Aller au contenu

polyligne 3d avec arc


Messages recommandés

Posté(e)

Salut à tous

Quelqu'un aurais t'il une idée ou une routine lisp pour essiner directement des polylignes 3D comportant des arc ( DESSIN TOPO )

merci d'avance

Pitou 66

(d'haitude je fais avec COVADIS pour éléver en 3D) :cool:

  • Réponses 54
  • Créé
  • Dernière réponse

Meilleurs contributeurs dans ce sujet

Meilleurs contributeurs dans ce sujet

Posté(e)
excuser moi mais mon doigt à chourfé et j'ai oublié le d [surligneur] de dessiner[/surligneur].

Pitou 66

 

Tu n'avais qu'à EDITER ton message !

 

une poly3D avec des arcs !? Ca n'existe pas. Il faudra faire des petits segments. Tu pars de quoi ? D'une poly 2D avec des points d'élévations à rentrer à la main ?

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Posté(e)

Si tu as Covadis, c'est le plus simple pour générer une poly3D segmentée qui se rapprochera le plus d'une forme courbe en 3D. Pour avoir un truc le plus fin possible, tu peux jouer sur la valeur max de la flèche lors de la conversion, que tu trouveras dans plusieurs endroits (CovaSuppArcs par exemple pour une poly2D). ou qd tu transforme une poly fermée en plateforme...

 

Tu peux également dessiner ta poly courbe en 2D (XY), la segmenter avec CovaSuppArcs, en faire un profil en long (cov3D > "profil en long par poly3D") et tracer une poly projet courbe (pour le Z) sur le profil en long et créer à partir de cette poly2D du profil une poly3D vers le levé topo... ("ajouter une courbe au groupe" puis "Courbe => polyligne 3D)...

Formateur Autocad - Revit - Sketchup - Photoshop

Posté(e)

Effectivement j'ai covadis et je remonte les poly2D avec la commande transformation 2D vers

3D avec un arc à 0.01m. je posait la question pour voir si quelqu'un avait cogité quelque chose en lisp.

si quelqu'un avait eu un truc cela m'aurait évité une commande à faire assez souvent.

( je suis un peu fainéant sur les bords )

Pitou 66

:) :) :) :)

Posté(e)

coucou,

 

C'est marrant que tu demandes ça maintenant,

car je suis justement en train de penser à faire quelque chose dans ce sens.

La commande Covadis a le mérite d'exister, mais comme c'est souvent le cas

elle est lourde comme une vache morte,

et je clique ici et je clique là et je reclique ceci et le déclique celà...

 

Je pense que le compère (gile) va nous sortir quelque chose,

c'est bien dans son domaine d'activité de VisualLisp,

dès que j'ai quelque chose je te le propose, mais pas de Visual...

 

de mon côté je pense à demander

le point de départ en 3D

le point de passage en 2D

le point d'arrivée en 3D

le Z du Point de passage sera la moyenne des deux autres.

 

c'est à ça que tu penses ?

 

amicalement

 

Posté(e)

Salut didier

pour moi ce serais mieux d'avoir le point de passage en 3D mais si on peut pas, ton systéme me va bien .

Si (gile) pouvait se pencher la dessus ce serait bien. :) :)

Amicalement

Pitou 66

 

[Edité le 6/11/2006 par pitou66]

Posté(e)

Vous avez bien de la chance que (gile) ait un peu de temps ces jours ci (chômage).

 

Voilà une proposition, je ne sais pas si ça répond à vos attentes mais j'ai essayé de faire polyvalent.

 

Désolé Didier ça dépasse un peu les 10 lignes ;)

 

Edit : j'avais oublié de joindre la routine Norm_3Pts

 

Version 1.2

- ajout de la possibilité d'annuler les derniers points spécifiés 1.1

- reste en option "Ligne" tant que n'est pas spécifée l'option "Arc" et de même en option "Arc" tant que n'est pas spécifée l'option "Ligne" (un peu comme pour les polylignes optimisées).

 

;;; Gile3dPoly -Gilles Chanteau- 17/11/06 -version 1.2-
;;; Créé une polyligne 3D avec "arcs"
;;; Les arcs sont représentés par une succession de segments jointifs
;;; Le nombre de segments pour les arcs est spécifié par l'utilisateur
;;; Les "arcs" sont définis par "3 points" ou "départ centre fin" et
;;; sont décrits dans le plan défini par ces 3 points.

