[求助]：有没有可以一次裁剪多个相交圆的LSP ？（见图）

武陵山人

求可以一次裁剪多个相交的圆并将裁剪后的实体自动编组的LSP程序。

ll_j

没有见过这样的程序，应该是没有通用性。如果太复杂，不想一点一点剪，可以试试“面域”“交集”，可能会快一点。

andyhua5240

最初由 武陵山人 发布
[B]求可以一次裁剪多个相交的圆并将裁剪后的实体自动编组的LSP程序。 [/B]

WKAI斑竹的，交点断开，如何？

xyp1964

简单的可以，需改进：
[php];;;外轮廓
(defun c:test (/ pt1 pt2 ss e1 e2)
  (vl-load-com)
  (mkla "外轮廓" 1)
  (setq        pt1 (getpoint "\n窗口点1 : ")
        pt2 (getcorner pt1 "\n对角点 : ")
  )
  (setq ss(ssget"w" pt1 pt2 (list (cons 0 "CIRCLE"))))
  (vl-cmdf ".undo" "BE")
  (COMMAND "rectang" pt1 pt2)
  (setq e1 (entlast))
  (setq pt1 (getpoint "\n内部点 : "))
  (command "_boundary" pt1 "")
  (setq e2 (entlast))
  (vla-erase (vlax-ename->vla-object e1))
  (vla-erase (vlax-ename->vla-object e2))
  (command "erase" ss "")
  (vl-cmdf ".undo" "E")
  (princ)
)
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)
[/php]

andyhua5240

程序不错，有3个问题：
1、建议不要增加“外轮廓”图层
2、不要改变用户的当前层
3、程序运行完后的外轮廓建议不要是个整体，由多个原对象保留下来的线组成？

xyp1964

1、2、3基本解决，但不充分：
[php]
;;;外轮廓
(defun c:test (/ pt1 pt2 ss e1 e2)
  (vl-load-com)
  ;;(mkla "外轮廓" 1)
  (setq        pt1 (getpoint "\n窗口点1 : ")
        pt2 (getcorner pt1 "\n对角点 : ")
  )
  (setq ss (ssget "w" pt1 pt2 (list (cons 0 "CIRCLE"))))
  (vl-cmdf ".undo" "BE")
  (COMMAND "rectang" pt1 pt2)
  (setq e1 (entlast))
  (setq pt1 (getpoint "\n内部点 : "))
  (command "_boundary" pt1 "")
  (setq e2 (entlast))
  (vla-erase (vlax-ename->vla-object e1))
  (vla-erase (vlax-ename->vla-object e2))
  (command "erase" ss "")
  (command "explode" "l" "")
  (vl-cmdf ".undo" "E")
  (princ)
)
[/php]

lsjjm

xyp1064的基本思路不错，先建立一个临时的外轮廓，然后BOUNDARY。 但局限性很大：程序中很难确定角点， 且内部点附近有其他实体时容易出错， 删除原有的轮廓后会丢失数据如不同的图层等等？

LUCAS

先把所有圓轉面域->union->再炸開即可

hi71400

最初由 LUCAS 发布
[B]先把所有圓轉面域->union->再炸開即可 [/B]

能写几句到底怎么弄吗?
没办法俺只会纯LISP,不懂Vlisp,想看看

LUCAS

;;有需要就把它炸開,NO ERROR CHECK
(defun C:TT (/ SS)
  (setq SS (ssget "X"))
  (command "_.REGION" (ssget) "")
  (command "_.SELECT" (ssget "X") "R" SS "")
  (command "_.UNION" "P" "")
  (princ)
)

eachy

增加一句  (vl-cmdf ".pedit" "m" "p" "" "y" "j" "0.1" "");

武陵山人

谢谢各位，问题解决了。我依葫芦画瓢自己组合了一下。还有一个问题：每次转换后程序总会将 t3 设为当前图层，请问该如何设置才能保持原来的当前图层不变？
[PHP]
(defun C:trr (/ SS)
  (mkla "t3" 3)
  (setq SS (ssget "X"))
  (command "_.REGION" (ssget) "")
  (command "_.SELECT" (ssget "X") "R" SS "")
  (command "_.UNION" "P" "")
  (command "explode" "l" )
  (vl-cmdf "_.pedit" "m" "p" "" "y" "j" "0.1" "")
  (princ)
)
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
(princ)
) [/PHP]

狂刀

要改就改个ssget不用“x”的嘛
恢复层，设 “clayer”系统变量

aeo

加个grread,就是理正的插成片树

eachy

2. 
   
3. (defun C:trr (/ SS oldlay)
   
4. (setq oldlay (getvar "clayer"))
   
5. ....
   
6. (setvar "clayer" oldlay)
   
7. (princ)
   
8. )

<br /> (defun C:trr (/ SS oldlay) <br /> (setq oldlay (getvar "clayer")) <br /> ....<br /> (setvar "clayer" oldlay)<br /> (princ)<br /> )