HELP! 求一个删除多余线条的LISP！-CAD家园

HELP! 求一个删除多余线条的LISP！

作者：cad 提交日期：2008-11-20| 分类: | 访问量：

HELP! 求一个删除多余线条的LISP！

本帖被 tandongchi 执行取消锁定操作(2007-09-15) 求快速剪切多余线的LISP！高手出招!
兄弟在绘图时经常遇到四条平行相交的直线！我要用F命令倒0角四次!才能删除多的线条，得到一个矩形！请有没有那位大侠有这样的LISP：只要一次框选就能删除多余的线条，得到一个矩形！
谢谢！我真的很需要！

如果我的表达不是很清楚！有个附件可供参考！

附件：在绘图经常遇到四条相交的直线.doc (137 K) 下载次数:3

Trim --> 选四线--> F -->绕一圈
or
Command: -boundary

Specify internal point or [Advanced options]: Selecting everything...
Selecting everything visible...
Analyzing the selected data...

Analyzing internal islands...

Specify internal point or [Advanced options]:

BOUNDARY created 1 polyline
Command: e
ERASE
Select objects: Specify opposite corner: 5 found

Select objects: r

Remove objects: l
1 found, 1 removed, 4 total

Remove objects:
=======================
是用在处理冲头套件吗?
我们用的套装软体可以直接产生各层部件(含下料孔)
这个功能用法现己少用了

[ 此贴被andyes在2007-09-09 16:44重新编辑 ]

这个不管用！1楼没有明白我的意思！

能否把你的传给我用下！我的邮箱是MINGVICTOR@163.com

图片：

;;; 仅供测试用
;;; for test only
(defun c:prueba ()
;; 借用Boundary
(bpoly (getpoint"\n请用鼠标指向四方框的内部: "))
(vl-cmdf "Erase"
(apply 'ssget
(append
(list "C")
(acet-ent-geomextents (entlast))
'(((0 . "LINE")))
) )
""
)
(princ)
)

[ 此贴被andyes在2007-09-09 22:10重新编辑 ]

我用lisp编制了一个程序，只要在矩形的中间点一点，由程序去给你倒角，程序如下：