(defun c:Gile3dPoly (/	       3dPolyArc 3dPolyArc_err	     drawvecs
	     segmentundo	 AcDoc	   ModSp     prec
	     p1	       p2	 p3	   opt	     lst
	     cnt       new	 loop1	   loop2
	    )
 (vl-load-com)

 ;;***********************************************************;;

 (defun 3dPolyArc_err (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (redraw)
   (vla-EndUndoMark AcDoc)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;;***********************************************************;;

 (defun drawvecs (lst)
   (setq p1 (last lst))
   (redraw)
   (if	(      (grvecs (apply 'append
	     (mapcar '(lambda (x1 x2)
			(list -255 x1 x2)
		      )
		     (reverse (cdr (reverse lst)))
		     (cdr lst)
	     )
      )
     )
   )
 )

 ;;***********************************************************;;

 (defun segmentundo ()
   (if	(      (progn
(prompt "\nTous les segments ont déjà été annulés.")
     )
     (setq lst	(sublst lst 1 (- (length lst) (car cnt)))
    cnt	(cdr cnt)
     )
   )
 )

 ;;***********************************************************;;

 (defun 3dPolyArc
	   (p1 p2 p3 opt prec / norm mid1 mid2 cen rad ang inc n ptlst)
   (if	(= opt "3")
     (setq norm (norm_3pts p2 p3 p1))
     (setq norm (norm_3pts p2 p1 p3))
   )
   (setq p1 (trans p1 0 norm)
  p2 (trans p2 0 norm)
  p3 (trans p3 0 norm)
   )
   (if	(= opt "3")
     (setq mid1 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2)
    mid2 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p2 p3)
    cen	 (inters mid1
		 (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
		 mid2
		 (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)
		 nil
	 )
     )
     (setq cen p2)
   )
   (setq rad (distance cen p1)
  ang (- (angle cen p3) (angle cen p1))
   )
   (if	(minusp ang)
     (setq ang (+ (* 2 pi) ang))
   )
   (setq inc (/ ang prec)
  n   0
   )
   (repeat prec
     (setq ptlst (cons (polar cen (- (angle cen p3) (* inc n)) rad) ptlst)
    n	  (1+ n)
     )
   )
   (setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst))
 )

 ;;***********************************************************;;

 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (setq	m:err	*error*
*error*	3dPolyArc_err
 )
 (vla-StartUndoMark AcDoc)
 (if (not (vlax-ldata-get "3dPolyArc" "prec"))
   (vlax-ldata-put "3dPolyArc" "prec" 20)
 )
 (prompt (strcat "\nParamètre courant - Nombre de segments par arc: "
	  (itoa (vlax-ldata-get "3dPolyArc" "prec"))
  )
 )
 (while (not (vl-consp p1))
   (initget 1 "Segments")
   (setq
     p1 (getpoint
   "\nSpécifiez le point de départ de la polyligne ou [segments]: "
 )
   )
   (if	(= p1 "Segments")
     (progn
(initget 6)
(if (setq prec
	   (getint
	     (strcat "\nSpécifiez le nombre de segments pour les arcs 			     (itoa (vlax-ldata-get "3dPolyArc" "prec"))
		     ">: "
	     )
	   )
    )
  (vlax-ldata-put "3dPolyArc" "prec" prec)
)
     )
   )
 )
 (setq	prec  (vlax-ldata-get "3dPolyArc" "prec")
lst   (cons p1 lst)
cnt   (cons 1 cnt)
loop1 T
 )
 (while loop1
   (initget "Arc annUler")
   (setq
     p1 (last lst)
     p2 (getpoint p1
	   "\nSpécifiez l'extrémité de la ligne ou [Arc/annUler]: "
 )
   )
   (if	p2
     (progn
(if (= p2 "annUler")
  (segmentundo)
  (if (= p2 "Arc")
    (progn
      (setq loop2 T)
      (while loop2
	(setq p2 p1)
	(while (equal p1 p2 1e-9)
	  (initget "Centre Ligne annUler")
	  (setq	p2
		 (getpoint
		   p1
		   "\nSpécifiez le deuxième point de l'arc ou [Centre/Ligne/annUler]: "
		 )
	  )
	)
	(if p2
	  (if (= p2 "Ligne")
	    (setq loop2 nil)
	    (if	(= p2 "annUler")
	      (progn
		(segmentundo)
		(drawvecs lst)
	      )
	      (progn
		(if (= p2 "Centre")
		  (progn
		    (setq p2 p1)
		    (while (equal p2 p1)
		      (initget 1)
		      (setq
			p2
			 (getpoint p1
				   "\tSpécifiez le centre de l'arc: "
			 )
		      )
		    )
		    (setq opt "c")
		  )
		  (setq opt "3")
		)
		(setq p3 p2)
		(while (equal p2 p3)
		  (initget 1 "annUler")
		  (setq
		    p3
		     (getpoint p2 "\nSpécifiez l'extrémité de l'arc: ")
		  )
		)
		(setq new (3dPolyArc (last lst) p2 p3 opt prec)
		      lst (append lst new)
		      cnt (cons (length new) cnt)
		)
		(drawvecs lst)
	      )
	    )
	  )
	  (setq	loop2 nil
		loop1 nil
	  )
	)
      )
    )
    (setq lst (append lst (list p2))
	  cnt (cons 1 cnt)
    )
  )
)
(drawvecs lst)
     )
     (setq loop1 nil)
   )
 )
 (if (    (vlax-invoke ModSp
	 'add3dPoly
	 (apply 'append (mapcar '(lambda (p) (trans p 1 0)) lst))
   )
 )
 (redraw)
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;***********************************************************;;


;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points

(defun norm_3pts (org xdir ydir / norm)
 (foreach v '(xdir ydir)
   (set v (mapcar '- (eval v) org))
 )
 (if (inters org xdir org ydir)
   (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm)))
    (setq norm (list (-	(* (cadr xdir) (caddr ydir))
			(* (caddr xdir) (cadr ydir))
		     )
		     (-	(* (caddr xdir) (car ydir))
			(* (car xdir) (caddr ydir))
		     )
		     (-	(* (car xdir) (cadr ydir))
			(* (cadr xdir) (car ydir))
		     )
	       )
    )
   )
 )
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)

(defun sublst (lst start leng / rslt)
 (if (not (    (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

[Edité le 7/11/2006 par (gile)][Edité le 16/11/2006 par (gile)]

 

[Edité le 17/11/2006 par (gile)]

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Avec une version récente de Covadis (je sais plus quand, peut être as-tu une version ancienne), est apparue un petit menu contextuel "Opérations 2D/3D".

 

Bouton droit sur une polyligne donne ça :

 

http://xs108.xs.to/xs108/06452/menup2-3D.jpg

 

ce qui fait que je dessine une polyligne (z=0 ou pas) passant (en xy) par des points topo par exemple, je fais bouton droit dessus, je choisis dans ce petit menu "Convertir en poly3D" >> "Altitudes des points topos" et hop ! ça me projette ma poly en 3D en s'interpolant à chaque fois entre chaque point topo.

 

ici la poly initiale a le Z du 1er point topo à droite (2205.05), j'ai relié par des lignes bleues les point topos à la poly d'origine pour que ça ressorte mieux.

on obtient une poly3D composée de petits segments droits, ici en vert, qui est issue d'une poly à segments arc.

 

http://xs108.xs.to/xs108/06452/vuepoly3.jpg

Formateur Autocad - Revit - Sketchup - Photoshop

Posté(e)

Plus elle est pentue et plus elle tend vers le noir ? Rapport au niveau de ski !

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Posté(e)
Vous avez bien de la chance que (gile) ait un peu de temps ces jours ci (chômage).

Je suis triste de l'apprendre.

Je te souhaite toutes la chance que tu mérites pour ton emplois futur !

Bon courage.

 

 

 

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Posté(e)

Je suis triste de l'apprendre.

Je te souhaite toutes la chance que tu mérites pour ton emplois futur !

Bon courage.

 

Je te remercie, mais ne te fais pas de souci, ma vie professionnelle a toujours été une alternance de périodes chômées et de périodes salariées et je m'en accommode.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Je pense que le compère (gile) va nous sortir quelque chose

Si (gile) pouvait se pencher la dessus ce serait bien.

 

(gile) s'est penché dessus et a sorti quelque chose.

 

Aussi, j'aurais bien aimé avoir un petit retour, je n'attends pas des remerciements élogieux mais juste savoir si ça répond à la demande, ce qu'il faudrait éventuellement changer ou même si, finalement, Covadis le fait très bien.

N'étant ni géomètre ni topographe je ne suis pas sûr d'avoir compris l'utilisation qui peut en être faite.

 

Merci d'avance...

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Désolé (gile) mais je n'ai pas eu le temps de regarder je le ferais ce WE j'étais en vadrouille toute la semaine mais je ne doute pas que avec ton expérience ton lisp ne convienne pas a nos attentes

merci d'avance

@ plus

pitou 66 :) :) :)

Posté(e)

Salut (gile)

Dis moi si j'ai correctement copié ta routine .

copier puis coller dans éditeur de texte nommer en Norm_3Pts

puis charger lisp et voila le message

Commande: _appload Norm_3pts.lsp correctement chargé(s)

Commande: ; erreur: caractère lu incorrect (octal): 21

peut tu me dire ce qui ne vas pas

merci d'avance

Pitou 66 :) :)

 

Posté(e)

Tu dois avoir copier trop ou pas assez, il faut prendre tout le code et seulement le code (ce qui apparaît sur fond de papier.

Sinon le reste de la procédure semble bon.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Désolé (gile) mais tu sais je maitrise pas du tout le lisp

voila ce que j'ai copié

dis moi si ca va

[surligneur] ;;; Gile3dPoly -Gilles Chanteau- 07/11/06

;;; Créé une polyligne 3D avec "arcs"

;;; Les arcs sont représentés par une succession de segments jointifs

;;; Le nombre de segments pour les arcs est spécifié par l'utilisateur

;;; Les "arcs" sont définis par "3 points" ou "départ centre fin"

 

(defun c:Gile3dPoly (/ 3dPolyArc_err AcDoc ModSp prec p1 p2 p3 opt lst)

(vl-load-com)

 

(defun 3dPolyArc_err (msg)

(if (= msg "Fonction annulée")

(princ)

(princ (strcat "\nErreur: " msg))

)

(redraw)

(vla-EndUndoMark AcDoc)

(setq *error* m:err

m:err nil

)

(princ)

)

 

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))

ModSp (vla-get-ModelSpace AcDoc)

)

