Wie jedes Jahr gibt's ein kleines Geschenk von mir, und passend zur Nachfrage ein paar Threads weiter unten ist es diesmal die Funktion CURVE->POLY, die Polylinien mit Bögen, kurvenangepasste Polylinien, Splines, Kreise und Kreisbögen, Ellipsen und Ellipsenbögen durch Polylinien mit geraden Liniensegmenten annähert.
In der globalen Variablen AT:CURVE->POLY-ACCURACY steht die Genauigkeit, mit der die Segmentierung erfolgt. Die muss an die bestehenden Verhältnisse angepasst werden.
In der globalen Variablen AT:OLDOSMODE wird der alte Objektfangmodus gesichert.
Code:
(vl-load-com)(defun curve->poly (en / ACCURACY el
closedflag lastent len vertexnumber
stparam endparam diffparam startpt
endpt
)
(if (not AT:CURVE->POLY-ACCURACY)
(setq AT:CURVE->POLY-ACCURACY 0.01)
)
(setq ACCURACY AT:CURVE->POLY-ACCURACY)
(if (= 'ENAME (type en))
(progn (setq el (entget en)
en (vlax-ename->vla-object en)
)
)
(progn (setq el (entget (vlax-vla-object->ename en))))
)
(if (and (assoc 70 el) (logand 1 (cdr (assoc 70 el))))
(setq closedflag T)
)
(setq lastent (entlast))
(if (vlax-property-available-p en 'Length)
(setq len (vlax-get-property en 'Length))
(progn
(setq
len (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))
)
;; Ellipsenbögen liefern vlax-curve-getDistAtParam = 0 aus:
(if (= 0.0 len)
(setq len (vlax-curve-getDistAtParam en 1.0))
)
)
)
(setq vertexnumber (fix (/ len ACCURACY)))
(if (= 0 vertexnumber)
(setq vertexnumber 1)
)
(setq stparam (vlax-curve-getstartparam en)
endparam (vlax-curve-getendparam en)
diffparam (/ (- endparam stparam) (float vertexnumber))
startpt (trans (vlax-curve-getStartPoint en) 0 1)
endpt (trans (vlax-curve-getEndPoint en) 0 1)
)
(deactivate-osmode)
(command "._pline" startpt)
(while (< (+ stparam diffparam) endparam)
(setq stparam (+ stparam diffparam))
(setq startpt (vlax-curve-getPointAtParam en stparam))
(command (trans startpt 0 1))
)
(if (= 1 closedflag)
(command "_cl")
(command endpt "")
)
(restore-osmode)
(if (not (eq (entlast) lastent))
(entlast)
)
)
(defun deactivate-osmode ()
(if (not AT:OLDOSMODE)
(setq AT:OLDOSMODE (getvar "osmode"))
)
(if (not (or (= 0 AT:OLDOSMODE)
(< 16384 AT:OLDOSMODE)
)
)
(setvar "osmode" (+ 16384 AT:OLDOSMODE))
)
)
(defun restore-osmode ()
(if AT:OLDOSMODE
(setvar "osmode" AT:OLDOSMODE)
)
)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP