fonte
(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
;; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
;; Alan J. Thompson, 09.29.10
;; http://www.cadtutor.net/forum/showthread.php?73308-Multiple-Offsets&p=535978&viewfull=1#post535978
(vl-load-com)
(defun foo (e)
(and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
(not (vlax-curve-isClosed (car e)))
)
)
(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
(defun _pnts (e / p l)
(if e
(cond ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
(list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
)
((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
(repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
(setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
)
)
)
)
)
(defun _pline (lst)
(if (and (> (length lst) 1)
(entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
(foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
)
(cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
)
)
(defun _lwpline (lst)
(if (> (length lst) 1)
(entmakex (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
(cons 70 (* (getvar 'plinegen) 128))
)
(mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)
)
)
)
)
(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
(if
(and
(setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
(setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
(not (initget 0 "Lwpolyline Polyline"))
(setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <"
(cond (*LBL:Opt*)
((setq *LBL:Opt* "Lwpolyline"))
)
">: "
)
)
)
(*LBL:Opt*)
)
)
)
((if (eq *LBL:Opt* "Lwpolyline")
_lwpline
_pline
)
(vl-remove nil
(mapcar (function (lambda (a b)
(if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
(mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b)
)
)
)
e1
(if (< (_dist (car e1) (car e2))
(_dist (car e1) (last e2))
)
e2
(reverse e2)
)
)
)
)
)
(princ)
)