(setq m:err *error*

*error* 3dPolyArc_err

)

(vla-StartUndoMark AcDoc)

(if (not *3dPolyArcPrec*)

(setq *3dPolyArcPrec* 20)

)

(initget 6)

(if (not (setq prec

(getint

(strcat "\Spécifiez le nombre de segments pour les arcs <"

(itoa *3dPolyArcPrec*)

">: "

)

)

)

)

(setq prec *3dPolyArcPrec*)

(setq *3dPolyArcPrec* prec)

)

(initget 1)

(setq p1 (getpoint "\nSpécifiez le point de départ de la polyligne: "

)

lst (cons (trans p1 1 0) lst)

)

(while

(progn

(initget "Arc")

(setq

p1 (trans (last lst) 0 1)

p2 (getpoint p1

"\nSpécifiez l'extrémité de la ligne ou [Arc]: "

)

)

)

(if (= p2 "Arc")

(progn

(setq p2 p1)

(while (equal p1 p2 1e-9)

(initget 1 "Centre")

(setq p2

(getpoint

p1

"\nSpécifiez le deuxième point de l'arc ou [Centre]: "

)

)

)

(if (= p2 "Centre")

(progn

(setq p2 p1)

(while (equal p2 p1)

(initget 1)

(setq

p2 (getpoint p1 "\tSpécifiez le centre de l'arc: ")

)

)

(setq opt "c")

)

(setq opt "3")

)

(setq p3 p2)

(while (equal p2 p3)

(initget 1)

(setq p3 (getpoint p2 "\nSpécifiez l'extrémité de l'arc: "))

)

(setq lst

(append lst

(3dPolyArc (last lst)

(trans p2 1 0)

(trans p3 1 0)

opt

prec

)

)

)

)

(setq lst (append lst (list (trans p2 1 0))))

)

(redraw)

(grvecs (apply 'append

(mapcar '(lambda (x1 x2)

(list -255 x1 x2)

)

(mapcar '(lambda (p) (trans p 0 1)) (reverse (cdr (reverse lst))))

(mapcar '(lambda (p) (trans p 0 1)) (cdr lst))

)

)

)

)

(if (< 1 (length lst))

(vlax-invoke ModSp 'add3dPoly (apply 'append lst))

)

