明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 7297|回复: 102

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

  [复制链接]
发表于 2022-10-1 13:16 | 显示全部楼层 |阅读模式
本帖最后由 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)
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 2明经币 +2 金钱 +20 收起 理由
cjh20088 + 1 + 10 赞一个!
tigcat + 1 + 10 很给力!

查看全部评分

本帖被以下淘专辑推荐:

发表于 2022-11-27 12:07 | 显示全部楼层
(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)
)
发表于 2022-11-1 13:27 | 显示全部楼层
老师您好:

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


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


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

谢谢您


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-10-1 13:31 | 显示全部楼层
不错很好  用三维命令的确可以增强功能   唯一的缺点就是速度方面
发表于 2022-10-1 13:26 | 显示全部楼层
学些下隐藏的好东西   谢谢!
发表于 2022-10-1 13:40 | 显示全部楼层
学些下隐藏的好东西   谢谢
发表于 2022-10-1 13:49 | 显示全部楼层

学些下隐藏的好东西   谢谢
发表于 2022-10-1 14:11 | 显示全部楼层
回复看一下隐藏的东西
谢谢分享!
发表于 2022-10-1 15:12 | 显示全部楼层
看看先好不好用
发表于 2022-10-1 17:08 | 显示全部楼层
学习下楼主的好方法
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 04:29 , Processed in 0.314132 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表