Convertir une spline en polyligne

[(gile)]

Salut,

 

Il existe de nombreuses routines pour transformer des splines en polylignes. La plupart créent une polyligne constituée de nombreux segments droits. Plus ces segments sont courts, donc plus les sommets sont nombreux, plus la polyligne "suit" précisément les courbes de la spline source.

 

Voici un LISP qui crée une polyligne constitués de segments en arc de cercle. La longueur des segments est calculée en fonction des changement de courbure de la spline sans toutefois être inférieure à une longueur minimale.

 

Le LISP contient 2 routines et une fonction d'appel SPL2PL.

L'utilisateur sélectionne une spline, spécifie la longueur minimale pour les segments, une fois la polyligne créée, il peut valider le résultat ou spécifier une autre largeur minimale, enfin, il lui est proposé de conserver ou non la spline source.

 

EDIT : correction d'un dysfonctionnement dans le calcul du bulge du dernier segment dans des SCU non parallèle au SCG

 

;; 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    /	   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)))
 )
 (setq	dis    (float seg)
nor    (cdr (assoc 210 (entget spl)))
len    (vlax-curve-getDistAtParam spl (vlax-curve-getEndParam spl))
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)
 (princ)
)

;; 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] [b]<[/b]Oui>: ")
   "Non"
)
     (entdel (entlast))
     (setq loop nil)
   )
 )
 (initget "Oui Non")
 (if (/= (getkword "\nSupprimer la spline ? [Oui/Non] [b]<[/b]Oui>: ")
  "Non"
     )
   (entdel spl)
 )
 (princ)
) 

[Edité le 10/2/2008 par (gile)]

[Edité le 11/2/2008 par (gile)]

[lili2006]

Bonjour à toutes et tous,

 

ça marche super (gile) !

 

Merci pour cet utilitaire.

[Bred]

Salut,

chez moi ça ne fonctionne pas, désolé....

Commande: spl2pl

Sélectionnez une spline:

Spécifiez la longueur minimum des segments: 0.01

; erreur: type d'argument incorrect: VLA-OBJECT nil

Commande:

[(gile)]

Salut,

 

J'avais oublié de définir *acdoc* (défini chez moi dans le fichier acaddoc.lsp)

 

C'est réparé.

[lili2006]

Bonjour à toutes et tous,

 

Chez moi, ça fonctionne sans avoir redéfini *acdoc* (V2008), bizarre,non ?

[Bred]

Re,

merci (gile) !

 

Chez moi, ça fonctionne sans avoir redéfini *acdoc* (V2008), bizarre,non ?

... c'est que *acdoc* doit être défini dans un autre lisp que tu as, est pas déclaré en variable locale...

 

Si tu tapes !acdoc en ligne de commande, tu dois avoir un retour différent de nil.

 

[goufis]

merci çà marche super et j'en avais vraiment besoin

[philsogood]

hello

j'ai un bug qund j'utilise cette fonction depuis que je suis en V2019

des fois ça amrche et souvent ça amrche aps

quand je précise une longueur pour l'édition de ma PL j'ai ce message qui s'afficeh :

erreur: type d'argument incorrect: numberp: nil

ça vient d'ou??

Phil

[(gile)]

Depuis plusieurs version déjà (2013 ?), l'option Polyligne de la commande native EDITSPLINE (accessible par le menu contextuel quand une spline est sélectionnée) permet de convertir une spline en polyligne et rend donc ce LISP obsolète.

[COME]

Depuis plusieurs version déjà (2013 ?), l'option Polyligne de la commande native EDITSPLINE (accessible par le menu contextuel quand une spline est sélectionnée) permet de convertir une spline en polyligne et rend donc ce LISP obsolète.

 

Merci merci merci beaucoup !

 

Dernièrement j'ai reçu un plan de cheminement piéton avec des splines pour les contours au lieu de polylignes ce qui m'a franchement compliqué la vie pour la poursuite du projet. Maintenant je serai plus serein devant un tel cas de figure.

 

Je confirme pour la V2013 !

[philsogood]

arf... j'avais oublié... mais ton lisp faisait des arcs et c'était plus joli!

bref

merci pour l'info

++

Phil

[(gile)]

arf... j'avais oublié... mais ton lisp faisait des arcs et c'était plus joli!

 

Regarde la variable PLINECONVERTMODE...