Développé de cône, tronc de cône, secteur de cône...

[(gile)]

Salut,

 

Un petit programme pour faire facilement les développés de cônes, troncs de cône, secteurs de cône ou de tronc de cône.

 

L'utilisateur sélectionne le cercle (ou l'arc) figurant la base du cône (ou du secteur) puis spécifie le sommet ou, après avoir fait Entrer ou clic droit, sélectionne le cercle (ou l'arc) figurant l'autre base du tronc (ou secteur de tronc) de cône.

Les bases et/ou sommet doivent être concentriques et situés à leurs altitudes respectives.

Le développé est figuré par une polyligne close, insérée au point spécifié par l'utilisateur dans le SCU courant, sur le calque courant.

Le point d'insertion est situé au milieu du plus grand arc du développé.

 

http://imageshack-france.com/out.php/i260022_devcone.png

 

;;; DEVCONE (gile)
;;; Crée une polyligne figurant le développé d'un cône, d'un tronc de cône,
;;; d'un secteur de cône ou de tronc de cône.
;;; L'utilisateur sélectionne un cercle (ou un arc) décrivant la base du cône
;;; puis spécifie un point décrivant son sommet (ou sélectionne un cercle ou un arc
;;; décrivant son autre base).
;;; Les bases et/ou sommet doivent être concentriques et situés à leurs altitudes respectives.

(defun c:devcone (/	 base1	elst1  typ    norm   base2   elst2
	  perim1 perim2	tmp    start1 start2 mid1   mid2
	  sum	 rad1	rad2   ins    elv    ang    ang/2
	  ang/4	 chord1	chord2 p1     p2     p3	    p4
                 bulge
	 )

 (defun 3dTo2dPoint (pt) (list (car pt) (cadr pt)))
 
 (if
   (and
     (setq
base1 (car (entsel "Sélectionnez la base du cône (arc ou cercle): "))
     )
     (setq elst1 (entget base1))
     (setq typ (cdr (assoc 0 elst1)))
     (setq norm (cdr (assoc 210 elst1)))
     (member typ '("ARC" "CIRCLE"))
   )
    (if
      (setq sum (getpoint "\nSpécifiez le sommet du cône ou [b]<[/b]base>: "))
(if
  (and
    (setq sum (trans sum 1 norm))
    (equal (3dTo2dPoint sum)
	   (3dTo2dPoint (cdr (assoc 10 elst1)))
	   1e-9
    )
  )
   (progn
     (setq start1 (trans (vlax-curve-getStartPoint base1) 0 norm)
	   rad1	  (distance sum start1)
	   ang	  (/ (vlax-curve-getDistAtParam
		       base1
		       (vlax-curve-getendParam base1)
		     )
		     rad1
		  )
	   ang/2  (/ ang 2)
	   ang/4  (/ ang 4)
	   chord1 (* 2 rad1 (sin ang/2))
	   ins	  (getpoint "\nPoint d'insertion: ")
	   ins	  (trans ins 1 (trans '(0 0 1) 1 0 T))
	   elv	  (caddr ins)
	   p1	  (polar ins (+ pi ang/4) (/ chord1 (* 2 (cos ang/4))))
	   p2	  (polar p1 0.0 chord1)
	   p3	  (polar p2 (- (* 1.5 pi) ang/2) rad1)
	   bulge  (/ (sin ang/4) (cos ang/4))
     )
     (entmake
       (list
	 '(0 . "LWPOLYLINE")
	 '(100 . "AcDbEntity")
	 '(100 . "AcDbPolyline")
	 '(90 . 3)
	 '(70 . 1)
	 (cons 38 elv)
	 (cons 10 p1)
	 (cons 42 (- bulge))
	 (cons 10 p2)
	 (cons 10 p3)
	 (cons 210 (trans '(0 0 1) 1 0 T))
       )
     )
   )
   (princ "\nSommet non valide.")
)
(if (and
      (setq base2 (car (entsel "Sélectionnez l'autre base: ")))
      (setq elst2 (entget base2))
      (= (cdr (assoc 0 elst2)) typ)
      (equal norm (cdr (assoc 210 elst2)) 1e-9)
      (equal (3dTo2dPoint (cdr (assoc 10 elst1)))
	     (3dTo2dPoint (cdr (assoc 10 elst2)))
	     1e-9
      )
      (or (= typ "CIRCLE")
	  (and
	    (equal (cdr (assoc 50 elst1))
		   (cdr (assoc 50 elst2))
		   1e-9
	    )
	    (equal (cdr (assoc 51 elst1))
		   (cdr (assoc 51 elst2))
		   1e-9
	    )
	  )
      )
    )
  (progn
    (setq perim1 (vlax-curve-getDistAtParam
		   base1
		   (vlax-curve-getendParam base1)
		 )
	  perim2 (vlax-curve-getDistAtParam
		   base2
		   (vlax-curve-getendParam base2)
		 )
    )
    (if	(< perim1 perim2)
      (setq tmp	   base1
	    base1  base2
	    base2  tmp
	    perim1 perim2
      )
    )
    (setq start1 (trans (vlax-curve-getStartPoint base1) 0 norm)
	  mid1	 (trans	(vlax-curve-getPointatParam
			  base1
			  (/ (+	(vlax-curve-getEndParam base1)
				(vlax-curve-getStartParam base1)
			     )
			     2
			  )
			)
			0
			norm
		 )
	  start2 (trans (vlax-curve-getStartPoint base2) 0 norm)
	  mid2	 (trans	(vlax-curve-getPointatParam
			  base2
			  (/ (+	(vlax-curve-getEndParam base2)
				(vlax-curve-getStartParam base2)
			     )
			     2
			  )
			)
			0
			norm
		 )
    )
    (if	(setq sum (inters start1 start2 mid1 mid2 nil))
      (progn
	(setq rad1   (distance sum start1)
	      rad2   (distance sum start2)
	      ang    (/ perim1 rad1)
	      ang/2  (/ ang 2)
	      ang/4  (/ ang 4)
	      chord1 (* 2 rad1 (sin ang/2))
	      chord2 (* 2 rad2 (sin ang/2))
	      ins    (getpoint "\nPoint d'insertion: ")
	      ins    (trans ins 1 (trans '(0 0 1) 1 0 T))
	      elv    (caddr ins)
	      p1     (polar ins
			    (+ pi ang/4)
			    (/ chord1 (* 2 (cos ang/4)))
		     )
	      p2     (polar p1 0.0 chord1)
	      p3     (polar p2
			    (- (* 1.5 pi) ang/2)
			    (- rad1 rad2)
		     )
	      p4     (polar p3 pi chord2)
	      bulge  (/ (sin ang/4) (cos ang/4))
	)
	(entmake
	  (list
	    '(0 . "LWPOLYLINE")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbPolyline")
	    '(90 . 4)
	    '(70 . 1)
	    (cons 38 elv)
	    (cons 10 p1)
	    (cons 42 (- bulge))
	    (cons 10 p2)
	    (cons 10 p3)
	    (cons 42 bulge)
	    (cons 10 p4)
	    (cons 210 (trans '(0 0 1) 1 0 T))
	  )
	)
      )
    )
  )
  (princ "\nEntité non valide.")
)
    )
    (princ "\nEntité non valide.")
 )
 (princ)
) 

[bseb67]

Salut gile.

 

Bon, ben j'ai voulu essayer. Je dessine un cone, trace un cercle reprenant la base, lance le lisp,

clique le cercle, la pointe du cone, le point d'insertion, le développé se créé et là:

BAMMMM, plantage autocad: fatale error. :o

 

J'ai relancé autocad, refait la manip, et là pas de plantage. ouf.

 

J'ai essaye tes différents modes, c'est ok chez moi.

 

Sauf que j'en ai pas l'utilité (pour l'instant) de ça.

 

PS: il me reste 2h avant le week-end, alors bon week-end à tous :)

[(gile)]

Une erreur fatale !!!

Je vois mal ce qui a pu provoquer ça, le LISP ne fait que quelques calculs trigonométriques basiques et crée une polyligne...

 

De mon côté, je m'en suis servi souvent ces derniers temps (c'est pour ça que je l'ai finalisé et publié ici) pour faire ce genre de choses (un cyclorama)

 

http://imageshack-france.com/out.php/i260057_p1010082.jpg

 

Chaque lame est un secteur de tronc cône différent :

 

http://imageshack-france.com/out.php/i260066_devcone2.png

[Tramber]

Question : (je n'ai pas lu le code)

 

Est-ce que les 2 arcs de cercle doivent être dans des plans parallèles, voire parallèles à XY courant ?

[(gile)]

Salut,

 

Dans l'état actuel, oui les deux arcs doivent être dans des plans parallèles qui peuvent être différents du plan XY du SCU courant (et du SCG).

 

Si les arcs n'étaient pas dans des plans parallèles, au moins un devrait être un arc elliptique.

 

Ce LISP donne un résultat géométriquement "juste" pour des situation simples.

Pour des situations plus "tordues" j'avais fait surfdev qui fonctionne avec des surfaces réglées et dont la précision dépend en grande partie de la valeur de SURFTAB1.