Générateur de profil métallique 2d et 3d

[aldo127]

J'ai aussi testé ta routine ftdr qui est bien, mais on pourrait y ajouter le poids du profilé, ce qui permettrait d'extraire le bordereau des profilés avec leurs poids.

Possible? En entrant la masse volumique de l'acier lors de la création du profil?

Faudra faire attention à l'unité du dessin.

Possibilité de choisir le calque des attributs?garder en mémoire?

 

[usegomme]

Salut à tous ,

J'ai rajouté le poids du profilé pour répondre à la demande d' aldo127.

Pour ce qui est de la densité j'ai mis 7.81 et rectifié à 7.85

En entrant la masse volumique de l'acier lors de la création du profil?

Donne moi des valeurs et à quoi ça correspond pour avoir un choix pour ceux qui comme moi ne pratique pas régulièrement.

Possibilité de choisir le calque des attributs?garder en mémoire?

A voir , mais plus tard.

 

;; FTD R--> Fer 3 D Renseigné type fer , longueur et poids  
;; version 4.3  de ftd    13-03-2010   usegomme sur Cadxp.com
;; tracer un profilé 3D en passant par des points et en sélectionnant sa section
;; grace à l'interface écran de L.Bouquillon 
;; et de PROFIL.LSP de L.Bouquillon ,adapté par Maxence Delannoy,
;; et modifié par moi-même , sans lequel cette routine ne peut pas fonctionner.
;; la version 4.3 permet ,si on active l'option correspondante dans le lisp
;;d'avoir la section du profil dans le bloc d'info.

(defun c:FTDR (/ pt_i_fer ftd:clore ftd:ps ftd:sommets ftd:profmet ftd:point
                ftd:fer ftd:pp ftd:axefer  i pt_i_fer_SCG ftd:ps_SCG att1 att2 att3 pc_SCG
	 longf longfer aspm unit_draw flong  fsurf mesure
	) 

 (if (null c:PROFIL)(load "PROFIL")) 
 
 (setq pt_i_fer (getpoint "\n Point de départ du fer: "))
 (if pt_i_fer (setq ftd:clore nil  ftd:ps (getpoint pt_i_fer "\n point suivant  : ")))
 (cond
   ((and pt_i_fer ftd:ps)  
     (command "_undo" "_be")
     ; sauve scu courant
     (command "_ucs" "_s" "tempftd") 
     (if (not (zerop (getvar "cmdactive")))(command "_y"))
     
     (command "_line" "_none" pt_i_fer "_none" ftd:ps "")
     (setq ftd:axefer (entlast))
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))
     (command "_ucs" "_zaxis" "_none" pt_i_fer "_none" ftd:ps)
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))

     ; sauve scu zaxis
     (command "_ucs" "_s" "tempftdzaxis") 
     (if (not (zerop (getvar "cmdactive")))(command "_y"))
     
     (c:profil)  ;; choix profil

     (setq ftd:profmet (entlast))

     ; aire section profil métallique
     (vl-load-com)
     (setq aspm (vla-get-area (vlax-ename->vla-object (entlast))))

     ; récupération de l'unité de mesure définie par profil.lsp
     (if (eq (substr (getvar "USERS5") 1 2) "qz")
         (setq unit_draw (atoi (substr (getvar "USERS5") 3)))
  (setq unit_draw 1)	
     )
     (cond
((= unit_draw 1000) (setq flong 10 fsurf 100 mesure " m"))
((= unit_draw 10) (setq flong 0.1 fsurf 0.01 mesure " cm"))
((= unit_draw 1) (setq flong 0.01 fsurf 0.0001 mesure " mm"))
     )	
      
     ; pivotements scu 
     (setq pc_SCG (trans pc 1 0))
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))     
     (command "_ucs" "_x" "-90")
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))     
     
     (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) 
     (setq ftd:ps_SCG (trans ftd:ps 1 0))     
     (command "_ucs" "_Z" "-90")
     (setq pt_i_fer (trans pt_i_fer_SCG 0 1))
     (setq ftd:ps (trans ftd:ps_SCG 0 1))      
     
     (setq ftd:sommets (list ftd:ps))

     ;; extrusion suivant chemin (path)
     (command "_extrude" ftd:profmet "" "_p" ftd:axefer)
     (setq ftd:fer (entlast))
     (while ftd:ps
       (setq ftd:pp ftd:ps)
       (if (< i 2)
         (setq ftd:ps (getpoint ftd:pp "\n point suivant :"))
         (progn
           (initget "Clore")
           (setq ftd:ps (getpoint ftd:pp "\n point suivant [Clore] :"))
           (if (= ftd:ps "Clore")
             (setq ftd:clore t)
           )
         )
       )
       (if ftd:ps
         (progn
           (if ftd:clore
             (setq ftd:ps nil)
             (setq ftd:sommets (append ftd:sommets (list ftd:ps)))
           )
           (entdel ftd:fer); efface fer 3d
       ;;efface AXE précédent
           (if (or (= 0 (getvar "delobj"))(= 1 (getvar "delobj")))
             (entdel ftd:axefer)
           )
           (command "_3dpoly" "_none" pt_i_fer)
           (setq i 0)
           (repeat (length ftd:sommets)
             (setq ftd:point (nth i ftd:sommets))
             (command "_none" ftd:point)
             (setq i (1+ i))
           )
           (if (not ftd:clore)
             (command "")
             (command "_c")
           )
           (setq ftd:axefer (entlast))
           (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj")))
             (entdel ftd:profmet) ; restaure profil 2d
           )
           (command "_extrude" ftd:profmet "" "_p" ftd:axefer)
           (setq ftd:fer (entlast))
           
         )
       )
     )


 ;; AXE présent ou pas suivant variable delobj en désactivant les 2 options ci-dessous
 ;;   ou bien 
 ;  AXE TOUJOURS EFFACé  (oter les ;)
  ;   (if (= 1 (getvar "delobj"))
   ;    (entdel ftd:axefer) ;efface AXE
   ;  )
   ;; ou AXE TOUJOURS PRESENT (oter les ;)
        (if (= 2 (getvar "delobj"))
         (entdel ftd:axefer) ;restaure AXE
       )

