【已解决】程序如何跳过（或强制拉伸）不能“EXTRUDE”为“三维实体”的“自交曲线”
本帖最后由 zxjing 于 2020-11-5 23:34 编辑一、程序功能批量拉伸平面图形（主要是PL线）至三维实体。具体为：把当前“打开状态”的每个图层上的图元（主要是闭合多段线）根据图层名称沿Z轴拉伸一定高度。（高度由图元所在的图层的名称“30-60m”的“-”和“m”之间的数值决定）调用的命令为“EXTRUDE”，工具条位置为“建模工具条\拉伸命令”。
二、面临问题程序执行至遇到不能拉伸的“自相交曲线”时，程序提示“不能扫掠或拉伸自交的曲线”并中断运行，要求“重新选择拉伸对象”。论坛里有类似的问题，只找到两种解决思路，但是没试出来怎么用，还请大咖们不吝赐教。思路①VLISP中vl-catch-all-apply 函数；思路②(defun *error*(msg)(princ "error: ")(princ msg) (princ))。
三、已知条件因为CAD的图层是按照高度分层的，所以，① 手动“拉伸”的话，可以“选层”，然后把本层所有图元统一拉伸一个高度。手动拉伸时，不能拉伸的图元（自相交曲线）会保持不变，但只要能拉伸的图元全部都能完成拉伸。（但程序执行时遇到“自交的曲线”就会中断，并一直要求输入待拉伸的图元（但并没有退出程序，也不是程序报错））② 剩下的“自相交曲线”可以通过工具条“拉伸”命令后面的“-presspull（按住并拖动）”命令来手动拉伸。4、CAD版本：AutoCAD2008和AutoCAD2018
四、该问题的三种解决思路1、 提前筛选自交曲线，不参与拉伸——目前网上找到的都不能满足需要，主要是两种情况：① 只要是闭合的就认为是自交——（我的图元都是闭合多段线）；② 不能把“不能拉伸的图元”判定为自交曲线。2、 跳过自交曲线，继续执行程序——能画个圈圈标注一下就更好了。这个不会弄，请求论坛大咖帮助啊。3、CAD2018中调用“-presspull”命令——昨晚发现AutoCAD2018的“-presspull（按住并拖动）”命令可以直接操作图元而不需要像CAD2008一样“点击图元内部的点”才可以拉伸。但是没有试出来调用的方法，一直提示“-presspull”。
五、代码(defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
(print "\n请把需要拉伸的图层独立。不允许“空图层”和不能拉伸的图元！")
;;;获取打开状态的图层列表=====-=========================
(setq n 1)
(while (setq lay (tblnext "layer" (not lay)))
(if (> (cdr (assoc 62 lay)) 0)
(if (= n 1)
(progn (setq date (cdr (assoc 2 lay))) (setq n 2))
(print(setq date (strcat date " " (cdr (assoc 2 lay))) ))
)
))
;;;获取打开状态的图层列表=====-=========================
(setq i 0)
(setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
(setq n 0)
(repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
(print (setq XStuceng;|显示图层|; (nth n str1))) ;获取一个打开的图层名
(setq ss (ssget "x" (list(cons 8XStuceng)))) ;按图层名称选择本层所有图元
(sssetfirst nil ss)
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
;;;(ascii "M(-+" ) ;查询ascii码
(setq pos (vl-string-position 45 XStuceng))
(setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
(command "layer" "s" XStuceng "")
(setq m 0) ;序号的初值设为0
(repeat (sslength ss);重复执行ss的长度的次数，即对象的个数
(setq name (ssname ss m));得到选择集内第n个对象的图元名
;;; (setq ent (entget name));得到该对象的图元表
;;; 核心执行的“拉伸”命令在这里 ===========
(if(=(command "extrude" name "" gaodu) nil);这句判断好像直接执行了，一点判断作用也没有，否的情况从来没执行过
;;;(progn (setq ss2 (ssadd))
;;;(ssadd name ss2)
;;;(sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2));
(progn (setq m (1+ m))
(princ m)
)
(progn(command "extrude" name "" gaodu)
(setq m (1+ m))
;;; (setq m(+ m 100))
)
);if cishu_nil ;序号M的数量加1
;;; 核心执行的“拉伸”命令在这里 ===========
)
(setq n (1+ n))
)
(prin1)
);程序结束
(defun C:PLLS2 () ;查找批量拉伸失败的那个图元
(command "regen")
(setq ss2 (ssadd))
(sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))
)
六、实例文件
上面的这个文件下载后显示为“无效文件”，百度网盘连接为：链接：https://pan.baidu.com/s/1Tz-cKNbXh_uoiamzJmzsfA提取码：1234
1、文件中共有三个不能拉伸的“自交曲线”，打开线宽就可以很明显的看到。程序中断的时候用“plls2”就可以看到，但只能找到本次卡住的那一个。
2、示例文件在在三维视图下的，打开“视图”工具条即可调整视图角度，或者shift+鼠标中键。
本帖最后由 wyl219 于 2020-11-5 07:02 编辑
command 只会返回nil...
为什么要分别extrude每个图元呢?直接extrude选择集不就好了
没用过3D相关命令,我的思路是:
1.遍历图层,寻找打开状态的,图层名符合要求的图层,并从图层名(lay)中获取拉伸高度h.
2.通过(ssget "x" (list(cons 8 lay)))获取该图层下所有对象
3.通过(command "extrude" ss "" h ) 自动拉伸能拉伸的对象,这样就能实现自动跳过不能拉伸的对象.
4.重新用(ssget "x" (list (cons 0 "~3DSOLID")(cons 8 lay)))获取该图层下所有不为三维实体的对象,这次获取到的就能不能拉伸的漏网之鱼.
5.遍历选择集,在组码10插入圆.
不太理解题主的问题所在,如果是需要对图层下的对象筛选以后,排除部分图元,可以ssdel以后拉伸选择集
另外还有一个思路,对一个选择集拉伸以后,选择集还在,但是拉伸后的对象图元名不在了,因此entget会返回nil,即对选择集拉伸以后,还能获取到信息表的对象是不能拉伸被跳过的对象
wyl219 发表于 2020-11-5 06:43
command 只会返回nil...
为什么要分别extrude每个图元呢?直接extrude选择集不就好了
好的，谢谢。 zxjing 发表于 2020-11-5 22:07
好的，谢谢。
我再试一下选择集。第一次用选择集的时候记得是提示参数错误了。 现在想也可能是图层或别的原因导致的。现在已经排除了这些干扰，可以再试一下。谢谢提醒:P wyl219 发表于 2020-11-5 06:43
command 只会返回nil...
为什么要分别extrude每个图元呢?直接extrude选择集不就好了
3.通过(command "extrude" ss "" h ) 自动拉伸能拉伸的对象,这样就能实现自动跳过不能拉伸的对象.
太感谢啦，这一句完美拉伸了所有可拉伸的图元 (defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
(print "\n请把需要拉伸的图层独立，关闭0层。不允许“空图层”和不能拉伸的图元！")
(setq ssbnls (ssadd))
(command "-layer""off" "0" "")
;;;获取打开状态的图层列表=====-=========================
(setq n 1)
(while (setq lay (tblnext "layer" (not lay)))
(if (> (cdr (assoc 62 lay)) 0)
(if (= n 1)
(progn (setq date (cdr (assoc 2 lay))) (setq n 2))
(print(setq date (strcat date " " (cdr (assoc 2 lay))) ))
)
))
;;;获取打开状态的图层列表=====-=========================
(setq i 0)
(setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
(setq n 0)
(repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
(print (setq XStuceng;|显示图层|; (nth n str1))) ;获取一个打开的图层名
(setq ss (ssget "x" (list(cons 8XStuceng)))) ;按图层名称选择本层所有图元
(sssetfirst nil ss)
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
;;;(ascii "M(-+" ) ;查询ascii码
(setq pos (vl-string-position 45 XStuceng))
(setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
(command "layer" "s" XStuceng "")
(command "extrude" ss "" gaodu )
(if (/=(setq bunenglashen (ssget "x" (list (cons 0 "~3DSOLID")(cons 8 XStuceng))))nil);选择不能拉伸的图元
(progn (sssetfirst nil bunenglashen)
;;; (setq ssbnls (ssadd ssbnls bunenglashen))
(setq k 0)
(repeat (sslength bunenglashen)
(setq ssbnls (ssadd (ssname bunenglashen k) ssbnls))
(setq k (1+ k))
)
(sssetfirst nil ssbnls)
));(progn ;if
(setq n (1+ n))
)
(sssetfirst nil ssbnls)
(prin1)
(if (= (tblobjname "layer" "0-未不能拉伸的图元") nil)
(command "-layer" "m" "0-未不能拉伸的图元" "c" "6" "" "")
(setvar "clayer" "0-未不能拉伸的图元")
)
(setq m 0) ;序号的初值设为0
(repeat (sslength ssbnls);重复执行ss的长度的次数，即对象的个数
(setq name (ssname ssbnls m));得到选择集内第n个对象的图元名
(setq ent (entget name);得到该对象的图元表
pt1 (cdr (assoc 10 ent))
;;; pt2 (cdr (assoc 10 (reverse ent)))
;;; r (* (getvar "DIMSCALE") 2)
)
(command ".CIRCLE" pt1 100 )(prin1)
(setq m (1+ m))
)
(sssetfirst nil ssbnls)
);程序结束
(defun C:PLLS2 () ;查找批量拉伸失败的图元
(command "regen")
(sssetfirst nil ssbnls)
)
本帖最后由 zxjing 于 2020-11-6 19:17 编辑
;兼容AutoCAD2018，设置为拉伸后删除图元。可以多次添加新图元进行拉伸
(defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
(alert "\n请确保①已把需要拉伸的图层独立显示；②无“空图层”；③关闭0层和无关层！")
(print "\n请把需要拉伸的图层独立，关闭0层。不允许“空图层”和不能拉伸的图元！")
(setvar "DELOBJ" -1);设置拉伸后原图元是否保留。3，默认删除； 0，保留；-1，提示是否删除
(setq ssbnls (ssadd))
(command "-layer""off" "0" "")
(if (/= (getvar "clayer") "0-未能拉伸的图元")
(command "-layer""off" "0-未能拉伸的图元" "")
(command "-layer""off" "0-未能拉伸的图元" "y" ""))
;;;获取打开状态的图层列表=====-=========================
(setq n 1)
(while (setq lay (tblnext "layer" (not lay)))
(if (> (cdr (assoc 62 lay)) 0)
(if (= n 1)
(progn (setq date (cdr (assoc 2 lay))) (setq n 2))
(print(setq date (strcat date " " (cdr (assoc 2 lay))) ))
)
))
;;;获取打开状态的图层列表=====-=========================
(setq i 0)
(setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
(setq n 0)
(repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
(print (setq XStuceng;|显示图层|; (nth n str1))) ;获取一个打开的图层名
(setq ss (ssget "x" (list(cons 0 "~3DSOLID")(cons 8XStuceng)))) ;按图层名称选择本层所有图元
(sssetfirst nil ss)
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
;;;(ascii "M(-+" ) ;查询ascii码
(setq pos (vl-string-position 45 XStuceng))
(setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
;;;获取图层名内“-”与“m”之间的数值作为拉伸的高度============
(command "layer" "s" XStuceng "")
(command "extrude" ss "" gaodu )
(if (/=(setq bunenglashen (ssget "x" (list (cons 0 "~3DSOLID")(cons 8 XStuceng))))nil);选择不能拉伸的图元
(progn (sssetfirst nil bunenglashen)
;;; (setq ssbnls (ssadd ssbnls bunenglashen))
(setq k 0)
(repeat (sslength bunenglashen)
(setq ssbnls (ssadd (ssname bunenglashen k) ssbnls))
(setq k (1+ k))
)
(sssetfirst nil ssbnls)
));(progn ;if
(setq n (1+ n))
)
(sssetfirst nil ssbnls)
(prin1)
(if (= (tblobjname "layer" "0-未能拉伸的图元") nil)
(command "-layer" "m" "0-未能拉伸的图元" "c" "6" "" "")
(progn (setvar "clayer" "0-未能拉伸的图元")(command "-layer""on" "0-未能拉伸的图元" ""))
)
(setq m 0) ;序号的初值设为0
(repeat (sslength ssbnls);重复执行ss的长度的次数，即对象的个数
(setq name (ssname ssbnls m));得到选择集内第n个对象的图元名
(setq ent (entget name);得到该对象的图元表
pt1 (cdr (assoc 10 ent))
;;; pt2 (cdr (assoc 10 (reverse ent)))
;;; r (* (getvar "DIMSCALE") 2)
)
(command ".CIRCLE" pt1 100 )(prin1)
(setq m (1+ m))
)
(sssetfirst nil ssbnls)
);程序结束
(defun C:PLLS2 () ;查找批量拉伸失败的图元
(command "regen")
(sssetfirst nil ssbnls)
)
(defun C:PLLS3 () ;查找批量拉伸失败的那个图元
(command "regen")
(setq ss2 (ssadd))
(sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))
)
本帖最后由 wyl219 于 2020-11-6 21:04 编辑
(if (/= ss nil))
可以修改为 (if ss )
(if (= ss nil))
可以修改为 (if (not ss ))
可以尝试一下以下代码:
;|
说明:筛选选择集ss中未被extrude命令处理的图元并画框标注
参数:ss:要被筛选的选择集
ss2:用于存放筛选出来的图元的选择集
返回值:无,但是ss2会被修改
|;
(defun flll_ss_by_extrude(ss ss2 / entmake_CIRCLE getbox old_lay en i)
(vl-load-com)
(setq entmake_CIRCLE (lambda (pt r)
(entmake (list '(0 . "CIRCLE")
'(8 . "0-未能拉伸的图元") ;图层
(cons 10 pt) ;圆心
(cons 40 r) ;半径
)) ));画圆的临时函数
(setq old_lay (getvar "CLAYER"));保存当前图层
(if (tblobjname "layer" "0-未能拉伸的图元")
(command "-layer""on" "0-未能拉伸的图元" "");如果有图层打开图层
(command "-layer" "m" "0-未能拉伸的图元" "c" "6" "" "");如果没有图层,建立图层
)
(setq getbox (lambda (en) ;获取对象的最小包围盒
(vla-GetBoundingBox (vlax-ename->vla-object en) 'll 'rr);得到对象的包围盒
(list (vlax-safearray->list ll) (vlax-safearray->list rr));返回左下右上坐标
))
(repeat (setq i (sslength ss))
(setq i (1- i))
(if(entget (setq en (ssname ss i)))
(progn;如果能找到信息表,说明未被处理
(ssadd en ss2)
(apply 'entmake_CIRCLE (apply '(lambda (p1 p2)
(list (mapcar '(lambda (x1 x2) (+ x1 (* (- x2 x1) 0.5))) p1 p2);包围盒的中点,圆心
(* 0.5 (distance p1 p2));半径r
))
(getbox en);获取最小包围盒
));画圆
)
)
)
(setvar "CLAYER" old_lay);恢复保存的图层
(princ)
)
;|
说明:示例函数
|;
(defun c:ttt ( /)
(setq ss (ssget (list(cons 0 "~3DSOLID"))));要被拉伸的选择集
(if(not ss2)
(setq ss2 (ssadd)));用于存放的选择集
(command "EXTRUDE" ss "" 100 );批量拉伸
(flll_ss_by_extrude ss ss2)
(sssetfirst nil ss2)
)
(princ)
建议写程序的时候遵照模块化的原则,这样修改和增减功能会方便很多
页:
[1]