- 积分
- 27451
- 明经币
- 个
- 注册时间
- 2003-8-26
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2012-3-8 23:11:27
|
显示全部楼层
(defun c:fe (/ cmd ss1 ss) ; get all objects touching entities in the sscross
; limited obj types to "line,arc,spline,lwpolyline,polyline,circle,ellipse"
(defun gettouching (sscros / ss lst lstb lstc objl)
(and
(setq lstb (vl-remove-if 'listp (mapcar
'cadr
(ssnamex sscros)
)
)
objl (mapcar
'vlax-ename->vla-object
lstb
)
)
(setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "ctab")))))
(setq lst (vl-remove-if 'listp (mapcar
'cadr
(ssnamex ss)
)
)
)
(setq lst (mapcar
'vlax-ename->vla-object
lst
)
)
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
(vlax-safearray->list (vlax-variant-value
(vla-intersectwith y
x acextendnone
)
)
)
)
)
)
)
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
)
objl
)
)
lst
)
)
lstc
)
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0) ; get objects to break
(setq ss1 (ssadd))
(prompt "\nselect object(s) to break with & press enter: ")
(if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(progn
(command "._undo" "_begin")
(mapcar
'(lambda (x)
(ssadd x ss1)
)
(gettouching ss)
)
(break_with ss ss1 nil)
(command "._undo" "_end")
) ; ssbreak ssbreakwith (flag nil = not to break with self)
)
(setvar "CMDECHO" cmd)
(princ)
)
|
|