Copyright © 2004-2022 SQL: 1.518 saniye - Sorgu: 67 - Ortalama: 0.02266 saniye
 |
 |
 |
 |
|
|
|
|
13.04.2013 10:35
ozgurayhan 
|
|
Arkadaşlar, yabancı bi sitede line ve polyline uzunluğunu, çizginin üzerinde istediğiniz bölgeye yazan bi lisp buldum. Lisp kodlama konusunda hiç bilgim yok. Acaba bu lispe arc, circle uzunluğuda eklenebilir mi ?
Kod: (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)))) ehya (13.04.2013 11:03 GMT) |
|
13.04.2013 11:14
 ehya
|
|
Kod: (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))) '("ARC" "LWPOLYLINE" "POLYLINE" "LINE"))) (progn (if (= (cdr (assoc 0 (entget cEnt))) "ARC") (progn (setq tStr (rtos (vla-get-arclength (vlax-ename->vla-object cEnt))))) (progn (setq tStr (rtos (vla-get-length (vlax-ename->vla-object cEnt)))))) (setq 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))))
|
|
13.04.2013 11:18
ozgurayhan
|
|
ehya eline sağlık, çok teşekkür ederim. Son birşey daha sorabilir miyim yazı yüksekliği 50 olarak geliyor bunu 20 yapma şansımız var mı ?
|
|
13.04.2013 11:30
ehya
|
|
Yazı yüksekliği aktif yazı stilinin yüksekliğine göre belirleniyor.
mevcut lispte düzenlemedim. Yerini söyleyeyim isteyen kendisine göre revize eder. lispin son kısmında yer alan koyu renk ile gösterdiğim yeri, (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)))) aşağıdaki gibi değiştirin. 20.00 değeri yazı yüksekliğidir. (cons 40 20.00)
|
|
16.04.2013 06:41
2032223351
|
|
hocam bunu toplu halde yaptiramazmiyiz ? illaki tek tek secip yermi gostermek lazim?
|
|
24.11.2013 11:23
cesi007
|
|
hocam bunu toplu halde yaptiramazmiyiz ? illaki tek tek secip yermi gostermek lazim?
bunun bir cevabı var mı ?
|
|
24.11.2013 18:51
 ProhibiT
|
|
Arkadaşlar, hem toplu seçim yapıp hem de uzunluğu taşıtarak yerleştirmek pek kullanışlı bir çözüm gibi görünmüyor.
Linkleri görebilmek için ÜYE olmalısınız. linkine bir göz atarsanız, belki işinize yarayabilir...
|
|
13.07.2023 16:43
 akcan
|
|
Kodlarda küçük bir değişiklik yaptım. LINE POLYLINE LWPOLYLINE ARC CIRCLE ELLIPSE SPLINE nesneleri kullanılabiliyor.
Kod: (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))) '("ARC" "LWPOLYLINE" "POLYLINE" "LINE"))) (member (cdr (assoc 0 (entget cEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "CIRCLE" "ELLIPSE" "SPLINE")) ) (progn ;;; (if (= (cdr (assoc 0 (entget cEnt))) "ARC") ;;; (progn ;;; (setq tStr (rtos (vla-get-arclength (vlax-ename->vla-object cEnt))))) ;;; (progn ;;; (setq tStr (rtos (vla-get-length (vlax-ename->vla-object cEnt)))))) (setq tStr (rtos (vlax-curve-getDistAtParam cEnt (vlax-curve-getEndParam cEnt)))) (setq 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) ) ) )
|
|
mtclass
|
|
BU LISPE 3D POLY LINE VE POLY LINE UZERINE TABAKANIN ISMINI OTOMATIK YAZACAK VE MESAFE L= 15.02 GIBI YAZACAK SEKILDE DUZENLEYEBILIRMIYIZ .. KOLAY GELSIN
|