(defun c:fff (/ p1 p2 p3 p5 p6 p7 pp1 pp2 pp3 pp4 pp5 pp6 pp7 dd ddd ggg gg g dd1)
(setq p1 (getpoint "在要剪的图形的中间点一下:") p2 (polar p1 0 2000) ddd nil pp4 nil dd nil) ;2000的数字可调整
(setq en (ssget "c" p1 p2) s (sslength en) i 0 p5 nil)
(command "fillet" "r" "0" )
(repeat s
(setq een (entget (ssname en i)) pp1 (cdr (assoc 10 een)) pp2 (cdr (assoc 11 een)) i (+ i 1) )
(setq p3 (inters p1 p2 pp1 pp2) dd (distance p1 p3))
(setq d (read (strcat "dd" (itoa i))) )
(setq c2 'd c2 dd)
(set d dd)
(if (= ddd nil)(setq ddd dd1)(setq ddd (min ddd dd)))
)
(setq p5 (polar p1 (* pi 0.5) 2000) )
(setq en (ssget "c" p1 p5) s (sslength en) i 0 ggg nil)
(repeat s
(setq een (entget (ssname en i)) pp1 (cdr (assoc 10 een)) pp2 (cdr (assoc 11 een)) i (+ i 1) )
(setq p5 (inters p1 p5 pp1 pp2) dd (distance p1 p5))
(setq d (read (strcat "dd" (itoa i))) )
(setq c2 'd c2 dd)
(set d dd)
(if (= ggg nil)(setq ggg dd1)(setq ggg (min ggg dd)))
)
(setq pp4 (polar p1 0 ddd) pp5 (polar p1 (* pi 0.5) ggg))
(command "fillet" pp4 pp5)
(setq p6 (polar p1 (* pi 1.5) 2000) )
(setq en (ssget "c" p1 p6) s (sslength en) i 0 gg nil)
(repeat s
(setq een (entget (ssname en i)) pp1 (cdr (assoc 10 een)) pp2 (cdr (assoc 11 een)) i (+ i 1) )
(setq p5 (inters p1 p6 pp1 pp2) dd (distance p1 p5))
(setq d (read (strcat "dd" (itoa i))) )
(setq c2 'd c2 dd)
(set d dd)
(if (= gg nil)(setq gg dd1)(setq gg (min gg dd)))
)
(setq pp6 (polar p1 (* pi 1.5) gg))
(command "fillet" pp4 pp6)
(setq p7 (polar p1 pi 2000) )
(setq en (ssget "c" p1 p7) s (sslength en) i 0 g nil)
(repeat s
(setq een (entget (ssname en i)) pp1 (cdr (assoc 10 een)) pp2 (cdr (assoc 11 een)) i (+ i 1) )
(setq p5 (inters p1 p7 pp1 pp2) dd (distance p1 p5))
(setq d (read (strcat "dd" (itoa i))) )
(setq c2 'd c2 dd)
(set d dd)
(if (= g nil)(setq g dd1)(setq g (min g dd)))
)
(setq pp7 (polar p1 pi g))
(command "fillet" pp7 pp6)
(command "fillet" pp7 pp5)
)

感谢二位！感谢二位的无私指教！

本程序只对矩形修边。能达到楼主的要求。
(defun c:ff (/ en gg gg1 gg2 gg3 p1 p2 p3 p4 p5 p6 p7 p8 pp1 pp2 pp3 pp4)
(setq en (ssget ))
(setq gg (entget (ssname en 0)) p1 (cdr (assoc 10 gg)) p2 (cdr (assoc 11 gg)) an1 (angle p1 p2))
(setq gg1 (entget (ssname en 1)) p3 (cdr (assoc 10 gg1)) p4 (cdr (assoc 11 gg1)) an2 (angle p3 p4))
(setq gg2 (entget (ssname en 2)) p5 (cdr (assoc 10 gg2)) p6 (cdr (assoc 11 gg2)) an3 (angle p5 p6))
(setq gg3 (entget (ssname en 3)) p7 (cdr (assoc 10 gg3)) p8 (cdr (assoc 11 gg3)) an4 (angle p7 p8))
(command "fillet" "r" "0" )
(setq pp1 (polar p1 an1 (/ (distance p1 p2) 2.0)) a nil)
(setq pp2 (polar p3 an2 (/ (distance p3 p4) 2.0)))
(setq pp3 (polar p5 an3 (/ (distance p5 p6) 2.0)))
(setq pp4 (polar p7 an4 (/ (distance p7 p8) 2.0)))
(if (and (= a nil)(/= (inters p1 p2 p3 p4) nil))(command "fillet" pp1 pp2)
(if (= a nil)(progn (setq a 1 )(command "fillet" pp1 pp3 "fillet" pp1 pp4 "fillet" pp2 pp3 "fillet" pp2 pp4))))
(if (and (= a nil)(/= (inters p5 p6 p3 p4) nil))(command "fillet" pp2 pp3)
(if (= a nil)(progn (setq a 1 )(command "fillet" pp2 pp4 "fillet" pp1 pp2 "fillet" pp1 pp3 "fillet" pp3 pp4))))
(if (and (= a nil)(/= (inters p5 p6 p7 p8) nil))(command "fillet" pp3 pp4)
(if (= a nil)(progn (setq a 1 )(command "fillet" pp1 pp3 "fillet" pp3 pp2 "fillet" pp4 pp1 "fillet" pp2 pp4))))
(if (and (= a nil)(/= (inters p7 p8 p1 p2) nil))(command "fillet" pp1 pp4)
(if (= a nil)(progn (setq a 1 )(command "fillet" pp1 pp3 "fillet" pp1 pp2 "fillet" pp3 pp4 "fillet" pp2 pp4))))
(princ)
)