关于CAD图纸筛选问题 ，求高手指导
我是做钢结构的，在一张CAD零件图中，有异形件、有矩形件，我想快速把这两种零件筛选过滤出来，通过lisp编程可以解决吗？求高手解答下。附件为一张CAD零件图。 本帖最后由 ZZXXQQ 于 2014-11-29 08:40 编辑找规律，分面积;零件分组 明经 ZZXXQQ 2014.11.20
(defun c:tt ()
(setvar "CMDECHO" 0)
(vl-load-com)
(if (setq ss (ssget "X" '((0 . "ARC,LINE")(62 . 2)))) (progn
(setq s1 (entlast) sslst (list))
(command "_.PEDIT" "M" ss "" "Y" "J" "0.02" "")
(if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4)))) (progn
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i))))
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
(setq p1 (mapcar '- p1 '(15 25)) p2 (mapcar '+ p2 '(10 25)))
(command "_.ERASE" "C" p1 p2 "")
)
))
(while (setq s1 (entnext s1)) (setq sslst (cons s1 sslst)))
(setq arealst (mapcar '(lambda (x) (vlax-curve-getArea(vlax-ename->vla-object x))) sslst))
(setq alst (mapcar 'list arealst sslst))
(setq alst (vl-sort alst '(lambda (a b) (< (car a) (car b)))))
(setq tmplst (list))
(setq aren (car alst))
(setq ar (car aren))
(setq enlst (cdr aren))
(setq i 1)
(foreach x (cdr alst)
(setq ttlst (list i (cdr x)))
(if (equal ar (car x) 1e-5)
(setq i (1+ i) enlst (append enlst (cdr x)))
(setq tmplst (append tmplst (list(list i enlst))) i 1 enlst (cdr x) ar (car x) ttlst (list))
)
)
(setq tmplst (append tmplst (list(list i enlst))))
(setq j 0)
(foreach x tmplst
(setq n (car x) j (1+ j))
(foreach y (cadr x)
(vla-getboundingbox (vlax-ename->vla-object y) 'pt1 'pt2)
(setq pt1 (vlax-safearray->list pt1))
(setq pt2 (vlax-safearray->list pt2))
(setq pt (mapcar '-
(mapcar '(lambda (a b) (/ (+ a b) 2)) pt1 (list (car pt2) (cadr pt1))) '(0 20)))
(command "_.TEXT" "S" "Arial" "M" pt "2.5" "0"
(strcat "%%U共" (itoa n) "件,编号" (itoa j) "%%U"))
)
)
))
(setvar "CMDECHO" 1)
(princ)
)
谢谢你的答复，但是我运行了下，怎么出现错误，运行不出来啊。 沙漠孤影 发表于 2014-11-26 16:16 static/image/common/back.gif
谢谢你的答复，但是我运行了下，怎么出现错误，运行不出来啊。
我CAD2004一运行，怎么出现这样“错误: no function definition: VLAX-ENAME->VLA-OBJECT”的问题呀？求指点 您好！这次可以运行了，谢谢你给与的帮助。运行的结果如图片所示，每个零件下面出现了新的一个编号。再麻烦你一下，请问是否可以实现经过lisp运行，CAD图中异形件异形件不动，把矩形件给删除了呢？期待你的回复，谢谢！！
沙漠孤影 发表于 2014-11-27 23:54 static/image/common/back.gif
您好！这次可以运行了，谢谢你给与的帮助。运行的结果如图片所示，每个零件下面出现了新的一个编号。再麻烦 ...
可以。
在(command "PEDIT" ...
之后加上
(if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4))))
(command "_.ERASE" ss "")
) ZZXXQQ 发表于 2014-11-28 07:53 static/image/common/back.gif
可以。
在(command "PEDIT" ...
之后加上
谢谢你的答复，图片是删除矩形框运行出来的结果，对于我这初学者来说，真有点崇拜你这高手啊 ！另外再问一下，通过lisp是否可以把矩形零件的标注线给删呢（即矩形件外轮廓没了，它自身的尺寸线是否也可以消除呢），还有异形件下重新编号的白色字体是否可以不显示呢，谢谢高手！求解答
还有什么要求一次说完。
新写的字体可以放在一个图层中，将该图层关闭或冻结即可。 ZZXXQQ 发表于 2014-11-28 20:02 static/image/common/back.gif
还有什么要求一次说完。
新写的字体可以放在一个图层中，将该图层关闭或冻结即可。
不好意思，老麻烦您了！经过lisp运行后，要求删除矩形件的轮廓线及其标注，只保留原图纸中异形件的信息。如所传附件为期望得到的结果。再次麻烦了，求解答。 沙漠孤影 发表于 2014-11-28 22:21 static/image/common/back.gif
不好意思，老麻烦您了！经过lisp运行后，要求删除矩形件的轮廓线及其标注，只保留原图纸中异形件的信息。 ...
问题给解决了，真是太感谢了。在lisp方面，你真是专家啊，特佩服你真得好好的向你学习下。
页:
[1]