(redraw)

(vla-EndUndoMark AcDoc)

(setq *error* m:err

m:err nil

)

(princ)

)

 

(defun 3dPolyArc

(p1 p2 p3 opt prec / norm mid1 mid2 cen rad ang inc n ptlst)

(if (= opt "3")

(setq norm (norm_3pts p2 p3 p1))

(setq norm (norm_3pts p2 p1 p3))

)

(setq p1 (trans p1 0 norm)

p2 (trans p2 0 norm)

p3 (trans p3 0 norm)

)

(if (= opt "3")

(setq mid1 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2)

mid2 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p2 p3)

cen (inters mid1

(polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)

mid2

(polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)

nil

)

)

(setq cen p2)

)

(setq rad (distance cen p1)

ang (- (angle cen p3) (angle cen p1))

)

(if (minusp ang)

(setq ang (+ (* 2 pi) ang))

)

(setq inc (/ ang prec)

n 0

)

(repeat prec

(setq ptlst (cons (polar cen (- (angle cen p3) (* inc n)) rad) ptlst)

n (1+ n)

)

)

(setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst))

)

 

;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points

 

(defun norm_3pts (org xdir ydir / norm)

(foreach v '(xdir ydir)

(set v (mapcar '- (eval v) org))

)

(if (inters org xdir org ydir)

(mapcar '(lambda (x) (/ x (distance '(0 0 0) norm)))

(setq norm (list (- (* (cadr xdir) (caddr ydir))

(* (caddr xdir) (cadr ydir))

)

(- (* (caddr xdir) (car ydir))

(* (car xdir) (caddr ydir))

)

(- (* (car xdir) (cadr ydir))

(* (cadr xdir) (car ydir))

)

)

)

)

)

) [/surligneur]

