Profil rectangulaire suivant axe sélectionné

usegomme · le 10 août 2009

Salut , un petit lisp pour répondre à la demande de moklaur dans le post tuyau 3d en espèrant que ça convient.

Si il y aura le lsp qui dessinera des profilets creux (Carré/rectangulaire)
je dessinerais seulements les lignes moyennes puis je selectionne chaque ligne et lsp dessine le tube et il ne restera que extruder qques faces, couper quelques solides percer par soustraction des cylindres dessiné à la main etc...

; ax2pr ; Axe to profil rectangulaire (creux si ep > 0)
; version 1 le 10-08-2009
; usegomme sur Cadxp.com

(defun c:ax2pr (/ la ha ep ax p1 p2 tubext)
(if (not ax2pr:la) (setq ax2pr:la 30.0)) ; par défaut	   
(setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: ")))
(if la (setq ax2pr:la la) (setq la ax2pr:la))
 
(if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la))	   
(setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: ")))
(if ha (setq  ax2pr:ha ha) (setq ha ax2pr:ha)) 

(if (not ax2pr:ep) (setq ax2pr:ep 0.0))	   
(setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: ")))
(if ep
  (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep))
  (setq ep ax2pr:ep)  
)
(while       
 (setq ax (entsel  "\nSélectionner l'AXE du TUBE rectangulaire :"))  
 (setq p1 (osnap (cadr ax) "_endp"))
 (setq p2 (osnap (cadr ax) "_mid"))
 (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 (setq P1 '(0. 0. 0.))
 (command "_PLINE" 
  "_non" (list (* (* la 0.5) -1) (* (* ha 0.5) -1))
  "_non" (list (* la 0.5) (* (* ha 0.5) -1))
  "_non" (list (* la 0.5) (* ha 0.5))
  "_non" (list (* (* la 0.5)-1) (* ha 0.5))
          "_c"
 )
 (command "_sweep" "_L" "" ax)  ;; balayage
 (cond
   ((> ep 0.0)
    (setq tubext (entlast))
    (if (= 2 (getvar "delobj"))(entdel (car ax)))
    (command "_PLINE" 
  "_non" (list (* (- (* la 0.5) ep) -1) (* (- (* ha 0.5) ep) -1))
  "_non" (list (- (* la 0.5) ep) (* (- (* ha 0.5) ep) -1))
  "_non" (list (- (* la 0.5) ep) (- (* ha 0.5) ep))
  "_non" (list (* (- (* la 0.5) ep) -1) (- (* ha 0.5) ep))
          "_c"
    )
    (command "_sweep" "_L" "" ax)
    (command "_subtract" tubext "" "_L" "")
   )
 )
 (command "_ucs" "_p")
)
(princ) 
)

Attention au "pointage" de l'axe, avec osnap il peut y avoir une mauvaise sélection .

moklaur · le 11 août 2009

Bonjour à tous,

Un grand merci usegomme, c'est vraiment ce que je cherche

mais j'ai oublié de vous dire que le profilet est un tube soudé donc obtenu à partir de tole plane ce qui implique des rayons int et ext dans les 4 coins

le rayon int est comme suit:

Rint=1mm si Ep tube <=3mm

Rint=2mm si Ep tube >3mm

le rayon ext est evident: Rint+Ep tube

J'espère que je vous drange pas

merci d'avance

usegomme · le 11 août 2009

Bonjour , content que ça te convienne , j'ai fait la modif pour les rayons en utilisant la commande raccord par facilté mais j'ai coincé pour forcer le mode ajuster de la commande,

donc à vérifier avant usage en attendant que je trouve ou que quelqu'un me donne l'info.

Je ne sais pas si tu utilises parfois des tubes courbés , car dans ce cas le tube rectangulaire ne s'oriente pas correctement , se sera peut être une modif ultérieure quand j'aurai le temps.

EDIT : dans la version 3 ci-dessous, je n'utilise plus la commande "raccord".

; ax2pr  Axe to profil rectangulaire (creux si ep > 0)
; version 3 le 24-08-2009
; usegomme sur Cadxp.com

(defun c:ax2pr (/ la ha ep ax p1 p2 tubext i)

(if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut	   
(setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: ")))
(if la (setq ax2pr:la la) (setq la ax2pr:la))
 
(if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la))	   
(setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: ")))
(if ha (setq  ax2pr:ha ha) (setq ha ax2pr:ha)) 

(if (not ax2pr:ep) (setq ax2pr:ep 2.0)) ; par défaut	   
(setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: ")))
(if ep
  (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep))
  (setq ep ax2pr:ep)  
)
(setq la (* 0.5 la) ha (* 0.5 ha))
 
(while       
 (setq ax (entsel  "\nSélectionner l'AXE du TUBE rectangulaire :"))  
 (setq p1 (osnap (cadr ax) "_endp"))
 (setq p2 (osnap (cadr ax) "_mid"))
 (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 (setq P1 '(0. 0. 0.))
 (cond
      ((and (> ep 0)(<= 3)) (setq r (+ ep 1)))
      ((> ep 3) (setq r (+ ep 2))) 
      (t (setq r 3))
 )
 (setq i 1)
 (repeat 2
  (if (= i 2)
   (cond
    ((> ep 0.0)
     (setq tubext (entlast))
     (if (= 2 (getvar "delobj"))(entdel (car ax)))
     (cond
      ((and (> ep 0)(<= 3)) (setq r  1))
      ((> ep 3) (setq r 2)) 
     )
     (setq la (- la ep) ha (- ha ep))
     (setq i 3)
    ) 
   )
  )

  (cond ((/= i 2) 
   (command "_PLINE" 
  "_non" (list (- la r) (* ha -1)) 
  "_A" "_CE" "_non" (list (- la r) (* (- ha r) -1)) 
         "_non" (list la  (* (- ha r) -1)) 
  "_L"  "_non" (list la (- ha r)) 
         "_A" "_CE" "_non" (list (- la r) (- ha r)) 
  "_non" (list (- la r) ha)  
         "_L" "_non" (list (* (- la r) -1) ha)
         "_A" "_CE" "_non" (list (* (- la r) -1) (- ha r))
  "_non" (list (* la -1) (- ha r)) 
         "_L" "_non" (list (* la -1) (* (- ha r) -1))
         "_A" "_CE" "_non" (list (* (- la r) -1) (* (- ha r) -1))
  "_non" (list (* (- la r) -1) (* ha -1))
   "_L" "_c"
   )
   (command "_sweep" "_L" "" ax)  ;; balayage
  )) ; cond 
   
  (if (= i 1)(setq i 2)) 
 ) ; repeat 
 
 (cond ((= i 3)(setq la (+ la ep) ha (+ ha ep))
   (command "_subtract" tubext "" "_L" "")
 ))
 (command "_ucs" "_p")
)

(princ) 
)

[Edité le 24/8/2009 par usegomme]

moklaur · le 14 août 2009

Bonjour,

Parfait comme amélioration pour arrondir les coins

çà marche convenablement

Pour le mode ajuster, peut etre la commande rectangle avec option raccord peut servir de moyen:

 Commande: _rectang
Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]: R
Spécifiez le rayon du raccord des rectangles <0.0000>: 1

J'ai utilisé cette methode pour faire un tube grugé en tapant successivement les commandes sur Excel et par simple copier coller dans la ligne de commande Autocad mon tube est dessiné d'un seul coup

ma methode Excel pour un tube grugé:

 _erase
tout 
_rectang R 4 -4,0 4,18
_move
_last 
0,0
0,0,-35
_extrude
_last 
75
_cylinder 0,-20,-60 30 0,-50,60
_cylinder 0,0,0 23 A 0,75,0
_cylinder 0,0,0 25 A 0,75,0
_subtract
_last 
tout 
_mirror
tout 
0,75 1,75
N
_union
tout

ma methode Excel pour un galet de cintrage:

 _erase
tout 
_arc
_c 
0,0
123.3,0
-123.3,0
_move
_last 
0,0,0
0,0,40
_circle 300,0 28
_sweep
_last 
tout
_move
_last 
0,0,0
0,0,3.5
_circle 300,7 28
_sweep
_last 
tout
_move
_last 
0,0,0
0,0,-3.5
_intersect
tout 
_cylinder 0,0,0 15.5 80
_cylinder 0,0,0 25 11
_cylinder 0,0,69 25 11
_box -10,-125 10,125 7
_box -10,-125,73 10,125,73 7
_box -125,-125 125,-40 80
_box -125,-40 -70,0 80
_mirror
_last 
0,0 0,1
N
_cylinder -70,-20,15 4 A -50,-20,15
_cylinder -70,-20,65 4 A -50,-20,65
_cone -50,-20,15 4 A -48.3092,-20,15
_cone -50,-20,65 4 A -48.3092,-20,65
_cylinder 70,-20,15 4 A 50,-20,15
_cylinder 70,-20,65 4 A 50,-20,65
_cone 50,-20,15 4 A 48.3092,-20,15
_cone 50,-20,65 4 A 48.3092,-20,65
_cylinder 0,0,0 120 80
_subtract
_last 
tout

NB: Peut etre il faut taper entrée à la fin pour finir et sortir

usegomme · le 19 août 2009

Salut, j´ai tardé à répondre car je ne pouvais essayer ce que tu as posté cause congés.

commande rectangle avec option raccord peut servir de moyen

C´est vrai , mais le rayon reste en mémoire et cela m´ennuie un peu .

ma methode Excel

Ce que tu fais est intéressant, tu pourrais en faire des scripts, mais ta méthode est peut ëtre plus pratique en tout cas je suis curieux de toutes astuces .

usegomme · le 24 août 2009

Bonjour, j'ai fait une mise à jour , voir au-dessus la réponse n° 2.

usegomme · le 31 août 2009

Bonjour , j'ai fait une mise à jour pour qu'on puisse utiliser autre chose que les lignes droites comme axe pour le profil.

C'est toujours dans mon style bricolo , mais dans la plupart des cas le résultat est bon.

; ax2pr  Axe to profil rectangulaire (creux si ep > 0)
; version 4.2 le 06-10-2009
; usegomme sur Cadxp.com

(defun c:ax2pr (/ la ha ep r ax p1 p2 tubext i l1 cfollow)
 (setq CFOLLOW (getvar "UCSFOLLOW"))
 (setvar "UCSFOLLOW" 0) 
      ; sauve scu courant
(command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) 
(if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut	   
(setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: ")))
(if la (setq ax2pr:la la) (setq la ax2pr:la))
 
(if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la))	   
(setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: ")))
(if ha (setq  ax2pr:ha ha) (setq ha ax2pr:ha)) 

(if (not ax2pr:ep) (setq ax2pr:ep 2.0)) ; par défaut	   
(setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: ")))
(if ep
  (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep))
  (setq ep ax2pr:ep)  
)
(setq la (* 0.5 la) ha (* 0.5 ha))
 
(while       
 (setq ax (entsel  "\nSélectionner l'AXE du TUBE rectangulaire :"))
 
 (cond
 
  ((or
    (and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax))))))
    (= "SPLINE" (cdr (assoc 0 (entget (car ax)))))
   )
   (command "_ucs" "")
    (setq i 9 ok nil p1 nil)     
     (while (and (= ok nil) (nth (setq i (+ i 1)) (entget (car ax))))
       (if (= 10 (car (nth i (entget (car ax)))))
         (if p1
           (setq p2 (cdr (nth i (entget (car ax)))) ok T) 
           (setq p1 (cdr (nth i (entget (car ax)))))
         )
       )
    )
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 )
  
 ((or (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 9 (cdr (assoc 70 (entget (car ax))))))
      (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 1 (cdr (assoc 70 (entget (car ax))))))
   )
     (command "_ucs" "")
     (setq l1 (entget (entnext (cdr (assoc -1 (entget (car ax)))))))
     (setq p1 (cdr (assoc 10 l1)))
     (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
     (setq p2 (cdr (assoc 10 l1)))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 )
  
 ((= "ELLIPSE" (cdr (assoc 0 (entget (car ax)))))
    (setq p1 (osnap (cadr ax) "_qua"))
    (setq p2 (osnap (cadr ax) "_cen"))
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    (command "_ucs" "_y" "-90")
 )
  
 (T
  (if (setq p1 (osnap (cadr ax) "_endp"))
   (if (setq p2 (osnap (cadr ax) "_cen"))
    (progn
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
     (command "_ucs" "_y" "-90") 
    )   
    (progn
     (setq p2 (osnap (cadr ax) "_mid"))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    )
   )
   (progn
    (setq p1 (osnap (cadr ax) "_qua"))   
    (setq p2 (osnap (cadr ax) "_cen"))
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    (command "_ucs" "_y" "-90")
   ) 
 ) ; if
)  ; T
)   ; cond
 
 (setq P1 '(0. 0. 0.))
 (cond
      ((and (> ep 0)(<= 3)) (setq r (+ ep 1)))
      ((> ep 3) (setq r (+ ep 2))) 
      (t (setq r 3))
 )
 (setq i 1)
 (repeat 2
  (if (= i 2)
   (cond
    ((> ep 0.0)
     (setq tubext (entlast))
     (if (= 2 (getvar "delobj"))(entdel (car ax)))
     (cond
      ((and (> ep 0)(<= 3)) (setq r  1))
      ((> ep 3) (setq r 2)) 
     )
     (setq la (- la ep) ha (- ha ep))
     (setq i 3)
    ) 
   )
  )

  (cond ((/= i 2) 
   (command "_PLINE" 
  "_non" (list (- la r) (* ha -1)) 
  "_A" "_CE" "_non" (list (- la r) (* (- ha r) -1)) 
         "_non" (list la  (* (- ha r) -1)) 
  "_L"  "_non" (list la (- ha r)) 
         "_A" "_CE" "_non" (list (- la r) (- ha r)) 
  "_non" (list (- la r) ha)  
         "_L" "_non" (list (* (- la r) -1) ha)
         "_A" "_CE" "_non" (list (* (- la r) -1) (- ha r))
  "_non" (list (* la -1) (- ha r)) 
         "_L" "_non" (list (* la -1) (* (- ha r) -1))
         "_A" "_CE" "_non" (list (* (- la r) -1) (* (- ha r) -1))
  "_non" (list (* (- la r) -1) (* ha -1))
   "_L" "_c"
   )
   (command "_sweep" "_L" "" ax)  ;; balayage
  )) ; cond 
   
  (if (= i 1)(setq i 2)) 
 ) ; repeat 
 
 (cond ((= i 3)(setq la (+ la ep) ha (+ ha ep))
   (command "_subtract" tubext "" "_L" "")
 ))
 
 (command "_ucs" "_r" "tempftd")
)
(setvar "UCSFOLLOW" CFOLLOW)
(princ) 
)

Et le même sans les arêtes arrondies , il doit bien y avoir quelqu'un pour qui ça a un intérêt.

 
; ax2pr0  Axe to profil rectangulaire (creux si ep > 0) mais arêtes sans rayon
; version 4.2 bis le 06-10-2009 
; usegomme sur Cadxp.com

(defun c:ax2pr0 (/ la ha ep  ax p1 p2 tubext i l1 cfollow)
 (setq CFOLLOW (getvar "UCSFOLLOW"))
 (setvar "UCSFOLLOW" 0)
      ; sauve scu courant
(command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) 
(if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut	   
(setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: ")))
(if la (setq ax2pr:la la) (setq la ax2pr:la))
 
(if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la))	   
(setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: ")))
(if ha (setq  ax2pr:ha ha) (setq ha ax2pr:ha)) 

(if (not ax2pr:ep) (setq ax2pr:ep 0.0)) ; par défaut	   
(setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: ")))
(if ep
  (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep))
  (setq ep ax2pr:ep)  
)
(setq la (* 0.5 la) ha (* 0.5 ha))
 
(while       
 (setq ax (entsel  "\nSélectionner l'AXE du TUBE rectangulaire :")) 
 
 (cond
 
  ((or
    (and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax))))))
    (= "SPLINE" (cdr (assoc 0 (entget (car ax)))))
   )
   (command "_ucs" "")
    (setq i 9 ok nil p1 nil)     
     (while (and (= ok nil) (nth (setq i (+ i 1)) (entget (car ax))))
       (if (= 10 (car (nth i (entget (car ax)))))
         (if p1
           (setq p2 (cdr (nth i (entget (car ax)))) ok T) 
           (setq p1 (cdr (nth i (entget (car ax)))))
         )
       )
    )
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 )
  
 ((or (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 9 (cdr (assoc 70 (entget (car ax))))))
      (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 1 (cdr (assoc 70 (entget (car ax))))))
   )
     (command "_ucs" "")
     (setq l1 (entget (entnext (cdr (assoc -1 (entget (car ax)))))))
     (setq p1 (cdr (assoc 10 l1)))
     (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
     (setq p2 (cdr (assoc 10 l1)))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 )
  
 ((= "ELLIPSE" (cdr (assoc 0 (entget (car ax)))))
    (setq p1 (osnap (cadr ax) "_qua"))
    (setq p2 (osnap (cadr ax) "_cen"))
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    (command "_ucs" "_y" "-90")
 )
  
 (T
  (if (setq p1 (osnap (cadr ax) "_endp"))
   (if (setq p2 (osnap (cadr ax) "_cen"))
    (progn
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
     (command "_ucs" "_y" "-90") 
    )   
    (progn
     (setq p2 (osnap (cadr ax) "_mid"))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    )
   )
   (progn
    (setq p1 (osnap (cadr ax) "_qua"))   
    (setq p2 (osnap (cadr ax) "_cen"))
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    (command "_ucs" "_y" "-90")
   ) 
 ) ; if
)  ; T
)   ; cond
 
 (setq P1 '(0. 0. 0.))

 (setq i 1)
 (repeat 2
  (if (= i 2)
   (cond
    ((> ep 0.0)
     (setq tubext (entlast))
     (if (= 2 (getvar "delobj"))(entdel (car ax)))
     
     (setq la (- la ep) ha (- ha ep))
     (setq i 3)
    ) 
   )
  )

  (cond ((/= i 2) 
   (command "_PLINE" 
                 "_non" (list (*  la  -1) (* ha -1))
  "_non" (list la (* ha -1))
  "_non" (list la ha)
  "_non" (list (* la -1) ha)
                "_c"
   )
   (command "_sweep" "_L" "" ax)  ;; balayage
  )) ; cond 
   
  (if (= i 1)(setq i 2)) 
 ) ; repeat 
 
 (cond ((= i 3)(setq la (+ la ep) ha (+ ha ep))
   (command "_subtract" tubext "" "_L" "")
 ))
 
 (command "_ucs" "_r" "tempftd")
)
(setvar "UCSFOLLOW" CFOLLOW)
(princ) 
)

