面域合并

a1093553560

厉害啊 就是不知道怎么加载

hh_lj007

谢谢分享面域合并源码！

543628024

进来看看，有啥不同

s100sp

谢谢，谢谢分享

yaojing38

好用，谢谢分享

qxlonmsn

我一次遇到   REGION ** 在当前版本中此命令被禁止执行。**
就在前辈代码的基础上改进了下

;|
Region 对象之间的布尔运算　(并集、交集、差集)
acUnion : 执行并集运算
acIntersection : 执行交集运算
acSubtraction:  执行差集运算
|;
(princ "\n创建面域:Mreg")
(princ "\n差集命令:Sreg")
(princ "\n并集命令:Ureg")
(princ "\n交集命令:Ireg")
(princ "\n")


;构造面域
(defun c:mreg ( / *Obj *Doc *MSp plss pli dei plcount objs ent object curves regobjs )
  (vl-load-com)
  (if (and
        (princ "\n选择闭合的曲线: ")
        (setq plss (ssget '((0 . "LWPOLYLINE,CIRCLE,SPLINE,ELLIPSE"))))
      );end and
      (progn
        (setq  *Obj (vlax-get-acad-object)
               *Doc (vla-get-activeDocument *Obj)
               *MSp (vla-get-Modelspace *Doc)
        )
        (setq  pli  0
               dei  0
               plcount  (sslength plss)
               objs  nil
        )
        (repeat plcount
          (setq ent (ssname plss pli))
          (setq object (vlax-ename->vla-object ent))
          (if  (vlax-curve-isClosed object)
               (setq objs (cons object objs))
          );end if
          (setq pli (1+ pli))
        )
        (setq  curves (vlax-make-safearray
                        vlax-vbobject
                        (eval '(cons 0 (1- plcount)))
                      )
        )
        (vlax-safearray-fill curves objs)
        (setq regobjs (vla-addregion *Msp curves))
        (repeat plcount
          (setq obj (nth dei objs))
          (vla-delete obj)
          (setq dei (1+ dei))
        )
        (setq regobjs (vlax-safearray->list (vlax-variant-value regobjs)))
        (setq regobjs
          (vl-sort
            regobjs
            '(lambda (s1 s2) (> (vla-get-area s1) (vla-get-area s2)))
          );end vl-sort
        )
        (princ)
      );end progn
  );end if
)


;;面域差集
(defun c:sreg ( / dreg_boj xreg_boj )
  (vl-load-com)
  (if (and
         (princ "\n请选择被减面域:")
         (setq dreg_boj (ssget ":S" '((0 . "REGION"))));大面积
         (princ "\n请选择减去的面域:")
         (setq xreg_boj (ssget  '((0 . "REGION"))));小面积
         (setq dreg_boj (vlax-ename->vla-object (ssname dreg_boj 0)));
         (setq xreg_obj (mapcar 'vlax-ename->vla-object (ss->enamelst xreg_boj)))
         (> (vla-get-area dreg_boj) (apply '+ (mapcar 'vla-get-area xreg_obj)));面积大小合理
      );end and
      (progn
        (foreach n xreg_obj
          (vla-boolean dreg_boj acSubtraction n)
        )
        (princ "\n完成差集运算!")
      );end progn
      (princ "\n未完成差集运算!")
  );end if
)

;面域并集
(defun c:ureg ( / dreg_boj xreg_boj )
  (vl-load-com)
  (if (and
         (princ "\n请选择并集面域:")
         (setq xreg_boj (ssget  '((0 . "REGION"))));
         (setq xreg_obj (mapcar 'vlax-ename->vla-object (ss->enamelst xreg_boj)))
         (setq dreg_boj (car xreg_obj))
         (setq xreg_obj (cdr xreg_obj))
      );end and
      (progn
        (foreach n xreg_obj
          (vla-boolean dreg_boj acUnion n)
        )
        (princ "\n完成并集运算!")
      );end progn
      (princ "\n未完成并集运算!")
  );end if
)

;面域交集
(defun c:Ireg ( / dreg_boj xreg_boj )
  (vl-load-com)
  (if (and
         (princ "\n请选择交集面域:")
         (setq xreg_boj (ssget  '((0 . "REGION"))));
         (setq xreg_obj (mapcar 'vlax-ename->vla-object (ss->enamelst xreg_boj)))
         (setq dreg_boj (car xreg_obj))
         (setq xreg_obj (cdr xreg_obj))
      );end and
      (progn
        (foreach n xreg_obj
          (vla-boolean dreg_boj acIntersection n)
        )
        (princ "\n完成交集运算!")
      );end progn
      (princ "\n未完成交集运算!")
  );end if
)



;;函数名称:        ss->enamelst
;;调用格式:        (ss->enamelst ss)
;;参数说明:        ss是非空选择集
;;返回值:        图元名表
;;函数简介:        将选择集转为表以方便用mapcar操作
(defun ss->enamelst (ss)
    (vl-load-com)
    (vl-remove-if-not
      '(lambda (x) (equal (type x) 'ename))
      (mapcar 'cadr (ssnamex ss))
    )
);;;end defun

(princ)

mzxgj

刚学了一个又一个不错！

dj_521

前来学习前来学习前来学

dyjwyqz5221

看下面域合并

searienon

好东西，楼主辛苦了。

ZJ135016

下来看看再说

hui51001321

666666666666666

bai0371

红红火火恍恍惚惚或或或或或或或或

drshang

666666666666666

hoangcao9999

hay tuyet voiu