在两个对象内尝试此拾取。您可能需要注意选择两个具有正交等的点。
- ; Create two paralell lines between two objects
- ; by crossing objects
- ; By Alan H Sep 2017
- (defun c:brid ( / pt1 pt2pt3 pt4 ss obj1 obj3 obj4)
- (setq oldsnap (getvar "osmode"))
- (setvar "osmode" 0)
- (setq pt1 (getpoint "pick inside pt1"))
- (while (/= (setq pt2 (getpoint pt1 "pick inside pt2")) nil)
- (setq ss (ssget "f" (list pt1 pt2)))
- (if (and (/= ss nil)(< 3 (sslength ss)))
- (progn
- (alert "do again more than two objects")(exit)
- ))
- (setq obj1 (vlax-ename->vla-object (ssname ss 0)))
- (setq obj2 (vlax-ename->vla-object (ssname ss 1)))
- (command "line" pt1 pt2 "")
- (setq obj3 (entlast))
- (command "offset" 2.5 obj3 (polar pt1 (+ (/ pi 2.0)(angle pt1 pt2)) 5) "")
- (setq obj4 (vlax-ename->vla-object (entlast)))
- (setq pt3 (vlax-invoke obj1 'intersectWith obj4 acExtendThisEntity))
- (setq pt4 (vlax-invoke obj2 'intersectWith obj4 acExtendThisEntity))
- (vla-delete obj4)
- (command "line" pt3 pt4 "")
- (setq obj5 (entlast))
- (command "offset" 2.5 obj3 (polar pt1 (+ (/ pi 2.0)(angle pt2 pt1)) 5) "")
- (setq obj4 (vlax-ename->vla-object (entlast)))
- (setq pt5 (vlax-invoke obj1 'intersectWith obj4 acExtendThisEntity))
- (setq pt6 (vlax-invoke obj2 'intersectWith obj4 acExtendThisEntity))
- (vla-delete obj4)
- (command "line" pt5 pt6 "")
- (setq obj6 (entlast))
- (vla-delete (vlax-ename->vla-object obj3))
- (command "trim" obj5 obj6 "" "f" pt1 pt2 "" "")
- (setvar 'osmode oldsnap)
- (setq pt1 pt2)
- )
- (princ)
- )
|