et voila la réponse autocad

Commande: _appload Norm_3Pts.lsp correctement chargé(s)

 

 

Commande:

Commande:

Commande: Norm_3Pts

Commande inconnue "NORM_3PTS". Appuyez sur F1 pour obtenir de l'aide.

 

merci de me venir en aide

Pitou 66

Posté(e)

Ce que tu as copié est bon mais pas ce que tapes à la ligne de commande.

Norm_3pts est une routine qui est appelée par le LISP, mais comme elle sert aussi dans d'autres elle est juste ajoutée au fichier.

 

Pour lancer la commande, il faut taper : Gile3dPoly

C'est, comme dans toutes les commandes défine en LISP, ce qui est écrit juste après le c: dans (defun c:Gile3dPoly ...), tu peux changer ce nom en remplaçant Gile3dPoly par ce que tu veux (pas d'espace entre c: et le nom de la commande.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

merci (gile) c'est bien ce que je cherchais

je viens de faire un essai et ai comparé avec la commande de covadis pour remonter en 3D les poly. entre la poly covadis et la tienne il y a un ecart en altitude qui provient de l'interpolation ??

ton lisp est meilleur que covadis car beaucoup plus rapide.

si didier pouvais essayer la commande de son coté et dire ce qu'il en pense.

vois si tu as une idée pour l'interpolation

merci beaucoup tu me rends un grand service

@plus

Pitou66 :) :)

Posté(e)

Interpolation??

c'est la répartition de la différence d'altitude entre les deux premiers point de l'arc divisé par la distance curviligne entre ces deux meme points.

si ca peut t'aider pour trover une solution

pitou 66 :)

Posté(e)

(gile) je viens de faire plusieurs essais et on dirait que ton lisp interpole beaucoup mieux que la commande covadis si les covadisiens présents sur le site pouvait tester ce serait génial.

 

Si tu pouvait modifier ton lisp pour pouvoir continuer en courbe aprés les trois premiers points sans avoir à donner de second point et pouvoir revenir en arriére avec la [surligneur] commande U [/surligneur]en transparence .

 

merci beaucoup

pitou66 :) :D :) [Edité le 10/11/2006 par pitou66]

 

[Edité le 10/11/2006 par pitou66]

Posté(e)

Je ne suis pas sûr de bien comprendre l'interpolation.

 

Le LISP ci-dessus dispose les sommets de la polyligne 3D suivant un arc de cercle contenu dans le plan défini par les trois points spécifés. L'altitude des trois points 3D est donc prise en compte comme tu le demandais.

 

