- (defun C:test ( / c e o L )
- (setq c (cdr (assoc 62 (tblsearch "LAYER" (getvar 'clayer)))))
- (setvar 'errno 0)
- (while (/= 52 (getvar 'errno)) ; Lee Mac's structure to prompt for (entsel)
- (setq e (car (nentsel "\nPick text <exit>: ")))
- (cond
- ( (= 7 (getvar 'errno)) (setvar 'errno 0) )
- (e (setq o (vlax-ename->vla-object e))
- (cond
- ( (not (vlax-property-available-p o 'InsertionPoint)) (princ "\nInvalid object.") )
- ( (not (setq L (cons (vlax-get o 'InsertionPoint) L))) )
- ( (<= 2 (length L)) (redraw)
- (grvecs (apply 'append (mapcar '(lambda (a b) (list c a b)) L (cdr L))))
- )
- ); cond
- ); e
- ); cond
- ); while
- (and (<= 2 (length L)) (LWPoly (LM:UniqueFuzz L 1e-3) 0) (redraw))
- (princ)
- ); defun
- ;; Unique with Fuzz - Lee Mac
- ;; Returns a list with all elements considered duplicate to
- ;; a given tolerance removed.
- (defun LM:UniqueFuzz ( l f )
- (if l
- (cons (car l)
- (LM:UniqueFuzz
- (vl-remove-if
- (function (lambda ( x ) (equal x (car l) f)))
- (cdr l)
- )
- f
- )
- )
- )
- )
- (defun LWPoly (lst cls) ; Lee Mac again
- (entmakex
- (append
- (list
- (cons 0 "LWPOLYLINE")
- (cons 100 "AcDbEntity")
- (cons 100 "AcDbPolyline")
- (cons 90 (length lst))
- (cons 70 cls)
- )
- (mapcar (function (lambda (p) (cons 10 p))) lst)
- )
- )
- )