【面域】面域转多段线 region to PLINE

1028695446

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)
)

ynhh

老师您好：

我做一个三角形实体测试，用您程序无法处理这些三维面域
命令行提示如下


提取面域和平面曲面边界（多段线）
选择对象: 找到 1 个
选择对象:  要连接的直线必须与多段线共面要连接的直线必须与多段线共面要连接的直线必须与多段线共面


斜面四边形面域只出了三个边线
垂直面的三角度形虽出了三根线，但都是分开的不是一个整体
请您试试指教

谢谢您

guosheyang

不错很好  用三维命令的确可以增强功能   唯一的缺点就是速度方面

guosheyang

学些下隐藏的好东西   谢谢！

foer123

学些下隐藏的好东西   谢谢

xj6019

学些下隐藏的好东西   谢谢

p-3-ianlcc

回复看一下隐藏的东西
谢谢分享！

mpk023

看看先好不好用

Linxian1028

学习一下。

fxlt619

学习一下。

tigcat

学习下楼主的好方法