08.09.2018 21:22    

pisibaliqi
Poz numaralandırmak için kullanmış olduğum bir lisp var, bu numaralandırmayı dimaligned ile beraber kullanmak istiyorum.

Yani istediğim şey Da ile ölçü aldığımda, ölçünün üzerine atıyorum 50 birim ofset atıp D1 diye başlayarak, ölçülendirmeye numara verecek. İkinci birimi ölçtüğümde yine ölçüyü yazıp üzerine D2 diye devam edecek.

Kısacası ölçülendirmelerimi ön eki ile beraber numaralandırmasını istiyorum. Hatta ikisinide yani hem ölçüyü hem numarayı aynı textin içinde yazabilirse şahane olur.

Bu iki komutu birleştirebilirmiyiz yada bunu yapabilmek için önerebileceğiniz bir kaynak var mı?

Kullanmış olduğum lisp;

(defun c:numara ()
(setq om (getvar "osmode"))
(setvar "cmdecho" 0)
(setq T1 "\n yazi yuksekligi <"
T2 "> ? "
T3 (getvar "textsize")
)
(terpri)
(setq TH (getreal (strcat T1 (rtos T3 2 2) T2)))
(if (= TH nil)
(setq TH t3)
)
(setq h1 (getstring "\n açiklama olarak bas ek ? "))
(setq n (getint "\n etiket numarasi kaçtan baslasin ? ")) ; 1
(initget 1 "d k") ; 2
(setq z (getkword "\n daireli mi koseli mi olsun ? ")) ; 3
(if
(= z "d")
(progn
(while
(setq p1 (getpoint "\n ilk noktayi giriniz"))
(setvar "osmode" 0)
(setq p2 (getpoint p1 "\n ikinci noktayi giriniz"))
(command "line" p1 p2 "") ; 4
(command "circle" p1 (* 0.5 th)) ; 5
(command "circle" p2 (* 1.5 th))
(command "trim" "l" "" p2 "")
(setq nn (strcat h1 (itoa n)))
(command "text" "j" "mc" p2 th "0" nn "")
(setq n (1+ n)) ; 6
(setvar "osmode" om)
)
)
)
(if ; 7
(= z "k")
(progn
(setq ko (getint "\n kac koseli olsun ")) ; 8
(while ; 9
(setq p1 (getpoint "\n ilk noktayi giriniz"))
(setvar "osmode" 0)
(setq p2 (getpoint p1 "\n ikinci noktayi giriniz"))
(command "line" p1 p2 "")
(command "circle" p1 (* 0.5 th))
(command "polygon" ko p2 "c" (* 1.5 th))
(command "trim" "l" "" p2 "")
(setq nn (strcat h1 (itoa n)))
(command "text" "j" "mc" p2 th "0" nn "")
(setq n (1+ n))
(setvar "osmode" om)
)
)
)
)

admin (14.09.2018 21:21 GMT)

09.09.2018 20:21    

alumina
Alıntı
pisibaliqi :

Kod:

(defun c:da (/ ly tx p1 p2 ss n sr ty ls cl a) (vl-load-com)
  (if (and (setq ly "Dim_Pose_Num"
        tx (getstring "\nFirst character(s):"))
          (setq p1 (getpoint "\nSpecify first point:"))
            (setq p2 (getpoint p1 "\nSpecify second point:")))
    (progn
      (if (not (tblobjname "layer" ly))
        (vla-add (vla-get-Layers (vla-get-activedocument
          (vlax-get-acad-object))) ly))
      (if (setq ss (ssget "x" (list '(0 . "dimension") (cons 8 ly))))
        (repeat (setq n (sslength ss))
          (setq n (1- n) sr (vla-get-TextOverride
            (vlax-ename->vla-object (ssname ss n))) ty (strlen tx))
          (if (= (substr sr 1 ty) tx)
            (setq ls (cons (atof (substr sr (1+ ty)
              (1- (vl-string-position (ascii "-") sr)))) ls)))))
      (setq a (if ls (apply 'max ls) 0) cl (getvar 'clayer))
      (setvar 'clayer ly) (setvar 'cmdecho 0)
      (vl-cmdf "._dimaligned" p1 p2 "t" (strcat tx (rtos (1+ a) 2 0) "-<>"))
      (setvar 'clayer cl) (setvar 'cmdecho 1)
    )
  ) (prin1)
)

alumina (10.09.2018 09:47 GMT)

09.09.2018 20:31    

pisibaliqi
Çok teşekkürler emeğiniz için ancak bir türlü tam anlamıyla çalıştıramadım. Kodda devam sağlamıyor D1 ise D1 olarak atıp kodu tekrar ettiğimde yeniden ön ek soruyor ve 1 ekliyor tekrar yani D2 desemde D21 oluyor.

Benim istediğim ise kodu tekrar girmeden direkt d1 d2 d3 olarak devam edebilmek.

Yine de çok teşekkür ederim uğraşınız için

09.09.2018 20:37    

alumina
Alıntı
pisibaliqi :

Sadece karakteri girerek olculendirme yapin. hangi sayida kaldiysa otomatik olarak bir sonraki sayidan devam edecektir. Degisik harf gruplariyla da deneyebilirsiniz.

09.09.2018 20:52    

pisibaliqi
Malesef çalıştıramadım ilk ölçüye numarayı atıyor ancak devamında komuttan çıkıyor tekrar dediğimde de yeniden ön ek soruyor. Dco ile devam ettiğimde de numarayı yazmıyor.

Sanırım yanlış yaptığım bişeyler var :/

09.09.2018 21:17    

alumina
Alıntı
pisibaliqi :

Kodu siteden tekrar kopyalayin. Kod surekli olculendirme icin yazilmadi. Her calistirdiginizda on ek soracak ve buna sadece harf veya harf grubu girerek cevap verin. Ornegin "d" veya "dd" veya "dc" vs girebilirsiniz. O harf grubunun kullanildigi butun olculer otomatik olarak taranacak ve son kullandigi sayi hangisi ise bir sonraki sayidan devam edecektir. harf grubunun onunde sayi girmeyiniz. "d1" veya "dd1" olarak degil, sadece "d" veya "dd" olarak giriniz.

09.09.2018 22:47    

alumina
Kod 2013 surumunde normal calisirken, 2018 surumunde, (setvar 'clayer ly) calismiyor. Bu nedenle, dim nesnesi "Dim_Pose_Num" layerinde create edilemiyor. Boyle olunca da surekli olarak harfin onune 1 atiyor. Daha da ilginci, son olusturulan nesnenin layerini entmod yada vla-put la da degistirmiyor... Anlayan varsa anlatsin bana..

10.09.2018 15:12    

alumina
kodun sonundaki (setvar 'clayer cl) ifadesi kaldirilirsa 2018 surumunde de calisiyor, fakat "Dim_Pose_Num" layerinde kaliyor..

11.09.2018 17:08    

pisibaliqi
Layerda kalması sorun değil çok teşekkür ederim emeğiniz için herhalde bir while döngüsü ile kodun devam etmesini sağlayabilirim diye düşünüyorum. Biraz kurcalayacağım. Tekrar teşekkürler

14.09.2018 11:27    

alumina
Alıntı
pisibaliqi :

Kod:

(defun c:da (/ dc ly tx p1 p2 ss n sr ty ls a a1 a2 st ns) (vl-load-com)
  (if (setq dc (vla-get-activedocument (vlax-get-acad-object))
        ly "Dim_Pose_Num" tx (getstring "\nFirst character(s):"))
    (while (and (setq p1 (getpoint "\nSpecify first point:"))
        (setq p2 (getpoint p1 "\nSpecify second point:")))
      (vla-startundomark dc)
      (if (not (tblobjname "layer" ly))
        (vla-add (vla-get-Layers dc) ly))
      (if (setq ss (ssget "x" (list '(0 . "dimension") (cons 8 ly))))
        (repeat (setq n (sslength ss))
          (setq n (1- n) sr (vla-get-TextOverride
            (vlax-ename->vla-object (ssname ss n))) ty (strlen tx))
          (if (= (substr sr 1 ty) tx)
            (setq ls (cons (atof (substr sr (1+ ty)
              (1- (vl-string-position (ascii "-") sr)))) ls)))))
      (setq a (if ls (apply 'max ls) 0) a1 (angle p1 p2) a2 (/ pi 2)
        st (cdr (assoc 140 (entget (tblobjname "dimstyle"
          (getvar 'dimstyle))))) ns (vlax-invoke (vla-get-modelspace dc)
            'adddimaligned p1 p2 (polar p1 (+ a1 a2) (* (if st st 2.5)
              (if (and (> a1 a2) (<= a1 (+ pi a2))) 2.5 2)))))
      (vla-put-Layer ns ly)
      (vla-put-TextOverride ns (strcat tx (rtos (1+ a) 2 0) "-"
        (rtos (distance p1 p2) 2 2))) (vla-endundomark dc)
    )
  ) (prin1)
)

> 1 <
Copyright © 2004-2022 SQL: 1.384 saniye - Sorgu: 72 - Ortalama: 0.01922 saniye