18.05.2016 21:26    

Arkadaşlar çok araştırıp bulamadığım bir lisp . Bu konuda yardımcı olursanız sevinirim .

Derdim 1 den fazla polyline üzerine otomatik hepsinin toplamını yazdırmak . Metraj hazırladığım için her bir renk başka anlama geliyor dolayısıyla farklı renklerde farklı polyline çizmek zorunda kalıyorum . Bulduğum bir lisp Tek polyline üzerine atabiliyor . Ama bu sefer de çok köşe noktası oluyor K1 , K2 , K3 , K4 ..... Şeklinde belli aralıklarla Ayırıyorum . Bazen 100 ü geçiyor tek tek yazmak zahmet alıyor .
Örnek Olarak 2. resimde K57-K50 Arası İki uzunluğu da ayrı yazdım . Normalde ikisinin toplamını bir yazıyorum . Proje büyük olduğu için uğraşamadım . Kırmızı ve turkuaz Polyline uzunluklarını toplayıp üzerine otomatik yazsın istiyorum kısacası .


Daha önce bulduğum Line üzerine yazan ve Polyline Üzerine yazan lispleri paylaşayım . Belki bunlardan üretebilirsiniz .
Bide Yazı Yüksekliği ve Virgülden Sonra Kaç hane olacağını seçebiliyor muyuz ?
Luprec komutu ile ayarlayabiliyoruz galiba noktadan sonra kaç hane olacağını.


Şimdiden İlginize Teşekkürler . . .




Polyline üzerine Yazan

(defun c:plLen (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4)
(vl-load-com)
(if (and (setq cEnt (car (entsel "\nSelect Object: ")))
(member (cdr (assoc 0 (entget cEnt)))
'("LWPOLYLINE" "POLYLINE" "LINE")))
(progn
(setq tStr (rtos (vla-get-length
(vlax-ename->vla-object cEnt)))
tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
tHgt (- (cadadr tBox) (cadar tBox))
twid (- (caadr tBox) (caar tBox)))
(princ "\nPosition Text...")
(while (eq 5 (car (setq gr (grread t 5 0))))
(redraw)
(if (listp (setq sPt (cadr gr)))
(progn
(setq cPt (vlax-curve-getClosestPointto cEnt sPt)
lAng (angle cPt sPt)
bpt (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
tpt (polar bpt lAng tHgt)
mPt (polar bPt lAng (/ tHgt 2.))
pt1 (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
pt2 (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
pt3 (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
pt4 (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
(grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
(if (eq 3 (car gr))
(progn
(setq lAng (- lAng (/ pi 2.)))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(Make_Text mPt tStr lAng))))
(princ "\n<!> Incorrect Selection <!>"))
(redraw)
(princ))

(defun Make_Text (pt val rot)
(entmake
(list
(cons 0 "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 62 2)
(cons 10 pt)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 val)
(cons 50 rot)
(cons 7 (getvar "TEXTSTYLE"))
(cons 71 0)
(cons 72 1)
(cons 73 2)
(cons 11 pt))))


Line Üzerine Yazan


(defun c:uy ()
(setq uy_os (getvar "osmode"))
(setq uy_sec nil)
(setq uy_sec (ssget (list (cons 0 "LINE"))))
(if (= uy_sec nil)
(progn
(princ "
Nesne seçimi yok. Komut bitirildi..."))
(progn

(if (= uy_yaz_yuk nil)(setq uy_yaz_yuk 12))
(initget 2)
(setq uy_yaz_y (getdist (strcat "
Yazılacak yazının Yüksekliği:<" (rtos uy_yaz_yuk) ">:")))
(if (= uy_yaz_y nil)(setq uy_yaz_y uy_yaz_yuk))
(setq uy_yaz_yuk uy_yaz_y)
(setq uy_c 0)
(setq uy_say (sslength uy_sec))
(while (< uy_c uy_say)
(setq uy_sec_tek (ssname uy_sec uy_c))
(setq uy_sec_tek_10 (cdr (assoc 10 (entget uy_sec_tek)))
uy_sec_tek_11 (cdr (assoc 11 (entget uy_sec_tek))))
(setq uy_sec_tek_mes (distance uy_sec_tek_10 uy_sec_tek_11))
(setq uy_sec_tek_10_x (car uy_sec_tek_10)
uy_sec_tek_10_y (cadr uy_sec_tek_10)
uy_sec_tek_11_x (car uy_sec_tek_11)
uy_sec_tek_11_y (cadr uy_sec_tek_11))
(setq uy_yaz_x (/ (+ uy_sec_tek_10_x uy_sec_tek_11_x) 2.00)
uy_yaz_y (/ (+ uy_sec_tek_10_y uy_sec_tek_11_y) 2.00)
uy_yaz (list uy_yaz_x uy_yaz_y))
(if (< uy_sec_tek_10_x uy_sec_tek_11_x)
(progn
(setq uy_sec_aci_bas uy_sec_tek_10)
(setq uy_sec_aci_son uy_sec_tek_11)
)
(progn
(setq uy_sec_aci_bas uy_sec_tek_11)
(setq uy_sec_aci_son uy_sec_tek_10)))
(setq uy_sec_tek_aci (angle uy_sec_aci_bas uy_sec_aci_son))
(command "style" "cizgiyazi" "" "" "" "" "" "" "")
(command "osnap" "node")
(command "text" "j" "bc" uy_yaz uy_yaz_yuk (angtos uy_sec_tek_aci) (rtos uy_sec_tek_mes))
(setq uy_c (+ uy_c 1))
)))(setvar "osmode" uy_os)(princ))
(princ "
Komutu çalıştırmak için [UY] yazın")(princ)