本帖最后由 夏生生 于 2022-9-20 16:28 编辑
就是region和boundary的配合应用。
- (defun c:tt(/ )
- (setq en (entlast)
- ss (ssget '((0 . "solid")))
- ss1 (ssadd)
- ss2 (ssadd)
- )
- (command "copy" ss "" '(0 0) '(0 0))
- (while (setq en (entnext en)) (setq ss1 (ssadd en ss1)))
- (setq en (entlast))
- (command "region" ss1 "")
- (while (setq en (entnext en)) (setq ss2 (ssadd en ss2)))
- (command "union" ss2 "")
- (setq ss2 (entlast))
- (vla-getboundingbox (vlax-ename->vla-object ss2) 'pt1 'pt2)
- (setq pt1 (vlax-safearray->list pt1)
- pt2 (vlax-safearray->list pt2)
- pt1 (mapcar '- pt1 '(100 100))
- pt2 (mapcar '+ pt2 '(100 100))
- )
- (command "zoom" pt1 pt2)
- (command "rectangle" pt1 pt2)
- (setq en (entlast)
- area (vla-get-area
- (vlax-ename->vla-object en)
- )
- en1 en
- )
- (command "_.-boundary""_a""_b""_n" ss2 en"""_i""_y""_o""_p"""(mapcar '+ pt1 '(50 50))"")
- (while (< 0 (getvar 'cmdactive)) (command-s ""))
- (while (setq en (entnext en))
- (if (equal area
- (vla-get-area
- (vlax-ename->vla-object en)
- )
- 1e-4
- )
- (entdel en)
- )
- )
- (entdel en1)
- (command "erase" ss2 "")
- (command "erase" ss "");_不保留原型注释此句
- (command"zoom""p")
- )
|