[Edité le 5/10/2009 par usegomme]

[Edité le 6/10/2009 par usegomme]

moklaur · le 1 septembre 2009

Bonsoir,

je pense que vous developpez sans saisse, c'est super bien

j'espère que mes exigenses restent toujour dans le cadre de vous laisser créer

l'essais de la vesrsion 4/4 bis sera deamin au bureau

moklaur · le 2 septembre 2009

Bonjour,

J'ai essayé les 2 version 4,

çà bien marché en coins vifs et arrondis donc deux spécialité sont satisfaites

les Tubes Acier Soudées (coins arrondis) et les profilets Alu ou autre (Coins Vifs)

merci beaucoup, après utilisation, je vous communique les infos pour condrver ou developper

usegomme · le 3 septembre 2009

Merci

A+

binoit · le 24 septembre 2009

Bonjour usegomme,

Merci pour ce code lisp, super travail

J ai juste un petit probleme, quand mon axe est une poly 3D, le tube vrille au fur et a mesure des sommets

N y aurait il pas moyen de laisser la face du tube toujours dans le meme inclinaison

Merci

usegomme · le 29 septembre 2009

Salut Binoit,

Comme tu l´as certainement constater autocad génére le solide avec une continuité des arêtes et si la section du tube tracée au départ selon une orientation "standard" n´est pas aligné avec le plan formé par les segments de la polyligne , il y a une déformation .

