【求双线切割工具】Gu_xl版主已完美解决！~~

daidong013 · 发表于 2011-7-3 13:46:33

本帖最后由 daidong013 于 2011-7-5 16:09 编辑

求非常实用的双线切割工具!~~

daidong013 · 发表于 2011-7-3 15:34:50

本帖最后由 daidong013 于 2011-7-3 18:35 编辑

沙发！还望需要此功能的朋友用力顶啊！~~~

ninja37 · 发表于 2022-10-26 21:25:14

Gu_xl 发表于 2011-7-5 13:18
回复 dai
dong013 的帖子

版主可不可以修改一下，改成双线可以修剪的样子，被修剪的两个对象是圆矩形或者封闭的多义线。

999999 · 发表于 2020-9-8 22:56:20

顶起来，多逛逛论坛可以发现好多好东西，，谢谢大神们的辛苦

daidong013 · 发表于 2011-7-3 19:43:10

本帖最后由 daidong013 于 2011-7-4 10:40 编辑

自己再顶一把！~~~望大侠们出手帮忙！~可参考以下链接
http://bbs.mjtd.com/thread-85203-1-4.html

daidong013 · 发表于 2011-7-4 13:25:02

快沉底了！~~再加把油！~~

daidong013 · 发表于 2011-7-5 00:31:06

沙发、板凳、地板全都坐光了！~~

Gu_xl · 发表于 2011-7-5 11:10:42

本帖最后由 Gu_xl 于 2011-7-5 19:08 编辑

回复 daidong013 的帖子

;;;明经通道编制 By Gu_xl 2011年7月5日
(defun c:DtrimIn(/ p1 p3 p4 dis pl s1 enrec w enpline 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 是否删除双线[Yes/No]<No>:"))
(if (= "Yes" kd)
(progn
(entdel pline1)
(entdel pline2)
)
)
(mapcar 'setvar (list 'osmode 'cmdecho) (list osmode cmdecho))
(princ)
)

;;;明经通道 编制 By Gu_xl 2011年7月5日 
(defun c:DtrimIn(/ p1 p3 p4 dis pl s1  enrec w  enpline 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 是否删除双线[Yes/No]<No>:")) 
  (if (= "Yes" kd) 
    (progn 
      (entdel pline1) 
      (entdel pline2) 
      ) 
    ) 
  (mapcar 'setvar (list 'osmode 'cmdecho) (list osmode cmdecho)) 
  (princ) 
  )

daidong013 · 发表于 2011-7-5 11:48:08

本帖最后由 daidong013 于 2011-7-5 11:53 编辑

回复 Gu_xl 的帖子

版主真厉害啊！~~就是这样的效果！~~~
能加上捕捉吗？！~~~感谢感谢！~~

还有切割矩形，圆的时候切割的有点不干净！~~

Gu_xl · 发表于 2011-7-5 13:18:52

本帖最后由 Gu_xl 于 2012-3-31 14:40 编辑

回复 dai
dong013 的帖子

改进版：

;;;明经通道编制 By Gu_xl 2011年7月5日
(defun c:DtrimIn(/ p1 p3 p4 dis pl s1 en w enpline pline1 pline1 ss ssbj kd ss1 ss2 ss3 ss4 pl1 pl2 removesel)
(setq os (getvar 'osmode))
(setq cmd (getvar 'cmdecho))
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
(if *w*
(progn
(setq w (getdist (getvar "viewctr") (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))
)
)
(initget 7 "Yes No ")
(setq kd (getkword "\n 是否删除双线[Yes/No]<No>:"))
(setq en (entlast))
(princ "\n 请绘制双线中线: ")
(setvar 'osmode 3071)
(vl-cmdf "_pline")
(while (= 1 (getvar "cmdactive"))
(vl-cmdf pause)
)
(setvar 'osmode 0)
(setq enpline (entlast))
(if (not (equal en enpline))
(progn
(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 pline1))))
(setq pl (append pl (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline2))))))
(setq p1 (apply 'mapcar (cons 'min pl))
p3 (apply 'mapcar (cons 'max pl))
)
(command "_.Zoom" "_Window" p1 p3 "._Zoom" "0.95x")
(setq dis (* 0.15 w))
(vla-Offset (vlax-ename->vla-object enpline) (- (/ w 2.0) dis))
(setq pline3 (entlast))
(vla-Offset (vlax-ename->vla-object enpline) (+ dis (/ w -2.0)))
(setq pline4 (entlast))
(setq pl1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline3))))
(setq pl2 (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline4)))))
(entdel pline3)
(entdel pline4)
(vla-put-Visible (vlax-ename->vla-object pline1) :vlax-false)
(vla-put-Visible (vlax-ename->vla-object pline2) :vlax-false)
(setq ss1 (ssget "f" (list (car pl1) (last pl2))) ss2 (ssget "f" (list (last pl1) (car pl2))))
(if ss1
(repeat (setq n (sslength ss1))
(setq removesel (cons (ssname ss1 (setq n (1- n))) removesel))
)
)
(if ss2
(repeat (setq n (sslength ss2))
(setq removesel (cons (ssname ss2 (setq n (1- n))) removesel))
)
)
(mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-false)) removesel)
(vla-put-Visible (vlax-ename->vla-object pline1) :vlax-true)
(vla-put-Visible (vlax-ename->vla-object pline2) :vlax-true)
(setq pl1 (append pl1 pl2))
(command "trim" ssbj "" )
(setq p1 (car pl1))
(foreach a (cdr pl1)
(command "f" p1 a "")
(setq p1 a)
)
(command "")
(mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-true)) removesel)
(entdel enpline)
(setq ss (ssget "wp" pl))
(if ss (command "erase" ss ""))
(if (= "Yes" kd)
(progn
(entdel pline1)
(entdel pline2)
)
)
)
)
(mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd))
(princ)
)

;;;明经通道 编制 By Gu_xl 2011年7月5日 
(defun c:DtrimIn(/ p1 p3 p4 dis pl s1  en w  enpline pline1 pline1 ss ssbj kd ss1 ss2 ss3 ss4 pl1 pl2 removesel) 
(setq os (getvar 'osmode)) 
(setq cmd (getvar 'cmdecho)) 
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0)) 
  (if *w* 
    (progn 
  (setq w (getdist (getvar "viewctr") (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)) 
      ) 
    ) 
  (initget 7 "Yes No  ") 
  (setq kd (getkword "\n 是否删除双线[Yes/No]<No>:")) 
  (setq en (entlast)) 
  (princ "\n 请绘制双线中线: ") 
  (setvar 'osmode 3071) 
  (vl-cmdf "_pline") 
  (while (= 1 (getvar "cmdactive")) 
  (vl-cmdf pause) 
    ) 
  (setvar 'osmode 0) 
  (setq enpline (entlast)) 
  (if (not (equal en enpline)) 
    (progn 
  (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 pline1)))) 
  (setq pl (append pl (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline2)))))) 
  (setq p1 (apply 'mapcar (cons 'min pl)) 
        p3 (apply 'mapcar (cons 'max pl)) 
        ) 
  (command "_.Zoom" "_Window" p1 p3 "._Zoom" "0.95x") 
  (setq dis (* 0.15 w)) 
    (vla-Offset (vlax-ename->vla-object enpline) (- (/ w 2.0) dis)) 
  (setq pline3 (entlast)) 
  (vla-Offset (vlax-ename->vla-object enpline) (+ dis (/ w -2.0))) 
  (setq pline4 (entlast)) 
  (setq pl1 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline3)))) 
  (setq pl2 (reverse (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pline4))))) 
  (entdel pline3) 
  (entdel pline4) 
  (vla-put-Visible (vlax-ename->vla-object pline1) :vlax-false) 
  (vla-put-Visible (vlax-ename->vla-object pline2) :vlax-false) 
  (setq ss1 (ssget "f" (list (car pl1) (last pl2))) ss2 (ssget "f" (list (last pl1) (car pl2)))) 
  (if ss1 
    (repeat (setq n (sslength ss1)) 
      (setq removesel (cons (ssname ss1 (setq n (1- n))) removesel)) 
      ) 
    ) 
  (if ss2 
    (repeat (setq n (sslength ss2)) 
      (setq removesel (cons (ssname ss2 (setq n (1- n))) removesel)) 
      ) 
    ) 
  (mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-false)) removesel) 
  (vla-put-Visible (vlax-ename->vla-object pline1) :vlax-true) 
  (vla-put-Visible (vlax-ename->vla-object pline2) :vlax-true) 
  (setq pl1 (append pl1 pl2)) 
  (command "trim" ssbj "" ) 
  (setq p1 (car pl1)) 
  (foreach a (cdr pl1) 
    (command "f" p1 a "") 
    (setq p1 a) 
    ) 
  (command "") 
  (mapcar '(lambda (x) (vla-put-Visible (vlax-ename->vla-object x) :vlax-true)) removesel) 
  (entdel enpline) 
  (setq ss (ssget "wp" pl)) 
  (if ss (command "erase" ss "")) 
  (if (= "Yes" kd) 
    (progn 
      (entdel pline1) 
      (entdel pline2) 
      ) 
    ) 
  ) 
    ) 
(mapcar 'setvar (list 'osmode 'cmdecho) (list os cmd)) 
  (princ) 
  )

daidong013 · 发表于 2011-7-5 13:45:30

回复 Gu_xl 的帖子

近乎完美啊！~~真的是太厉害了！~~崇拜啊！~~
不过在使用完这个工具后，在使用过程中有捕捉，用完后捕捉就没有了！~~

Gu_xl · 发表于 2011-7-5 15:55:43

楼上已改！

账号		自动登录	找回密码
密码			注册

【求双线切割工具】Gu_xl版主已完美解决！~~

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

本帖子中包含更多资源

评分

评分