;; Longueur totale du ou des segments
     (setq i 0 longF nil)
           (repeat (length ftd:sommets)
             (setq ftd:point (nth i ftd:sommets))
      (if (= i 0) (setq p1 pt_i_fer))
      (if longF
       (setq longF (+ longF (distance p1 ftd:point)) p1 ftd:point)	
              (setq longF (distance p1 ftd:point) p1 ftd:point)
      )	
             (setq i (1+ i))
           )
           (if ftd:clore
              (setq longF (+ longF (distance ftd:point pt_i_fer)))
           )
      (setq longFer (strcat (rtos longF 2 1) mesure))

;; poids total en Kg         ;; densité acier à ajuster 
    (setq ptkg (strcat (rtos (* 7.81 longF flong aspm fsurf) 2 2) " Kg"))    

 
;; création attributs

 (setq st (getvar "textstyle"))
 (setvar "textstyle" "standard")
 (setq tsize (getvar "textsize"))   
 (setq af (getvar "aflags"))           
 (setq modelfer (strcat fer type_fer))
 (setq ht (* 0.07 h_fer (/ 1.0 unit_draw))) ; hauteur texte
 (setq it (* 1.3 ht))          ; intervale ligne texte


 (if (or (= fer "IPE") (= fer "IPN") (= fer "HEA") (= fer "HEB") (= fer "COR") (= fer "CORL") (= fer "HEM") (= fer "IPEA"))
     (command "_ucs" "_x" "90")
 )
     
 (setq pc (trans pc_SCG 0 1))  
 (setvar "aflags" 0)
 ; (setvar "aflags" 1)  ;;;  invisible
 (command "_-attdef" "" "NOM" "quel nom ?" "?"   "_non" (polar pc (* 0.5 pi) (+ (* 3 it) (* 0.2 ht)))  ht "0")
 (setq att1 (entlast))
 (setvar "aflags" 8)  ;;; prédéfini
  ; (setvar "aflags" 9)  ;;; prédéfini et invisible
 (command "_-attdef" "" "PROFIL" "PROFIL" modelfer  "_non" (polar pc (* 0.5 pi) (+ (* 2 it) (* 0.2 ht)))  ht "0")
 (setq att2 (entlast))
 (setvar "aflags" 8)   ;;; prédéfini
 (command "_-attdef" "" "LONG"  "Longueur" longFer  "_non" (polar pc (* 0.5 pi) (+ it (* 0.2 ht)))  ht "0")
 (setq att3 (entlast))
 (command "_-attdef" "" "POIDS"  "Poids" ptkg  "_non" (polar pc (* 0.5 pi) (* 0.2 ht))  ht "0")
 (setq att4 (entlast))  
    
 ; alignement angulaires des attributs
 (command "_ucs" "_r" "tempftdzaxis")
 (command "_rotate" att1 att2 att3 att4 "" "_non" '(0. 0. 0.) "")
 (command "_ucs" "_p")

; nom du nouveau bloc

 (setq nom (strcat modelfer "-" (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) "_"))
 (setq nomb (strcat  nom "1"))   
 (setq i 1 )  
 (while (tblsearch "block"  nomb)
  (setq i (1+ i))
  (setq nomb (strcat  nom (itoa i)))
 )
  
      
; créer et insérer  bloc
; 2 OPTIONS au choix , activer celle désirée 
      
 ;; 1 SANS section du profil dans le bloc
 (command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer "")

 ;; 2  ou AVEC section du profil dans le bloc -> ftd:profmet
    ;;; restauration section du profil pour pouvoir l'insérer dans le bloc
    
; (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj")))(entdel ftd:profmet))
 ;(command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer ftd:profmet "")    

;;;;;;;;;  fin des options du bloc   
    
 (setq atdia (getvar "attdia"))
 (setvar "attdia" 1)
 (command "_-insert" nomb "_non" '(0. 0. 0.) "" "" "0" )
 (setvar "attdia" atdia)

 (setvar "aflags" af)
 (setvar "textsize" tsize )  
 (setvar "textstyle" st)
 
 ; restoration scu
   (command "_ucs" "_r" "tempftd")
   (command "_undo" "_e")
   )
 )
 (princ)
) 

 

 

[Edité le 11/3/2010 par usegomme]

 

[Edité le 13/3/2010 par usegomme]

[thry0]

Bjr à tous,

 

Je pratique un peu la charpente et l'acier d'une manière générale

et on considère communément une densité de 7.85 Kg/m3 pour l'acier.

Juste une valeur à modifier dans le lisp pour ceux qui le souhaitent ...

Sinon le lisp fonctionne à merveille. Bravo !

[usegomme]

Bonjour, c'est rectifié , merci thry0.

[FRAXA]

Bonjour usegomme,

 

Toutes les mofications apportées sont superbes mais, il y a toujours un mais, pouurais-tu modifier le FTDR, pour:

- pouvoir choisir le nom du bloc créé

- insérer dans le bloc la surface extrudée originale (permet de comparer visuellement le bloc et le solide).

 

Merci d'avance

 

[aldo127]

Merci usegomme pour ce petit rajout qui fonctionne à merveille. Beau travail

[usegomme]

Salut ,

Merci aldo127.

Sinon pour répondre en partie à FRAXA , j'ai rajouté une option dans le lisp qu' on peut

activer en enlevant les point-virgule , pour avoir la section du profil dans le bloc d'info.

 

; créer et insérer  bloc
; 2 OPTIONS au choix , activer celle désirée 
      
 ;; 1 SANS section du profil dans le bloc
; (command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer "")

 ;; 2  ou AVEC section du profil dans le bloc -> ftd:profmet
    ;;; restauration section du profil pour pouvoir l'insérer dans le bloc
    
  (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj")))(entdel ftd:profmet))
  (command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer ftd:profmet "")    

;;;;;;;;;  fin des options du bloc  

 

Le code complet plus haut est modifié ,mais avec l'option 1 active.

 

Pour ce qui est d' entrée le nom du bloc manuellement ça ne me semble pas une bonne idée s 'il y a beaucoup de fer. Mais en tout cas il faut une boite de dialogue comme celle de getblock de (gile) , si tu en connais une , je veux bien , sinon il faut la créer ou faire une adaptation.

[FRAXA]

Bonjour Usegomme,

 

Désolé de te déranger mais je n'arrive pas à activer l'option 2.

Pourrais-tu mettre le bout de code avec l'option 2 active en ligne.

 

Merci

[thry0]

Bjr à tous,

 

FRAXA il suffit d'ajouter ou enlever les points virgules placés en début de ligne de code

Soit pour activer l'option 1 :

(command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer "") 

 

Soit pour activer l'option 2 :

 (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj")))(entdel ftd:profmet))
  (command "_-block" nomb "_non" '(0. 0. 0.) att1 att2 att3 att4 ftd:axefer ftd:profmet ""

 

On active bien évidemment soit l'une soit l'autre selon les besoins ...

[usegomme]

Salut à tous.

Voici une petite correction du fichier de données des profils HEA.

 

profil_HEA.DAT

;Base de données écrit par L.BOUQUILLON le 27.03.97
;Modifié le 15-09-2010 MT .Rajouté HEA400 et rectifié HEA360.
;Objet : HEA.
-hh-----h----b----a----e-----r---h1
1000,990,300,16.5,31.0,30,868
0900,890,300,16.0,30.0,30,770
0800,790,300,15.0,28.0,30,674
0700,690,300,14.5,27.0,27,582
0650,640,300,13.5,26.0.27,534
0600,590,300,13.0,25.0,27,486
0550,540,300,12.5,24.0,27,438
0500,490,300,12.0,23.0,27,390
0450,440,300,11.5,21.0,27,344
0400,390,300,11.0,19.0,27,298
0360,350,300,10.0,17.5,27,261
0340,330,300,09.5,16.5,27,243
0320,310,300,09.0,15.5,27,225
0300,290,300,08.5,14.0,27,208
0280,270,280,08.0,13.0,24,196
0260,250,260,07.5,12.5,24,177
0240,230,240,07.5,12.0,21,164
0220,210,220,07.0,11.0,18,152
0200,190,200,06.5,10.0,18,134
0180,171,180,06.0,09.5,15,122
0160,152,160,06.0,09.0,15,104
0140,133,140,05.5,08.5,12,092
0120,114,120,05.0,08.0,12,074
0100,096,100,05.0,08.0,12,056

[RhymOne]

Bonjour,

Serait-il possible au lancement de lisp de laisser le choix entre:

Création d'un chemin pour l'extrusion.

Selection d'un chemin existant.

 

Merci d'avance....

[usegomme]

Salut , ce sera le choix d'une autre commande et d'un autre lisp mais qui fait toujours appel à PROFIL.lsp

que j' invite à retélécharger car j'y ai rectifié un petit oubli.

 

; FTDA  Fer Trois D suivant un Axe sélectionné , fonctionne avec PROFIL.lsp
; version 1 le 05-11-2010
; Usegomme sur Cadxp.com  , avec du code à (gile) pour les ellipses

;------------------------------------------------------------------------------
;; 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:FTDA (/ pt_i_fer  ax p1 p2  i l1  CFOLLOW elst pe cen elv ext pa1 pa2 grd prd ang pt1 pt2 mat a1 a2 aec)

(if (null c:PROFIL)(load "PROFIL"))
 
(setq CFOLLOW (getvar "UCSFOLLOW"))    

(setvar "UCSFOLLOW" 0) 
      ; sauve scu courant
(command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y"))

(while       
 (setq ax (entsel  "\nSélectionner l'AXE pour le Profilé Métallique:"))

 (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
 
 (setq pt_i_fer '(0. 0. 0.))
 (c:profil)
 (setq ftd:profmet (entlast))

 (command "_sweep" ftd:profmet "" ax)

 (command "_ucs" "_r" "tempftd")
)
(setvar "UCSFOLLOW" CFOLLOW)
 
(princ) 
)  

 

[Edité le 13/2/2011 par usegomme]

[usegomme]

S' il y en a qui veulent du rectangulaire barre ou tube il faut télécharger AX2PR.lsp qui m'a servi à faire le montage précédent car il fonctionne sur le même principe.

a+