De mëme lors d´un changement de direction avec changement de niveau . Dans ce cas il faut se déporter jusqu´à la génératrice extérieure du tube avant de changer de niveau.

A part demander à l´utilisateur un angle de rotation de la section de départ, je ne vois pas ce que je peux faire .

Je te renvoie donc la balle , détaille un peu mieux ton soucis , sait-on jamais !

usegomme · le 5 octobre 2009

Version 4.2 avec quelques corrections voir réponse n°6

[Edité le 6/10/2009 par usegomme]

usegomme · le 29 juillet 2012

Mise à jour du sujet avec beaucoup de retard.

; ax2pr  Axe to profil rectangulaire (creux si epaisseur supérieure 0)
; version 5 le 01-12-2009 version avec demande de rotation de la section du profil
;;        5.1  validation scu
;;        5.2  correction delobj 2   27 07 2012
; usegomme
;;===================================================;;

;; MXV
;; Applique une matrice de transformation à un vecteur -Vladimir Nesterovsky-
;;
;; Arguments : une matrice et un vecteur

(defun mxv (m v)
 (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)

;;===================================================;;

(defun c:ax2pr (/ la ha ep r ax  p2 p1 tubext i l1 tubint CECHO CFOLLOW typar sv_dm pw dm
              elst pe cen elv ext pa1 pa2 grd prd ang pt1 pt2 mat a1 a2 aec rep
      ) 
(setq CFOLLOW (getvar "UCSFOLLOW") CECHO (getvar "CMDECHO")
      sv_dm (getvar "DYNMODE") pw (getvar "plinewid")
)
 
(setvar "UCSFOLLOW" 0) (setvar "plinewid" 0) (setvar "CMDECHO" 1)
      ; sauve scu courant
(command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) 
(if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut	   
(setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: ")))
(if la (setq ax2pr:la la) (setq la ax2pr:la))
 
(if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la))	   
(setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: ")))
(if ha (setq  ax2pr:ha ha) (setq ha ax2pr:ha)) 

(if (not ax2pr:ep) (setq ax2pr:ep 2.0)) ; par défaut	   
(setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts, 0 = plein <" (rtos ax2pr:ep 2 4) ">: ")))
(if ep
  (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep))
  (setq ep ax2pr:ep)  
)
(setq la (* 0.5 la) ha (* 0.5 ha))
(cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm))
          (t (setq sv_dm nil dm nil))
)
(initget  "Arrondies Vives")   
(setq typar (getkword "\nProfilé avec arêtes : <Vives>[Arrondies] : "))  
(if (/= typar "Arrondies") (setq typar "Vives"))
(if sv_dm (setvar "DYNMODE" sv_dm))
 
(while       
 (setq ax (entsel  "\nSélectionner l'AXE du TUBE rectangulaire :"))

 (cond
  
  ((= "SPLINE" (cdr (assoc 0 (entget (car ax)))))
    (command "_ucs" "")
    (setq i 9 ok nil p1 nil)     
    (while (and (= ok nil) (nth (setq i (+ i 1)) (entget (car ax))))
       (if (= 10 (car (nth i (entget (car ax)))))
         (if p1
           (setq p2 (cdr (nth i (entget (car ax)))) ok T) 
           (setq p1 (cdr (nth i (entget (car ax)))))
         )
       )
    )
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
  )
  
  ((and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax))))))
    (command "_ucs" "_e" (car ax)) 
    (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
    
 )

 ((or (= "CIRCLE" (cdr (assoc 0 (entget (car ax)))))
      (= "ARC" (cdr (assoc 0 (entget (car ax)))))
  )   
    (command "_ucs" "_e" (car ax))
    (setq p1 (polar '(0. 0. 0.) 0.0 (cdr (assoc 40 (entget (car ax))))))
    (command "_ucs" "_o" "_non" p1 )  
    (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
 ) 
  
 ((or (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 9 (cdr (assoc 70 (entget (car ax))))))
      (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 1 (cdr (assoc 70 (entget (car ax))))))
   )
     (command "_ucs" "")
     (setq l1 (entget (entnext (cdr (assoc -1 (entget (car ax)))))))
     (setq p1 (cdr (assoc 10 l1)))
     (setq l1 (entget (entnext (cdr (assoc -1 l1)))))
     (setq p2 (cdr (assoc 10 l1)))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
 )
  
 ((= "ELLIPSE" (cdr (assoc 0 (entget (car ax)))))
    (setq ent  (car ax))
  ;; le code traitant les ellipses provient du lisp PELL.lsp de (gile) sur cadxp.com
(setq elst (entget ent))
 (or
   (equal (trans '(0 0 1) 1 0 T) (cdr (assoc 210 elst)) 1e-9)
   (and
     (setq ucs T)
     (command "_.ucs" "_zaxis" "_non" '(0 0 0) "_non" (trans (cdr (assoc 210 elst)) ent 1 T))
   )
 )
(setq  
       pe   (getvar "pellipse")
       elst (entget ent)
       cen  (cdr (assoc 10 elst))
       elv  (caddr (trans cen 0 (cdr (assoc 210 elst))))
       ext  (trans (mapcar '+ cen (cdr (assoc 11 elst))) 0 1)
       cen  (trans cen 0 1)
       pa1  (cdr (assoc 41 elst)) ; angle
       pa2  (cdr (assoc 42 elst))
       grd  (distance cen ext)
       prd  (* grd (cdr (assoc 40 elst)))
       ang  (angle cen ext)
 )

 (if (or (/= pa1 0.0) (/= pa2 (* 2 pi)))
   (progn ; "ellipse coupée" 
     (setq 
           pt1 (list (* grd (cos pa1)) (* prd (sin pa1)))
           pt2 (list (* grd (cos pa2)) (* prd (sin pa2)))
           mat (list (list (cos ang) (- (sin ang)) 0)
                     (list (sin ang) (cos ang) 0)
                     '(0 0 1)
               )
           pt1 (mapcar '+ cen (mxv mat pt1))
           pt2 (mapcar '+ cen (mxv mat pt2))
    a1 (angtos (angle cen pt1) 0 2) a2 (angtos (angle cen pt2) 0 2)   
     )
     (cond   
((or (= a1 "0") (= a1 (angtos pi 0 2)))
        (command "_ucs" "_o" "_non" pt1)
 (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
)
((or  (= a1 (angtos (* 0.5 pi) 0 2)) (= a1 (angtos (* 1.5 pi) 0 2)))
        (command "_ucs" "_o" "_non" pt1)
 (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16))
 (command "_ucs" "_z" (angtos (/ pi 2) (getvar "AUNITS") 16))
)
       ((or (= a2 "0") (= a2 (angtos pi 0 2)))
        (command "_ucs" "_o" "_non" pt2)
 (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
)
((or  (= a2 (angtos (* 0.5 pi) 0 2)) (= a2 (angtos (* 1.5 pi) 0 2)))
        (command "_ucs" "_o" "_non" pt2)
 (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16))
 (command "_ucs" "_z" (angtos (/ pi 2) (getvar "AUNITS") 16))
)
(t (command "_ucs" "_o" "_non" pt1)
   (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16))
   
)
     )
     
    )
    (progn ;  "ellipse entière"
      (setq aec (angle ext cen))
      (command "_ucs" "_o" "_non" ext)
      (command "_ucs" "_z" (angtos aec (getvar "AUNITS") 16))
      (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
    ) 
  )   
 )
  
 (T
  (if (setq p1 (osnap (cadr ax) "_endp"))
   (if (setq p2 (osnap (cadr ax) "_cen"))
    (progn
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
     (command "_ucs" "_y" "-90") 
    )   
    (progn
     (setq p2 (osnap (cadr ax) "_mid"))
     (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    )
   )
   (progn
    (setq p1 (osnap (cadr ax) "_qua"))   
    (setq p2 (osnap (cadr ax) "_cen"))
    (command "_ucs" "_zaxis" "_non" p1 "_non" p2)
    (command "_ucs" "_y" "-90")
   ) 
 ) ; if
)  ; T
)   ; cond

 ;;; validation SCU ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq rep "Non" i 0)
 (while (= rep "Non")
  (setq i (+ 1 i))
  (initget "Oui Non")
  (setq rep (getkword "\nLe SCU est-il correct avec le Z dans la direction d'extrusion ?  [Non] <Oui> : "))
  (if (= rep "Non")
    (if (= i 1)
     (command "_ucs" "_zaxis" pause pause) 
     (progn (command "_ucs" ) (while (not (zerop (getvar "cmdactive")))(command pause)))
    )
  )
 )
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

 (setq P1 '(0. 0. 0.))
 (cond
      ((and (> ep 0)(<= 3)) (setq r (+ ep 1)))
      ((> ep 3) (setq r (+ ep 2))) 
      (t (setq r 3))
 )
 (setq i 1)
 (repeat 2
  (if (= i 2)
   (cond
    ((> ep 0.0)
     (setq tubext (entlast))
     (cond
      ((and (> ep 0)(<= 3)) (setq r  1))
      ((> ep 3) (setq r 2)) 
     )
     (setq la (- la ep) ha (- ha ep))
     (setq i 3)
    ) 
   )
  )

  (cond ((/= i 2)
   (cond	  
    ((= typar "Arrondies")	  
     (command "_PLINE" 
  "_non" (list (- la r) (* ha -1)) 
  "_A" "_CE" "_non" (list (- la r) (* (- ha r) -1)) 
         "_non" (list la  (* (- ha r) -1)) 
  "_L"  "_non" (list la (- ha r)) 
         "_A" "_CE" "_non" (list (- la r) (- ha r)) 
  "_non" (list (- la r) ha)  
         "_L" "_non" (list (* (- la r) -1) ha)
         "_A" "_CE" "_non" (list (* (- la r) -1) (- ha r))
  "_non" (list (* la -1) (- ha r)) 
         "_L" "_non" (list (* la -1) (* (- ha r) -1))
         "_A" "_CE" "_non" (list (* (- la r) -1) (* (- ha r) -1))
  "_non" (list (* (- la r) -1) (* ha -1))
   "_L" "_c"
     )
    )
    ((= typar "Vives")	  
     (command "_PLINE" 
                 "_non" (list (*  la  -1) (* ha -1))
          "_non" (list la (* ha -1))
          "_non" (list la ha)
          "_non" (list (* la -1) ha)
                 "_c"
     )
    )
   )	  
  )) ; cond 
   
  (if (= i 1)(setq i 2)) 
 ) ; repeat 
 
 (cond
   ((= i 2)
    (setq tubext (entlast))
    (command "_rotate" tubext "" "_non" p1)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (command "_sweep" tubext "" ax)  ;; balayage
   ) 
   ((= i 3)
    (setq la (+ la ep) ha (+ ha ep))
    (setq tubint (entlast))
    (command "_rotate" tubint tubext "" "_non" p1)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (command "_sweep" tubext "" ax)  ;; balayage
    (setq tubext (entlast))
    (if (= 2 (getvar "delobj"))(entdel (car ax)))
    (command "_sweep" tubint "" ax)  ;; balayage	 
    (command "_subtract" tubext "" "_L" "")
   )
 )

 (command "_ucs" "_r" "tempftd")
)
(setvar "UCSFOLLOW" CFOLLOW)(setvar "plinewid" pw)(setvar "CMDECHO" CECHO)
 (gc)
(princ) 
)

Profil rectangulaire suivant axe sélectionné

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante