好的,你想要一个几年前我做的lisp,叫做TICS,用于建筑TICS,将线延伸到一个已知的距离,你可以批量选择等等,
- ; BY Alan H 2012
- ; tics.lsp
- ; draw architectural tic marker tics.lsp
- ;defun exline
- (defun ah:exline (en / p1 p2 p3 p4 ang )
- (setq p1 (vlax-safearray->list (vlax-variant-value(vla-get-startpoint en))))
- (setq p2 (vlax-safearray->list (vlax-variant-value(vla-get-endpoint en))))
- (setq ang (angle p1 p2))
- (setq p3 (polar p1 (- ang pi) tic_len))
- (setq p4 (polar p2 ang tic_len))
- (command "line" p1 p3 "")
- (command "line" p2 p4 "")
- )
- ; pline co-ords
- ; By Alan H
- (defun AH:getcoords (ent / I len)
- (setq co-ords (vlax-safearray->list (vlax-variant-value (vlax-get-property en "Coordinates" ))))
- (setq len (length co-ords))
- (setq numb (/ len 2))
- (setq I 0)
- (repeat numb
- (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
- (setq co-ordsxy (cons xy co-ordsxy))
- (setq I (+ I 2))
- )
- ) ;defun
- (defun AH:expoly (ordsxy / pt1 pt2 num x)
- (setq x (length ordsxy))
- (if (= (vla-get-closed en) :VLAX-FALSE)
- (setq num x)
- (setq num (- x 1)) ; open
- ) ; closed
- (setq p2 (nth (setq x (- x 1)) ordsxy))
- (repeat num
- (setq p1 (nth (setq x (- x 1)) ordsxy))
- (setq ang (angle p1 p2))
- (setq p3 (polar p1 (- ang pi) tic_len))
- (setq p4 (polar p2 ang tic_len))
- (command "line" p1 p3 "")
- (command "line" p2 p4 "")
- (setq p2 p1)
- )
- )
- ; starts here
- ; checklay make if missing
- (if (= (tblsearch "layer" "Tics") nil)
- (command "-layer" "n" "Tics" "c" 1 "Tics" "")
- )
- (defun c:tics ( / tic_len ss y)
- (setq tic_len (getdist "\nEnter tick size mm <20> "))
- (if (= tic_len nil) ; pressed enter so 20
- (setq tic_len 20)
- )
- ; Selection set to measure
- ;now pick multiple lines etc
- (setq exlay (getvar 'clayer))
- (setvar "clayer" "tics") ; change layer name to suit
- (setq oldsnap (getvar 'osmode))
- (setq ss (ssget)) ; no check if it returned something
- ; put a create layer here
- (setvar 'osmode 0)
- (repeat (setq y (sslength ss))
- (setq en (vlax-ename->vla-object (ssname ss (setq y (- y 1)))))
- ; Entity type
- (setq entype (vla-get-ObjectName en))
- (cond ((= entype "AcDbLine")(AH:exline en))
- ((= entype "AcDbPolyline")(AH:getcoords en)(AH:expoly co-ordsxy)(setq co-ordsxy nil))
- )
- )
- (setvar 'clayer exlay)
- (setvar 'osmode oldsnap)
- (princ)
- ) ;defun
|