【面域】面域转多段线 region to PLINE
本帖最后由 1028695446 于 2022-10-25 18:41 编辑1、将面域转化成多段线，可以框选（批量转化）
2、支持面域中含有样条曲线（SPLINE）边界
3、支持3维空间中的面域
(defun C:REGX(/ ss_reg_PLANESURFACE ss_sp ss_lst ss_spx ss_next ss1 ss2 entmark ent_mark ent_mark0 ent_mark_spline spline_ctrl)
(princ "\n 提取面域和平面曲面边界（多段线）")
(setq spline_ctrl 10);;样条曲线转换成多段线的精度
(if (setq ss_reg_PLANESURFACE(ssget '((0 . "REGION,PLANESURFACE"))))
(progn
(setq ss_lst (ss-enlst ss_reg_PLANESURFACE))
(setq ent_mark0 (entlast))
(foreach x ss_lst
(setq ent_mark (entlast))
(command "XEDGES" (ssadd x) "")
(if (not (equal (entlast) ent_mark 0.01))
(progn
;;===================================================
(setq ss_next (MJ:EntNextAll_G ent_mark))
(command "SELECT" ss_next "" )
(setvar "peditaccept" 1)
(if (setq ss_sp (ssget "P" '((0 . "SPLINE"))))
(progn
(setq ent_mark_spline (entlast))
(command "_pedit" "M" ss_sp "" spline_ctrl"");;精度
(setq ss_spx (MJ:EntNextAll_G ent_mark))
(command "EXPLODE" ss_spx "")
)
)
;;===================================================
(setq ss_next (MJ:EntNextAll_G ent_mark))
(command "SELECT" ss_next "" )
(if(setq ss (ssget "P" '((0 . "*LINE,ARC,SPLINE")(-4 . "<not")(70 . 1)(-4 . "not>"))))
(progn
(setq entmark(entlast))
(setvar "peditaccept" 1)
(command "_pedit" (ssname ss 0) "J"ss """")
(setq ss1(MJ:EntNextAll_G entmark))
(setq ss(ssuni ss ss1))
(command "_pedit" "m" ss "" "join" "J" "E" "0.0005" "")
)
(princ"\n未选择对象，请重试")
)
;;===================================================连成多段线
)
)
)
(if (setq ss2(MJ:EntNextAll_G ent_mark0))
(progn
(command "SELECT" ss2 "" )
(sssetfirst ss2 ss2)
)
)
)
(princ "\n 请选择 region 或 PLANESURFACE")
)
(princ)
)
;;;======================选择集与对象名表互转
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
;;;======================函数取得en之后生成的所有图元的选择集
(defun MJ:EntNextAll_G (EN / LST)
(if EN
(while (setq EN (entnext EN))
(if (not (member (cdr (assoc 0 (entget EN)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(setq LST (cons EN LST))
)
)
(ssget "_X")
)
(ss-enlst(reverse LST))
)
;;;======================选集相加
(defun ssuni (ss1 ss2 / i res)
(setq i 0)
(repeat (sslength ss2)
(ssadd (ssname ss2 i) ss1)
(setq i (1+ i))
)
(setq res ss1)
)
(defun c:TT (/ *error* arcbugle acdoc space
ss n reg norm expl olst
blst dlst plst tlst blg pline
)
(vl-load-com)
;;;***************************************************************;;;
(defun *error* (msg)
(if (/= msg "Function cancelled")
(princ (strcat "\nError: " msg))
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ)
)
;;;***************************************************************;;;
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace acdoc)
(vla-get-ModelSpace acdoc)
)
)
(if (ssget '((0 . "REGION")))
(progn
(vla-StartUndoMark acdoc)
(vlax-for reg (setq ss (vla-get-ActiveSelectionSet acdoc))
(setq norm (vlax-get reg 'Normal)
expl (vlax-invoke reg 'Explode)
)
(if (vl-every '(lambda (x)
(or
(= (vla-get-ObjectName x) "AcDbLine")
(= (vla-get-ObjectName x) "AcDbArc")
)
)
expl
)
(progn
(vla-delete reg)
(setq olst (mapcar '(lambda (x)
(list x
(vlax-get x 'StartPoint)
(vlax-get x 'EndPoint)
)
)
expl
)
)
(while olst
(setq blst nil)
(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
(setq blst (list (cons 0 (arcbulge (caar olst)))))
)
(setq plst (cdar olst)
dlst (list (caar olst))
olst (cdr olst)
)
(while
(setq
tlst
(vl-member-if
'(lambda (x)
(or (equal (last plst) (cadr x) 1e-9)
(equal (last plst) (caddr x) 1e-9)
)
)
olst
)
)
(if (equal (last plst) (caddar tlst) 1e-9)
(setq blg -1)
(setq blg 1)
)
(if
(= (vla-get-ObjectName (caar tlst)) "AcDbArc")
(setq
blst
(cons (cons (1- (length plst))
(* blg (arcbulge (caar tlst)))
)
blst
)
)
)
(setq plst (append plst
(if (minusp blg)
(list (cadar tlst))
(list (caddar tlst))
)
)
dlst (cons (caar tlst) dlst)
olst (vl-remove (car tlst) olst)
)
)
(setq pline
(vlax-invoke
Space
'addLightWeightPolyline
(apply 'append
(mapcar '(lambda (x)
(setq x (trans x 0 Norm))
(list (car x) (cadr x))
)
(reverse (cdr (reverse plst)))
)
)
)
)
(vla-put-Closed pline :vlax-true)
(mapcar
'(lambda (x) (vla-setBulge pline (car x) (cdr x)))
blst
)
(vla-put-Elevation
pline
(caddr (trans (car plst) 0 Norm))
)
(vla-put-Normal pline (vlax-3d-point Norm))
(mapcar 'vla-delete dlst)
)
)
(mapcar 'vla-delete expl)
)
)
(vla-delete ss)
(vla-EndUndoMark acdoc)
)
)
(princ)
) 老师您好：
我做一个三角形实体测试，用您程序无法处理这些三维面域
命令行提示如下
提取面域和平面曲面边界（多段线）
选择对象: 找到 1 个
选择对象:要连接的直线必须与多段线共面要连接的直线必须与多段线共面要连接的直线必须与多段线共面
斜面四边形面域只出了三个边线
垂直面的三角度形虽出了三根线，但都是分开的不是一个整体
请您试试指教
谢谢您
不错很好用三维命令的确可以增强功能 唯一的缺点就是速度方面 学些下隐藏的好东西 谢谢！ 学些下隐藏的好东西 谢谢
学些下隐藏的好东西 谢谢 回复看一下隐藏的东西
谢谢分享！ 看看先好不好用 学习一下。 学习一下。 学习下楼主的好方法