更改线路长度
如何通过lisp根据用户给定的新长度更改或修改选定线或多边形线的长度？非常感谢。 为什么不能使用Kent Cooper在AutoDesk论坛上演示的“加长”命令？
延长
全部的
[输入长度]
栅栏
[绘制跨越要延长/缩短的端点的围栏路径] 谢谢你的评论。。我不知道这个命令。非常有用的命令。
如何缩短此命令，如
1） 选择线/多边形线
2） 指定所需的总长度
3） 然后输入。。
非常感谢。 (defun c:foo (/ l s)
(if (and (setq l (getdist "\nEnter length: ")) (setq s (ssget ":L" '((0 . "*polyline,line")))))
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(vl-cmdf "_Lengthen" "Total" l x "")
)
)
(princ)
) 下面是一个用于带选项的斜线的选项：
;| Change the Length of a Line|;
; BY: Tom Beauford
; BeaufordT@LeonCountyFL.gov
; Leon County Public Works Engineering
;(or C:chl (load "ChgLen.lsp"));chl
; (load "ChgLen.lsp") chl
;=======================================================
(defun C:chl (/ ActDoc A pick B etype pt1 pt pt2 pt3 pt4 distold dist1 ang1 z1)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(setq A (entsel "\nSelect Entity: ")
pick (osnap (cadr A) "endp")
B (entget (car A))
etype (cdr(assoc 0 B))
); setq
(princ "\netype = ")
(princ etype)
(cond
((eq etype "LINE")
(progn
(setq pt1 (cdr (assoc 10 B)) pt2 (cdr (assoc 11 B)))
(if (>(distance pt1 pick)(distance pick pt2))
(setq pt pt1 pt1 pt2 pt2 pt)
)
(setq pt3 (list (car pt1)(cadr pt1)) pt4 (list (car pt2)(cadr pt2))
distold (distance pt3 pt4)
ang1 (angle pt2 pt1)
)
(princ "\nOld Distance=")
(princ distold)
(initget "Lengthen Shorten Total Elevation Percent Ratio")
(if(= ¦¦global¦¦ nil)(setq ¦¦global¦¦ "Total"))
(if(setq ¦¦notnil¦¦ (getkword (strcat " <" ¦¦global¦¦ ">: ")))(setq ¦¦global¦¦ ¦¦notnil¦¦))
(setvar "cmdecho" 0)
(cond
((= ¦¦global¦¦ "Lengthen")
(setq dist1 (+ distold (getreal "\nEnter Distance: "))
z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
)
); Lengthen
((= ¦¦global¦¦ "Shorten")
(setq dist1 (- distold (getreal "\nEnter Distance: "))
z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
)
); Shorten
((= ¦¦global¦¦ "Total")
(setq dist1 (getreal "\nEnter New Length: ")
z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
)
); Total
((= ¦¦global¦¦ "Elevation")
(setq z1 (getreal "\nEnter Elevation to Trim/Extend: ")
dist1 (*(/ distold (-(caddr pt1)(caddr pt2)))(- z1 (caddr pt2)))
)
); Elevation
((= ¦¦global¦¦ "Percent")
(setq z1 (+(caddr pt2)(* distold(getreal "\nEnter Slope in %: ")0.01))
dist1 distold
)
); Percent
((= ¦¦global¦¦ "Ratio")
(setq z1 (+(caddr pt2)(/ distold(getreal "\nEnter Run/Rise: ")))
dist1 distold
)
); Ratio
); cond
(setq pt1 (polar pt2 ang1 dist1)
pt1 (list (car pt1)(cadr pt1) z1)
)
(if pt (setq pt pt1 pt1 pt2 pt2 pt))
(setq B (subst(cons 10 pt1)(assoc 10 B) B)
B (subst(cons 11 pt2)(assoc 11 B) B)
)
(entmod B)
(princ "\nOld Distance=")
(princ distold)
(princ ", New Distance=")
(princ dist1)
); progn
); line
((or(eq etype "ARC")(eq etype "POLYLINE")(eq etype "LWPOLYLINE"))
(progn
(command "lengthen" pick)
); progn
); ARC, POLYLINE or LWPOLYLINE
); cond
(vla-EndUndoMark ActDoc)
(princ)
) 你好谢谢你，罗恩·琼普。。我需要这样。 谢谢tombu
页:
[1]