Au vu de ce que tu me dis sur l'interpolation, et de la demande de Didier de ne prendre en compte que l'altitude du premier et du troisième point et d'interpoler celle du point intermédiaire, j'ai fais un autre LISP (ci-dessous).

 

Son fonctionnement est différent, les trois points sont projetés sur le plan XY du SCG* (Z = 0) pour définir un arc de cercle dans ce plan, lequel est divisé en autant de segments que spécifié. Chaque point ainsi obtenu est repositionné en altitude de manière incrémentielle.

Est-ce bien une interpolation ?

 

*Version 1.1 : les points sont projetés sur le plan XY du SCU courant.

 

Version 1.2

 

;;; InterPoly3D -Gilles Chanteau- 24/11/06 Version 1.2
;;; Crée une polyligne 3D.
;;; En option "Arc" les sommets s'inscrivent sur une helicoïde,
;;; - leur altitude est calculée par interpolation linéaire en fonction
;;; de l'altitude du premier et troisième point
;;; - la courbure est celle de l'arc défini par la projection des points
;;; spécifiés sur le plan XY du SCU courant.

(defun c:InterPoly3d (/ 3dPolyArc_err drawvecs segmentundo AcDoc ModSp prec p1 p2 p3 opt lst cnt)
 (vl-load-com)

   ;;***********************************************************;;

 (defun 3dPolyArc_err (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (redraw)
   (vla-EndUndoMark AcDoc)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;;***********************************************************;;

 (defun drawvecs (lst)
   (setq p1 (last lst))
   (redraw)
   (if	(      (grvecs (apply 'append
	     (mapcar '(lambda (x1 x2)
			(list -255 x1 x2)
		      )
		     (reverse (cdr (reverse lst)))
		     (cdr lst)
	     )
      )
     )
   )
 )

 ;;***********************************************************;;

 (defun segmentundo ()
   (if	(      (progn
(prompt "\nTous les segments ont déjà été annulés.")
     )
     (setq lst	(sublst lst 1 (- (length lst) (car cnt)))
    cnt	(cdr cnt)
     )
   )
 )

 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
ModSp	(vla-get-ModelSpace AcDoc)
m:err	*error*
*error*	3dPolyArc_err
 )
 (vla-StartUndoMark AcDoc)
 (if (not (vlax-ldata-get "interpoly3d" "prec"))
   (vlax-ldata-put "interpoly3d" "prec" 20)
 )
 (prompt (strcat "\nParamètre courant - Nombre de segments par arc: "
	  (itoa (vlax-ldata-get "interpoly3d" "prec"))
  )
 )
 (while (not (vl-consp p1))
   (initget 1 "Segments")
   (setq
     p1 (getpoint
   "\nSpécifiez le point de départ de la polyligne ou [segments]: "
 )
   )
   (if	(= p1 "Segments")
     (progn
(initget 6)
(if (setq prec
	   (getint
	     (strcat "\nSpécifiez le nombre de segments pour les arcs 			     (itoa (vlax-ldata-get "interpoly3d" "prec"))
		     ">: "
	     )
	   )
    )
  (vlax-ldata-put "interpoly3d" "prec" prec)
)
     )
   )
 )
 (setq	prec  (vlax-ldata-get "interpoly3d" "prec")
lst   (cons p1 lst)
cnt   (cons 1 cnt)
loop1 T
 )
 (while loop1
   (initget "Arc annUler")
   (setq
     p1 (last lst)
     p2 (getpoint p1
	   "\nSpécifiez l'extrémité de la ligne ou [Arc/annUler]: "
 )
   )
   (if	p2
     (progn
(if (= p2 "annUler")
  (segmentundo)
  (if (= p2 "Arc")
    (progn
      (setq loop2 T)
      (while loop2
	(setq p2 p1)
	(while (equal p1 p2 1e-9)
	  (initget "Ligne annUler")
	  (setq	p2
		 (getpoint
		   p1
		   "\nSpécifiez le deuxième point de l'arc ou [Ligne/annUler]: "
		 )
	  )
	)
	(if p2
	  (if (= p2 "Ligne")
	    (setq loop2 nil)
	    (if	(= p2 "annUler")
	      (progn
		(segmentundo)
		(drawvecs lst)
	      )
	      (progn
		(setq p3 p2)
		(while (equal p2 p3)
		  (initget 1 "annUler")
		  (setq
		    p3
		     (getpoint p2 "\nSpécifiez l'extrémité de l'arc: ")
		  )
		)
		(setq new (interpol (last lst) p2 p3 prec)
		      lst (append lst new)
		      cnt (cons (length new) cnt)
		)
		(drawvecs lst)
	      )
	    )
	  )
	  (setq	loop2 nil
		loop1 nil
	  )
	)
      )
    )
    (setq lst (append lst (list p2))
	  cnt (cons 1 cnt)
    )
  )
)
(drawvecs lst)
     )
     (setq loop1 nil)
   )
 )
 (if (    (vlax-invoke ModSp
	 'add3dPoly
	 (apply 'append (mapcar '(lambda (p) (trans p 1 0)) lst))
   )
 )
 (redraw)
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

(defun interpol	(pt1   pt2   pt3   prec	 /     alt1  alt3  p1	 p2    p3
	 mid1  mid2  cen   rad	 ang   i_ang i_alt n	 p_int ptlst
	)
 (setq	alt1 (caddr pt1)
alt3 (caddr pt3)
 )
 (mapcar '(lambda (p pt) (set p (list (car pt) (cadr pt) 0.0)))
  '(p1 p2 p3)
  (list pt1 pt2 pt3)
 )
 (if (or (equal p1 p2 1e-9) (not (inters p1 p2 p2 p3)))
   (setq ptlst (list pt3))
   (progn
     (setq mid1 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2)
    mid2 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p2 p3)
    cen	 (inters mid1
		 (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
		 mid2
		 (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)
		 nil
	 )
    rad	 (distance cen p1)
    ang	 (ang      )
     (if (	(setq ang (- ang (* 2 pi)))
     )
     (setq i_ang (/ ang prec)
    i_alt (/ (- alt1 alt3) prec)
    n	  0
     )
     (repeat prec
(setq p_int (polar cen (- (angle cen p3) (* i_ang n)) rad)
      p_int (list (car p_int) (cadr p_int) (+ alt3 (* i_alt n)))
      ptlst (cons p_int ptlst)
      n	    (1+ n)
)
     )
   )
 )
 ptlst
)

;;; Ang
(defun ang  (if (and (    ang
   (ang  )
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)

(defun sublst (lst start leng / rslt)
 (if (not (    (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

[Edité le 11/11/2006 par (gile)][Edité le 12/11/2006 par (gile)]

 

[Edité le 24/11/2006 par (gile)]

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Gilles, juste quelque infos sur l'interpolation!

 

Il y a plusieurs méthode:

 

La plus simple:

Pour interpoler un point sur un segment curviligne entre 2 points connus en Z. Il faut utiliser la longueur curviligne en 2D entre ces 2 points et non la distance rectiligne entre ces 2 points.

Après tu fais simplement une règle de trois pour obtenir le Z à la distance curviligne du point désiré.

 

L'autre méthode est plus complexe et généralement utilisé pour une interpolation sur des élément de type triangle 3D (MNT) ou on considère le poids du point. Les points utilisés ont plus de poids s'ils sont sont proches du point recherché (il y a des formules pour ça). Donc plus le point connu est proche du point recherché, plus sont influence pour l'interpolation pèse pour le calcul.

 

Je pense que ceci expliquera la différence de temps d'éxecution entre COVADIS et ton lisp

 

Tout ceci sort du domaine de l'ébénisterie ou menuiserie ;)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Posté(e)

Salut gilles

d'accord avec bonuscad pour l'interpolation

je pense que la commande covadis 2d vers 3d fonctionne comme ca puisque aucun mnt n'est crée.

[surligneur] Pour interpoler un point sur un segment curviligne entre 2 points connus en Z. Il faut utiliser la longueur curviligne en 2D entre ces 2 points et non la distance rectiligne entre ces 2 points.

Après tu fais simplement une règle de trois pour obtenir le Z à la distance curviligne du point désiré.[/surligneur]

[surligneur] pourrais t'on savoir pourquoi cela sort du domaine menuiserie/ébénisterie?????[/surligneur]

[surligneur] Tout ceci sort du domaine de l'ébénisterie ou menuiserie [/surligneur]

je pense que didier donneras son avis en début de semaine

Amicalement

Pitou 66 :) :) :) [Edité le 11/11/2006 par pitou66]

 

[Edité le 11/11/2006 par pitou66]

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant



×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité