Hello from France
Welcome to the Autodesk / AutoCAD Forums !
Maybe this nice french routine "SPL2PL" from Gilles (gile) could help you !?
Please Test - Load this VLisp routine with the command: APPLOAD <Enter>
And then launch it with the command: SPL2PL <Enter>
Regards, Patrice
A few translations :
Spécifiez la longueur minimum des segments:
>>> Specify minimum length of segments:
Supprimer la spline ? [Oui/Non] <Oui>:
>>> Delete/Erase the original Spline:
Spécifiez la longueur de segment minimale:
>>> Specify the minimum length for the segment:
;; SplineToPline (gile) 10/02/08
;; Crée une polyligne à partir d'une spline.
;; La polyligne est constituée exclusivement de segments en arc de cercle.
;; La longueur de chaque segment est calculée en fonction des changements
;; de courbure de la spline et de la longueur minimale des segments.
;;
;; Arguments
;; spl : le nom d'entité de la spline (ename)
;; seg : la longueur minimale des segments (entier ou réel)
(defun SplineToPline (spl seg / ent dis nor len ptg1
pto1 elv lsto deriv1 n loop ptg2 pto2
deriv2 ang blst pl
)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(and (= (type spl) 'VLA-OBJECT)
(setq spl (vlax-vla-object->ename spl)
ent T
)
)
(setq nor (cdr (assoc 210 (entget spl)))
len (vlax-curve-getDistAtParam spl (vlax-curve-getEndParam spl))
seg (/ len (fix (/ len seg)))
dis seg
ptg1 (vlax-curve-getPointAtDist spl 0)
pto1 (trans ptg1 0 nor)
elv (caddr pto1)
lsto (cons pto1 lsto)
deriv1 (angle '(0 0)
(trans (vlax-curve-getFirstDeriv
spl
(vlax-curve-getParamAtPoint spl ptg1)
)
0
nor
)
)
n 0
)
(while (< dis len)
(setq loop T)
(while loop
(if (and (< dis len)
(setq ptg2 (vlax-curve-getPointAtDist spl dis))
(setq pto2 (trans ptg2 0 nor))
(equal (- (setq deriv2
(angle
'(0 0)
(trans (vlax-curve-getFirstDeriv
spl
(vlax-curve-getParamAtPoint spl ptg2)
)
0
nor
)
)
)
(setq ang (angle pto1 pto2))
)
(- ang deriv1)
0.01
)
)
(setq dis (+ dis seg))
(setq loop nil)
)
)
(setq lsto (cons pto2 lsto)
blst (cons (cons n (tan (/ (- ang deriv1) 2.0))) blst)
ptg1 ptg2
pto1 pto2
deriv1 deriv2
dis (+ dis seg)
n (1+ n)
)
)
(setq lsto (cons (trans (vlax-curve-getEndPoint spl) 0 nor) lsto)
blst (cons
(cons
n
(tan
(/ (- (angle (cadr lsto) (car lsto))
(angle '(0 0)
(trans
(vlax-curve-getFirstDeriv
spl
(vlax-curve-getParamAtPoint spl ptg1)
)
0
nor
)
)
)
2.0
)
)
)
blst
)
lsto (reverse (mapcar '(lambda (p) (list (car p) (cadr p)))
(if (vlax-curve-isClosed spl)
(cdr lsto)
lsto
)
)
)
)
(setq pl (vlax-invoke
(vla-get-ModelSpace *acdoc*)
'addLightWeightPolyline
(apply 'append lsto)
)
)
(mapcar '(lambda (x) (vla-setBulge pl (car x) (cdr x)))
blst
)
(if (vlax-curve-IsClosed spl)
(vla-put-Closed pl :vlax-true)
)
(vla-put-Normal pl (vlax-3d-point nor))
(vla-put-Elevation pl elv)
(vla-getXData (vlax-ename->vla-object spl) "" 'typ 'val)
(and typ (vla-setXData pl typ val))
(if (not ent)
(vlax-vla-object->ename pl)
pl
)
)
;; Tan
;; Retourne la tangente de l'angle
(defun tan (a) (/ (sin a) (cos a)))
;; SPL2PL
;; Fonction principale
(defun c:spl2pl (/ spl seg loop)
(vl-load-com)
(while (not
(and
(setq spl (car (entsel "\nSélectionnez une spline: ")))
(= (cdr (assoc 0 (entget spl))) "SPLINE")
(vlax-curve-IsPlanar spl)
)
)
)
(setq loop T)
(while loop
(initget 7)
(setq seg (getdist "\nSpécifiez la longueur minimum des segments: "))
(SplineToPline spl seg)
(initget "Oui Non")
(if (= (getkword "\nConserver le résultat ? [Oui/Non] <Oui>: ")
"Non"
)
(entdel (entlast))
(setq loop nil)
)
)
(initget "Oui Non")
(if (/= (getkword "\nSupprimer la spline ? [Oui/Non] <Oui>: ")
"Non"
)
(entdel spl)
)
(princ)
)
(defun c:polyspline (/ seg spl)
(initget 7)
(and
(setq seg (getdist "\Spécifiez la longueur de segment minimale: "))
(vl-cmdf "_.spline")
(while (/= 0 (getvar "CMDACTIVE"))
(vl-cmdf pause)
)
(setq spl (entlast))
(SplineToPline (entlast) seg)
(entdel spl)
)
(princ)
)
Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks
Patrice BRAUD
