【求双线切割工具】Gu_xl版主已完美解决！~~
本帖最后由 daidong013 于 2011-7-5 16:09 编辑求非常实用的双线切割工具!~~
本帖最后由 daidong013 于 2011-7-3 18:35 编辑
沙发！还望需要此功能的朋友用力顶啊！~~~ Gu_xl 发表于 2011-7-5 13:18
回复 dai
dong013 的帖子
版主可不可以修改一下，改成双线可以修剪的样子，被修剪的两个对象是圆矩形或者封闭的多义线。 顶起来，多逛逛论坛可以发现好多好东西，，谢谢大神们的辛苦 本帖最后由 daidong013 于 2011-7-4 10:40 编辑
自己再顶一把！~~~望大侠们出手帮忙！~可参考以下链接
http://bbs.mjtd.com/thread-85203-1-4.html
快沉底了！~~再加把油！~~ 沙发、板凳、地板全都坐光了！~~ 本帖最后由 Gu_xl 于 2011-7-5 19:08 编辑
回复 daidong013 的帖子
;;;明经通道 编制 By Gu_xl 2011年7月5日
(defun c:DtrimIn(/ p1 p3 p4 dis pl s1enrec wenpline pline1 pline1 ss ssbj)
(setq osmode (getvar 'osmode))
(setq cmdecho (getvar 'cmdecho))
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
(if *w*
(progn
(setq w (getreal (strcat "\n 双线宽度<" (rtos *w* 2 2) ">: ")))
(if (null w) (setq w *w*) (setq *w* w))
)
(progn
(setq w (getreal (strcat "\n 双线宽度<1.0>: ")))
(if (null w) (setq w 1.0 *w* w) (setq *w* w))
)
)
(vl-cmdf "_pline")
(while (= 1 (getvar "cmdactive"))
(vl-cmdf pause)
)
(setq enpline (entlast))
(vla-Offset (vlax-ename->vla-object enpline) (/ w 2.0))
(setq pline1 (entlast))
(vla-Offset (vlax-ename->vla-object enpline) (/ w -2.0))
(setq pline2 (entlast))
(setq ssbj (ssadd pline1))
(ssadd pline2 ssbj)
(setq pl (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget enpline))))
(setq p1 (apply 'mapcar (cons 'min pl))
p3 (apply 'mapcar (cons 'max pl))
)
(command "_.Zoom" "_Window" p1 p3 "._Zoom" "0.95x")
(command "trim" ssbj "" )
(setq p1 (car pl))
(foreach a (cdr pl)
(command "f" p1 a "")
(setq p1 a)
)
(command "")
(entdel enpline)
(initget 7 "Yes No")
(setq kd (getkword "\n 是否删除双线<No>:"))
(if (= "Yes" kd)
(progn
(entdel pline1)
(entdel pline2)
)
)
(mapcar 'setvar (list 'osmode 'cmdecho) (list osmode cmdecho))
(princ)
)
本帖最后由 daidong013 于 2011-7-5 11:53 编辑
回复 Gu_xl 的帖子
版主真厉害啊！~~就是这样的效果！~~~
能加上捕捉吗？！~~~感谢感谢！~~
还有切割矩形，圆的时候切割的有点不干净！~~
本帖最后由 Gu_xl 于 2012-3-31 14:40 编辑
回复 dai
dong013 的帖子
改进版：
**** Hidden Message *****
回复 Gu_xl 的帖子
近乎完美啊！~~真的是太厉害了！~~崇拜啊！~~
不过在使用完这个工具后，在使用过程中有捕捉，用完后捕捉就没有了！~~ 楼上已改！