Meet Joe Burke's TracePline function

[Anonymous]

Yesterday, Joe Burke rescued me with a routine he calls TracePline. Not
obvious to most lurkers because of the title of that thread (Merging two
lists in the correct place) is the fact that I had been trying to create a
routine that could take a polyline, create a point list from it, then use
that point list for an ssget "cp" or "wp" selection set. My old routine
worked, but uses the Measure command, which, by nature, indiscriminately
places points on a polyline and which points would get erased after
collecting their coordinates into the needed list. Kind of like the
proverbial "bull in a china closet".
Joe's routine smartly defines points at the vertices for straight segments,
then handles the bulges (arcs) by defining either a fine or course series of
points along their perimiters. That, depending on the user's input of
angular degrees. He suggests 10 and it works fine for me. If you're curious
and actually draw the points from the list -- for large arcs you won't see
many points. For small arcs, just the opposite.
Len Miller

;; Joe Burke - 3/25/2006
;; Arguments: obj - the ename or vla-object of a heavy or lightweight pline.
;; deg - the approximate number of degrees between points
;; along an arc. Suggested value: 10.
;; Returns: WCS point list if successful. A 2D point list given a
;; a lightweight pline or a 3D list given a heavy pline.
;; Notes: The number of points returned when tracing an arc is proportional
;; to the included angle.
;; The point list returned eliminates any duplicate points
;; from source pline.
(defun TracePline (obj deg / typ param endparam
endpt startpt pt blg ptlst rep
delta inc arcparam
)
(and
(or
(= (type obj) 'VLA-OBJECT)
(setq obj (vlax-ename->vla-object obj))
)
(setq typ (vlax-get obj 'ObjectName))
(or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
(setq param 0
endparam (vlax-curve-getEndParam obj)
endpt (vlax-curve-getEndPoint obj)
startpt (vlax-curve-getStartPoint obj)
deg (/ 180.0 deg)
)
(cond
;Return nil given a pline which is either a zero length
;line or a 360 degree arc. Both look like a point.
((and
(equal startpt endpt 1e-16)
(= 1 endparam)
)
)
(T
(while (< param endparam)
(setq pt (vlax-curve-getPointAtParam obj param))
(if
(and
(not (equal pt (car ptlst) 1e-8))
(not (equal pt endpt 1e-8))
)
(setq ptlst (cons pt ptlst))
)
(setq blg (abs (vlax-invoke obj 'GetBulge param)))
(if (/= 0 blg)
(progn
(setq delta (* 4 (atan blg)) ;included angle
rep (1+ (fix (/ delta (/ pi deg))))
inc (/ 1.0 rep)
arcparam (+ param inc)
)
(repeat (1- rep)
(setq pt (vlax-curve-getPointAtParam obj arcparam)
ptlst (cons pt ptlst)
arcparam (+ inc arcparam)
)
)
)
)
(setq param (1+ param))
)
)
)
) ;and
(setq ptlst (reverse ptlst))
(if
(or
(= 1 (length ptlst))
(and
(not (equal (car ptlst) endpt 1e-8))
(not (equal (last ptlst) endpt 1e-8))
(not (equal (car ptlst) (last ptlst) 1e-8))
)
)
(setq ptlst (append ptlst (list endpt)))
)
(if (= typ "AcDbPolyline")
(mapcar '(lambda (x) (list (car x) (cadr x))) ptlst)
ptlst
)
) ;end


--
To email reply, eradicate all threes in my SPAM guarded address.