lilq_78 发表于 2011-12-24 14:05:09

面域求差集

(defun c:mreg ()
(vl-load-com)
(setq*Obj (vlax-get-acad-object)
*Doc (vla-get-activeDocument *Obj)
*MSp (vla-get-Modelspace *Doc)
)
(princ "\n选择生成面域的多段线: ")
(setq plss (ssget))
(setqpli0
dei0
plcount(sslength plss)
objsnil
)
(repeat plcount
    (setq ent (ssname plss pli))
    (setq object (vlax-ename->vla-object ent))
    (setq pb (vla-get-closed object))
    (if(= pb :vlax-true)
      (setq objs (cons object objs))
    )
    (setq pli (1+ pli))
)
(setqcurves (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)))
(setqregobjs
   (vl-sort
   regobjs
   '(lambda (s1 s2) (> (vla-get-area s1) (vla-get-area s2)))
   )
)

)求出了面域的集合regobjs，如何求差集？

mychenhan 发表于 2023-3-15 14:18:09

这个有用，好好学习一下

nzl1116 发表于 2011-12-24 15:34:24

(vla-boolean obj1 acSubtraction obj2)

lilq_78 发表于 2011-12-24 16:13:05

谢谢！

logitechlike 发表于 2011-12-24 18:09:52

(vla-Boolean Object Operation Object2)
3DSolid 或　Region 对象之间的布尔运算　(并集、交集、差集)
acUnion : 执行并集运算
acIntersection : 执行交集运算
acSubtraction:执行差集运算

lilq_78 发表于 2011-12-26 10:28:45

太感谢啦！

tanle2020 发表于 2012-7-15 01:21:33

obj2如果有很多图元怎么办

lilq_78 发表于 2012-7-21 10:36:54

本帖最后由 lilq_78 于 2012-7-21 10:38 编辑

(defun c:mreg (/ reg_ss s0 sss count i obj_ss reg_count obj_ss reg_i reg_j kword reg_obj reg_obj1 reg_obj_area reg_obj_area1 new_obj_area)
(setq reg_ss (ssget))
(setq s0 (ssadd))
(setq sss (entlast))
(command "region" reg_ss "")
(while (setq sss (entnext sss))
    (if      (not (member (cdr (assoc 0 (entget sss)))
                     '("region")
             )
      )
      (ssadd sss s0)
    )
)
(setq      count(sslength s0)
      i      0
      obj_ss nil
)
(while (> count i)
    (setq ent (ssname s0 i))
    (setq obj (vlax-ename->vla-object ent))
    (setq obj_ss (cons obj obj_ss))
    (setq i (1+ i))
)

(setq      reg_count (length obj_ss)
      reg_i          1
      reg_j          1
)
(setq      obj_ss
         (vl-sort
         obj_ss
         '(lambda (s1 s2)
            (> (vla-get-area s1)
               (vla-get-area s2)
            )
            )
         )
)
(while (< reg_i reg_count)
    (setq reg_obj (nth (- reg_i 1) obj_ss))
    (setq reg_obj_area (vla-get-area reg_obj))
    (while (< reg_j reg_count)
      (setq reg_obj1 (nth reg_j obj_ss))
      (setq reg_obj_area1 (vla-get-area reg_obj1))
      (command "undo" "m")
      (vla-boolean reg_obj acunion reg_obj1)
      (setq new_obj_area (vla-get-area reg_obj))
      (command "undo" "b")
      (if (= new_obj_area reg_obj_area)
      (progn
          (vla-boolean reg_obj acSubtraction reg_obj1)
          (setq obj_ss (vl-remove reg_obj1 obj_ss))
          (setq      obj_ss
               (vl-sort
                   obj_ss
                   '(lambda (s1 s2)
                      (> (vla-get-area s1)
                         (vla-get-area s2)
                      )
                  )
               )
          )
          (setq      reg_count (length obj_ss)
                reg_i          0
          )
          (setq reg_j reg_count)
      )
      )
      (setq reg_j (1+ reg_j))
    )
    (setq reg_i (1+ reg_i))
    (setq reg_j reg_i)
)
(setq
    kword (strcase
            (getstring "\n是否做成并集（Y/N）： <N>")
          )
)
(if (= kword nil)
    (setq kword "N")
)
(setq union_reg 1)
(setq union_obj (nth 0 obj_ss))
(if (= kword "Y")
    (progn
      (while (< union_reg reg_count)
      (setq union_obj1 (nth union_reg obj_ss))
      (vla-boolean union_obj acunion union_obj1)
      (setq union_reg (1+ union_reg))
      )
    )
)
)


这是我修改后的程序，与各位共享。

hehoubin 发表于 2012-11-25 22:53:31

不能差集和交集

hehoubin 发表于 2012-11-25 22:59:17

hehoubin 发表于 2012-11-25 22:59:53

要做到样在功能就好了。
页: [1] 2
查看完整版本: 面域求差集