Developper rapidement une spline 3d routine .lsp pour autocad

cette routine permet de créer un devellopement à partir d'une spline 3d et d'obtenir tout cela sous forme de graphique avec coordonnées X et Y.
Pour l'utiliser, coller le code qui suit dans le bloc notes, puis l'enregistrer en "devxz.lsp"
Dans autocad, taper "appload" et charger le fichier précédemment créé.
ensuite commande "devxz", il faudra selectionner la spline 3d et les points qui sont dessus, puis on obtient un joli développement à plat de la courbe!
permet de gagner beaucoup de temps!

;; DEVXZ_v5.lsp - profil developpe d'une spline 3D
;; X = longueur cumulee de la projection XY de la spline
;; Y = altitude Z relative au Z minimum des POINT selectionnes
(vl-load-com)

(defun dx3:xylen (a b)
(sqrt (+ (expt (- (car b) (car a)) 2.0)
(expt (- (cadr b) (cadr a)) 2.0))))

(defun dx3:interpol (u tab / a b f)
;; tab = ((parametre distance) ...), croissant en parametre
(cond
((<= u (car (car tab))) (cadr (car tab)))
((>= u (car (last tab))) (cadr (last tab)))
(T
(while (and (cdr tab) (> u (car (cadr tab))))
(setq tab (cdr tab)))
(setq a (car tab) b (cadr tab))
(if (equal (car a) (car b) 1e-12)
(cadr a)
(progn
(setq f (/ (- u (car a)) (- (car b) (car a))))
(+ (cadr a) (* f (- (cadr b) (cadr a)))))))))

(defun dx3:line (a b)
(entmakex (list '(0 . "LINE") (cons 8 (getvar "CLAYER"))
(cons 10 a) (cons 11 b))))

(defun dx3:circle (p r)
(entmakex (list '(0 . "CIRCLE") (cons 8 (getvar "CLAYER"))
(cons 10 p) (cons 40 r))))

(defun dx3:text (p h s)
(entmakex (list '(0 . "TEXT") (cons 8 (getvar "CLAYER"))
(cons 10 p) (cons 40 h) (cons 1 s))))

(defun dx3:graphpoint (base angleX x y)
(list (+ (car base) ( x (cos angleX)) ( y (- (sin angleX))))
(+ (cadr base) ( x (sin angleX)) ( y (cos angleX)))
(caddr base)))

