倒角-仅修剪1行
我经常用6“x6”乘以45度的倒角绘制连接到干管的单线支管。如果“修剪”选项处于启用状态，则将修剪主线和支线。我不想修剪主管道。我关闭了修剪选项，然后必须使用圆角来清理带有支线的倒角。有人知道或有人知道修改过的倒角命令，该命令只会修剪两条线中的一条谢谢 试试这段代码，我为你的情况编写了这段代码，你必须选择要修剪的线的端点，并指定要修剪所选直线以添加具有角度45指定长度的新线的距离长度。
(defun c:test (/ *error* acdoc e d len p1 ent p2 lst clse first second ang)
;; Tharwat 05. 08. 2011
(vl-load-com)
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if
(and
(setq e (entsel "\n Select line :"))
(eq (cdr (assoc 0 (setq ent (entget (car e))))) "LINE")
(setq d (getdist "\n Specify the distance :"))
)
(progn
(vla-StartUndoMark acdoc)
(setq len (sqrt (+ (* d d) (* d d))))
(setq p1 (cdr (assoc 10 ent )))
(setq p2 (cdr (assoc 11 ent)))
(setq lst (vl-remove-if-not
(function (lambda (x)
(member (car x) '(0 67 410 8 62 210))
)
)
ent
)
)
(setq clse
(vlax-curve-getclosestpointto (car e) (trans (cadr e) 1 0))
)
(if (< (distance p1 clse) (distance p2 clse))
(progn
(setq first p2)
(setq second (polar first
(setq ang (angle p2 p1))
(- (distance p2 p1) d)
)
)
)
(progn
(setq first p1)
(setq second (polar first
(setq ang (angle p1 p2))
(- (distance p1 p2) d)
)
)
)
)
(entmakex
(append lst
(list (cons 10 (trans first 1 0))
(cons 11 (setq x (trans second 1 0)))
)
)
)
(entmakex
(append
lst
(list (cons 10 x) (cons 11 (polar x (+ ang 0.785398) len)))
)
)
(entdel (car e))
)
(princ "\n Select a line only !! ")
)
(vla-EndUndoMark acdoc)
(princ)
)
Tharwat 另一个：
(defun c:Test (/ Line1 Line2 PtOfInters ascnum minDist)
(vl-load-com)
(setq Chad (cond (
(getdist (strcat "\nEnter Distance: <"
(rtos (setq Chad (cond ( Chad ) (72))) 2 2) ">: "
)
)
)
( Chad )
)
)
(setvar 'Trimmode 0)
(setvar 'ChamferA (setvar 'ChamferB chad))
(cond
((and
(setq line1 (car (entsel "\nSelect Main Pipe line: ")))
(setq line2 (car (entsel "\nSelect second line: ")))
)
(vl-cmdf "_Chamfer" line1 line2)
(setq PtOfInters
(vlax-invoke
(vlax-ename->vla-object Line2)
'intersectwith
(vlax-ename->vla-object (entlast))
acExtendBoth))
(setq minDist (mapcar
'(lambda (y)
(distance PtOfInters (cdr y)))
(list (assoc 10 (entget line2))
(assoc 11 (entget line2)))))
(entmod (subst (cons
(setq ascnum
(if (= (length (member (apply 'min minDist) mindist)) 1)
11
10)) PtOfInters)(assoc ascnum (entget Line2))(entget Line2))
)
)
)
(princ)
)
没有错误处理程序。无setvar重置。。。。。
希望这能有所帮助 非常感谢你写的例行公事。它工作得很好，但我想知道如果改变它来控制45度倒角绘制的方向，你会考虑作为一种增强吗？
-----
请使用代码标签！
再次感谢Tharwat。我试过这个，但当我选择支线时它崩溃了。 也许薄的可以适用于所有角度。
(defun c:test (/ *error* acdoc e d a len p1 ent p2 lst clse first second ang)
;; == Tharwat 09. 08. 2011 == ;;
(vl-load-com)
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if
(and
(setq e (entsel "\n Select line :"))
(eq (cdr (assoc 0 (setq ent (entget (car e))))) "LINE")
(setq d (getdist "\n Specify the distance :"))
(setq a (getangle "\n Specify the angle :"))
)
(progn
(vla-StartUndoMark acdoc)
(setq len (sqrt (+ (* d d) (* d d))))
(setq p1 (cdr (assoc 10 ent )))
(setq p2 (cdr (assoc 11 ent)))
(setq lst (vl-remove-if-not
(function (lambda (x)
(member (car x) '(0 67 410 8 62 210))
)
)
ent
)
)
(setq clse
(vlax-curve-getclosestpointto (car e) (trans (cadr e) 1 0))
)
(if (< (distance p1 clse) (distance p2 clse))
(progn
(setq first p2)
(setq second (polar first
(setq ang (angle p2 p1))
(- (distance p2 p1) d)
)
)
)
(progn
(setq first p1)
(setq second (polar first
(setq ang (angle p1 p2))
(- (distance p1 p2) d)
)
)
)
)
(entmakex
(append lst
(list (cons 10 (trans first 1 0))
(cons 11 (setq x (trans second 1 0)))
)
)
)
(entmakex
(append
lst
(list (cons 10 x) (cons 11 (polar x (+ ang a) len)))
)
)
(entdel (car e))
)
(princ "\n Select a line only !! ")
)
(vla-EndUndoMark acdoc)
(princ)
)
塔瓦特 感谢您修改单行倒角例程！它很好用，你能帮我完成我的请求真是太慷慨了。
-布鲁斯
不客气，布鲁斯。
我很高兴能帮助你。
塔瓦特
页:
[1]