Tube ou Profil Rectangulaire 3D

[usegomme]

Un lisp qui était resté dans mon placard, remettre un peu d'ordre ça fait pas de mal.

Pour tracer du tube ou profil rectangulaire en 3D en complément de "ax2pr" que je viens de mettre à jour sur le sîte.

Le choix des unités est verrouillé sur mm, mais il suffit d'un point virgule devant la ligne (setvar "USERS5" "qz1") pour le rétablir.

J'espère qu'il pourra être utile.

ps: j'ai le même simplifier qui ne fait que du plein et qui s'appelle PLA.lsp

c'est plus rapide et on concerve les valeurs par défaut de chacun.

Je le mettrai dans les petits outils 3D.

 

;; trace en solide 3d 
;; tube carré ou rectangulaire
;; plat, barre carré ou rectangulaire
;; on peut changer le point de référence mais dans le cas d'un tube (ep>0) on ne pourra tracer qu'un seul segment.
;;;;;pour plat ou barre (ep=0) le nombre de segment n'est pas limité
;;;;;il est préférable de prendre un point sur la section 2D pour un résultat prévisible  
;; 16/04/2010    usegomme 
;; 30/5/2010  option nouveau point de base ne permet qu'1 seul segment si tube 

(defun c:TR (/ 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 
	   unit_draw    sv_dm dm unit_key pw
         
         tubext tubint    dynm  CFOLLOW 
         ep la ha r typar npr  
	)

 
 (setvar "USERS5" "qz1")  ;;  FORCE unité mm  le choix est désactivé 

;; definition de l'unité de dessin , en cas d'erreur de choix réinitialisé "users5" via la ligne de commande
 
 (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
   (progn
     (setq sv_dm (getvar "DYNMODE"))
     (cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm))
           (t (setq sv_dm nil dm nil))
     )
  
     (initget "ME CM MM")
     (if (not (setq unit_key (getkword "\nDessin réalisé en [MM/CM/ME] <MM>: ")))
       (setq unit_key "MM")
     )
     (cond
       ((eq unit_key "ME")
 (setq unit_draw 1000)
       )
       ((eq unit_key "CM")
 (setq unit_draw 10)
       )
       ((eq unit_key "MM")
         (setq unit_draw 1)
       )
     )
    
     (setvar "USERS5" (strcat "qz" (itoa unit_draw)))
     (setq unit_draw (/ 1.0 unit_draw))
     
     (if sv_dm (setvar "DYNMODE" sv_dm))
   )
   
   (setq unit_draw (/ 1.0 (atoi (substr (getvar "USERS5") 3))))
   
 )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 
 (setq CFOLLOW (getvar "UCSFOLLOW") 
       pw (getvar "plinewid") tubint nil npr nil
 )

 
 (setq pt_i_fer (getpoint "\n Point de départ du TUBE RECTANGULAIRE ou du FER PLAT: "))
 (if pt_i_fer (setq ftd:clore nil  ftd:ps (getpoint pt_i_fer "\n point suivant DIRECTION et LONGUEUR  : ")))
 (cond
   ((and pt_i_fer ftd:ps)
     (setvar "CMDECHO" 0)
     (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))

     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
     (if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut	   
     (setq la (getdist (strcat "\nLARGEUR tube ou du plat <" (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 du tube ou épaisseur du plat <" (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 pour tube A METTRE A ZERO POUR PLAT ou Barre <" (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))
     (setq sv_dm (getvar "DYNMODE"))
     (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))

      (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
    
   (setvar "plinewid" pw)
   (setvar "CMDECHO" 1)     ;;; pour commande rotation ci-dessous
    
  (cond
   ((= i 2)
    (setq tubext (entlast))
    (command "_rotate" tubext "" "_non" p1)
    (while (not (zerop (getvar "cmdactive")))(command pause))
    (setq npr (getpoint p1 "\n nouveau point de référence <>:"))
    (if npr (command "_move" tubext "" "_non" npr "_non" p1))
   ) 
   ((= 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))
    (setq npr (getpoint p1 "\n nouveau point de référence <>:"))
    (if npr (command "_move" tubint tubext "" "_non" npr "_non" p1))
   )
 )

     ; pivotements scu
     (setvar "CMDECHO" 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" tubext "" "_p" ftd:axefer)
     (setq ftd:fer (entlast))
     (if tubint
(progn
  (if (= (getvar "delobj") 2) (entdel ftd:axefer))
 	  (command "_extrude" tubint "" "_p" ftd:axefer)
         (command "_subtract" ftd:fer "" "_L" "")
         (setq ftd:fer (entlast))
)  
     )
      
     
     (while (and ftd:ps (not (and (/= 0.0 ax2pr:ep) npr)))
       (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")))
      (progn
              (entdel tubext) ; restaure profil 2d
       (if tubint (entdel tubint))
      )
           )

           (command "_extrude" tubext "" "_p" ftd:axefer)
           (setq ftd:fer (entlast))
           (if tubint
            (progn
      (if (= (getvar "delobj") 2) (entdel ftd:axefer)) 
 	      (command "_extrude" tubint "" "_p" ftd:axefer)
             (command "_subtract" ftd:fer "" "_L" "")
             (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
     ;  )


 (setvar "UCSFOLLOW" CFOLLOW)   
 
 ; restoration scu
   (command "_ucs" "_r" "tempftd")
   (command "_undo" "_e")
   (setvar "CMDECHO" 1)
   )
 )
 (princ)
)