(defun dx3:spline (pts / args result)
;; Dessiner la spline avec la commande native AutoCAD.
;; Chaque point SCG est converti en SCU pour la commande.
(setq args (append
(list "_.SPLINE")
(mapcar '(lambda (pt) (trans pt 0 1)) pts)
(list "" "" "")))
(setq result (vl-catch-all-apply 'vl-cmdf args))
(if (vl-catch-all-error-p result)
(progn
(prompt (strcat "\nEchec creation spline : "
(vl-catch-all-error-message result)))
nil)
T))

(defun c:DEVXZ (/ error oldcmd phase ent obj ss n i en p cp prm
u0 u1 k u cur prev cum tab raw sorted item
x z zmin zmax pts total baseU dirU base dir ang
h vscale graphpts gp clean lastp idx endp)
(setq oldcmd (getvar "CMDECHO") phase "initialisation")
(defun error (msg)
(setvar "CMDECHO" oldcmd)
(if (and msg (not (wcmatch (strcase msg) "CANCEL,QUIT,EXIT")))
(prompt (strcat "\nErreur DEVXZ, etape [" phase "] : " msg)))
(princ))
(setvar "CMDECHO" 0)
(setq phase "selection spline")
(setq ent (car (entsel "\nSelectionner la spline 3D : ")))
(cond
((null ent) (prompt "\nAucune spline selectionnee."))
((/= (cdr (assoc 0 (entget ent))) "SPLINE")
(prompt "\nL'objet selectionne n'est pas une SPLINE."))
(T
(setq obj (vlax-ename->vla-object ent)
u0 (vlax-curve-getStartParam obj)
u1 (vlax-curve-getEndParam obj))
(setq phase "selection POINT")
(prompt "\nSelectionner les objets POINT sur la spline : ")
(setq ss (ssget '((0 . "POINT"))))
(if (and ss (>= (sslength ss) 2))
(progn
(setq phase "lecture POINT")
(setq raw nil i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
p (cdr (assoc 10 (entget en)))
;; POINT stocke ses coordonnees en SCG
cp (vlax-curve-getClosestPointTo obj p)
prm (vlax-curve-getParamAtPoint obj cp))
(setq raw (cons (list prm (caddr p)) raw)
i (1+ i)))
(setq sorted (vl-sort raw '(lambda (a b) (< (car a) (car b)))))
(initget 6)
(setq n (getint "\nNombre de segments de calcul <3000> : "))
(if (null n) (setq n 3000))
(if (< n 100) (setq n 100))
(setq phase "echantillonnage XY")
(setq tab nil cum 0.0 prev nil k 0)
(repeat (1+ n)
(setq u (+ u0 ( (- u1 u0) (/ (float k) n)))
cur (vlax-curve-getPointAtParam obj u))
(if (not (and (listp cur) (numberp (car cur))
(numberp (cadr cur))))
(progn
(prompt (strcat "\nPoint spline invalide a l'echantillon " (itoa k)))
(exit)))
(if prev (setq cum (+ cum (dx3:xylen prev cur))))
(setq tab (cons (list u cum) tab)
prev cur
k (1+ k)))
(setq tab (reverse tab) total cum)
(setq phase "interpolation des abscisses")
(setq pts nil zmin nil zmax nil)
(foreach item sorted
(setq x (dx3:interpol (car item) tab)
z (cadr item))
(setq pts (cons (list x z) pts))
(if (or (null zmin) (< z zmin)) (setq zmin z))
(if (or (null zmax) (> z zmax)) (setq zmax z)))
(setq pts (reverse pts))
(setq phase "position du graphique")
(setq baseU (getpoint "\nOrigine du graphique : "))
(if baseU
(progn
(setq dirU (getpoint baseU "\nDirection de l'axe X : "))
(if dirU
(progn
(setq base (trans baseU 1 0)
dir (trans dirU 1 0)
ang (angle base dir))
(initget 6)
(setq h (getreal "\nHauteur du texte <2.5> : "))
(if (null h) (setq h 2.5))
(initget 6)
(setq vscale (getreal "\nAmplification verticale <1.0> : "))
(if (null vscale) (setq vscale 1.0))
(setq phase "creation graphique")
(setq graphpts nil)
(foreach item pts
(setq gp (dx3:graphpoint base ang
(car item)
( (- (cadr item) zmin) vscale)))
(setq graphpts (cons gp graphpts)))
(setq graphpts (reverse graphpts))
(setq phase "creation axes")
(setq endp (dx3:graphpoint base ang total 0.0))
(dx3:line base endp)
(dx3:line base (dx3:graphpoint base ang 0.0
( (- zmax zmin) vscale)))
(setq phase "preparation spline profil")
(setq clean nil lastp nil)
(foreach gp graphpts
(if (or (null lastp) (> (distance gp lastp) 1e-8))
(setq clean (cons gp clean)
lastp gp)))
(setq clean (reverse clean))
(if (>= (length clean) 2)
(progn (setq phase "creation spline profil") (dx3:spline clean))
(prompt "\nImpossible de tracer la spline : points confondus."))
(setq phase "creation hauteurs et reperes")
(foreach item pts
(setq gp (dx3:graphpoint base ang
(car item) ( (- (cadr item) zmin) vscale)))
(dx3:line (dx3:graphpoint base ang (car item) 0.0) gp))
(setq phase "creation cercles et numeros")
(setq idx 1)
(foreach gp graphpts
(dx3:circle gp ( h 0.15))
(dx3:text (dx3:graphpoint gp ang 0.0 ( h 0.8))
h (itoa idx))
(setq idx (1+ idx)))
(setq phase "creation annotations")
(dx3:text (dx3:graphpoint base ang 0.0 ( -3.0 h))
h (strcat "Z reference = " (rtos zmin 2 3)))
(dx3:text (dx3:graphpoint endp ang 0.0 ( -3.0 h))
h (strcat "Longueur XY = " (rtos total 2 3)))
(prompt (strcat "\nDEVXZ termine. Longueur projetee XY = "
(rtos total 2 3) " ; Z min = "
(rtos zmin 2 3) " ; Z max = "
(rtos zmax 2 3) " ; amplitude graphique = "
(rtos (* (- zmax zmin) vscale) 2 3) " ; "
(itoa (length graphpts)) " points.")))
(prompt "\nDirection annulee.")))
(prompt "\nOrigine annulee.")))
(prompt "\nSelectionner au moins deux POINT."))))
(setvar "CMDECHO" oldcmd)
(princ))

+

+