Aller au contenu

Messages recommandés

Posté(e)

Bonjour,

 

j'ai trouvé ce lisp qui permet de créer des gaines flexibles :

http://cadxp.com/index.php?/topic/25804-besoin-de-modifier-un-lisp/page__p__140735__hl__%2Bflexible+%2Bgaine__fromsearch__1#entry140735

 

Je le trouve super mais je souhaiterai q'une fois créée, le flexible soit un bloc ou un groupe. Est-ce possible ? Si oui comment ?

 

Et sinon, Est il possible de modifier le choix du SCU ?

Par défault c'est le SCU général mais dans certains cas, le SCU courant est plus intéressant.

 

Merci d'avance pour vos réponses ;)

  • 2 semaines après...
Posté(e)

Bonjour

 

J'ai modifié le lisp pour que la gaine soit en bloc, c'était pour moi le plus simple et le plus rapide puisque j'ai déjà fait cela pour d'autres lisp.

 

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

; P.CHIALE en 99  modifié le 08-01-2010

;; version 21 11 2012 _ gaine en bloc 

; SP permet de tracer une gaine en souple à partir de la sélection 

; de l'axe du trajet. 


;;-------------  change la couleur de la dernière entite créée-------------  


(defun chgcolastent ()  

(command "_change" "_l" "" "_pr" "_co" "8" "") 

) 

;------------- Transformation d'un angle de radians en degres --------------- 


(defun DGR (a) 

 (* 180 (/ a PI)) 

)                                       ; Fin de defun 


;------------- Recouvrement des extrémités ----------------------------------- 


(defun EXT () 

 (setq Ex1D1 (cdr (assoc 10 (entget D1)))) 

 (setq Ex2D1 (cdr (assoc 11 (entget D1)))) 

 (setq Ex1D2 (cdr (assoc 10 (entget D2)))) 

 (setq Ex2D2 (cdr (assoc 11 (entget D2)))) 

)                                       ; Fin de defun 


;------------- Constitution de la sélection pour le réseau ------------------- 


(defun AJED () 

 (ssadd (entlast) rsel) 

)                                       ; Fin de defun 


;============= Commande SCU ================================================== 


(defun SP:SCU (rep / PTP vers lang) 

 

 (cond 

   ((= rep "SG") 

    (setq PTP (trans pt1 1 0)) 

    (command "_ucs" "")                                                         

    (setq PT1 (trans ptp 0 1)) 

    (setq TSCU T)                      ;SCU General 

   ) 


   ((= rep "S30") 

    (setq PTP (trans pt1 1 0)) 

    (command "_ucs" "_z" 30)                            

    (setq PT1 (trans ptp 0 1)) 

    (setq TSCU T)                      ;SCU Z 30 

   ) 


   ((= rep "S45") 

    (setq PTP (trans pt1 1 0)) 

    (command "_ucs" "_z" 45)                                                                    

    (setq PT1 (trans ptp 0 1)) 

    (setq TSCU T)                      ;SCU Z 45 

   ) 


   ((= rep "S60") 

    (setq PTP (trans pt1 1 0))     

    (command "_ucs" "_z" 60)                                                                            

    (setq PT1 (trans ptp 0 1)) 

    (setq TSCU T)                      ;SCU Z 60 

   ) 


   ((= rep "SCu") 

    (initget "Entite Z General") 

    (setq repsc (getkword "\nSCU : [Entite/Z/] :")) 

    (if (= nil repsc) 

      (setq repsc "General") 

    )                                  ;if 


    (cond 

      ((= repsc "Entite") 

       (setvar "osmode" 512) 

       (setq ptsc (getpoint "\nChoix d'objet correspondant au SCU :")) 

       (setq Etsc (ssget ptsc)) 

       (setq PTP (trans pt1 1 0))       

       (command "_ucs" "_e" Etsc)                                       

       (setq PT1 (trans ptp 0 1)) 

       (setq TSCU T) 

       (setvar "osmode" osmd) ; (setvar "osmode" 0) 

      ) 


      ((= repsc "Z") 

       (setq D1 (getreal "\n Angle de rotation autour de l'axe Z :")) 

       (setq PTP (trans pt1 1 0))       

       (command "_ucs" "_z" D1) 

       (setq PT1 (trans ptp 0 1)) 

       (setq TSCU T) 

      ) 


      ((= repsc "General") 

       (setq PTP (trans pt1 1 0))       

       (command "_ucs" "")                                                                              

       (setq PT1 (trans ptp 0 1)) 

       (setq TSCU T)                   ;SCU General 

      ) 

    )                                  ; Fin de cond 

   ) 

 )                                     ;Fin de cond 

)                                       ;Fin de defun 


;============== Dessin d'une partie rectiligne ================================ 


(defun LG (D / vers lang a1 a2 a3 a4 b1 b2 b3 b4 Ex1D Ex2D lgD angD1 Nbr) 

 

 (setq rsel nil) 

 (setq rsel (ssadd))                   ; Creation de la selection pour le reseau   

 (command "_ucs" "")                                                                                    

 (setq Ex1D (cdr (assoc 10 (entget D)))) 

 (setq Ex2D (cdr (assoc 11 (entget D)))) 

 (setq lgD (distance Ex1D Ex2D)) 

 (setq angD1 (angle Ex1D Ex2D)) 

 (setq Nbr (atoi (rtos (/ LgD pasR) 2 0))) 

 (if (<= Nbr 0) 

   (setq Nbr 1) 

 )                                     ;if 

 (setq sp_p (/ lgD Nbr)) 

 (setq A1 (polar Ex1D (+ angD1 (/ PI 2)) (/ diam 2))) 

 (setq B1 (polar Ex1D (- angD1 (/ PI 2)) (/ diam 2)))   

 (command "_line" "_non" A1 "_non" B1 "") 

 (chgcolastent) 

                                                                                

 (AJED) 


 (setq IpD (polar Ex1D angD1 (/ sp_p 2))) 

 (setq A2 (polar IpD (+ angD1 (/ PI 2)) (/ (+ diam ep) 2))) 

 (setq B2 (polar IpD (- angD1 (/ PI 2)) (/ (+ diam ep) 2))) 

   

     (command "_line" "_non" A1 "_non" A2 "") 

     (AJED) 

     (command "_line" "_non" B1 "_non" B2 "") 

     (AJED) 

     (command "_line" "_non" A2 "_non" B2 "") 

     (chgcolastent) 

     (AJED) 


 (setq IpD (polar Ex1D angD1 sp_p)) 

 (setq A3 (polar IpD (+ angD1 (/ PI 2)) (/ diam 2))) 

 (setq B3 (polar IpD (- angD1 (/ PI 2)) (/ diam 2))) 


     (command "_line" "_non" A2 "_non" A3 "") 

     (AJED) 

     (command "_line" "_non" B2 "_non" B3 "") 

     (AJED) 

     (command "_ucs" "_e" D) 

     (command "_change" D "" "_pr" "_lt" "axes2" "") 

                                       ;(command "_erase" D "") 

     (if (/= Nbr 1) 

       (command "_array" rsel "" "_r" 1 Nbr sp_p) 

     ) 

     (command "_ucs" "") 

                                                                         

 (setq A4 (polar Ex2D (+ angD1 (/ PI 2)) (/ diam 2))) 

 (setq B4 (polar Ex2D (- angD1 (/ PI 2)) (/ diam 2))) 

  

   (command "_line" "_non" A4 "_non" B4 "") 

   (chgcolastent) 


)                                       ; Fin de defun 


;============== Dessin d'une partie arrondie ================================== 


(defun AR (C / vers lang a1 a2 a3 a4 b1 b2 b3 b4 Ag1C Ag2C rayC cenC 

                     AgC Ag2C Ag1C lgC Nbr sp_p agpas Ex1C AngC IpD) 



 (setq rsel nil) 

 (setq rsel (ssadd))                   ; Creation de la selection pour le reseau 

  

 (command "_ucs" "") 

                                

 (setq Ag1C (cdr (assoc 50 (entget C)))) 

 (setq Ag2C (cdr (assoc 51 (entget C)))) 

 (setq rayC (cdr (assoc 40 (entget C)))) 

 (setq cenC (cdr (assoc 10 (entget C)))) 


 (setq AgC (- Ag2C Ag1C)) 

 (if (= T (< AgC 0)) 

   (setq AgC (+ AgC (* 2 PI))) 

 )                                     ;if 


 (setq lgC (* rayc AgC)) 

 (setq Nbr (atoi (rtos (/ lgC pasA) 2 0))) 

 (if (<= Nbr 0) 

   (setq Nbr 1) 

 )                                     ;if 


 (setq sp_p (/ lgC Nbr)) 

 (setq agpas (/ AgC Nbr 2)) 


 (setq Ex1C (polar cenc Ag1C rayc)) 

 (setq AngC (angle CenC Ex1C)) 


 (setq A1 (polar Ex1C AngC (/ diam 2))) 

 (setq B1 (polar Ex1C (+ AngC PI) (/ diam 2))) 

      

     (command "_line" "_non" A1 "_non" B1 "") 

     (chgcolastent) 

     (AJED) 

                                                

 (setq IpD (polar cenC (+ Ag1C agpas) rayc)) 

 (setq A2 (polar IpD (+ ag1C agpas) (/ (+ diam ep) 2))) 

 (setq B2 (polar IpD (+ ag1C agpas) (- (/ (+ diam ep) 2)))) 

      

     (command "_line" "_non" A1 "_non" A2 "") 

     (AJED) 

     (command "_line" "_non" B1 "_non" B2 "") 

     (AJED) 

     (command "_line" "_non" A2 "_non" B2 "") 

     (chgcolastent) 

     (AJED) 

                                        

 (setq IpD (polar cenC (+ Ag1C (* agpas 2)) rayc)) 

 (setq A3 (polar IpD (+ ag1C (* agpas 2)) (/ diam 2))) 

 (setq B3 (polar IpD (+ ag1C (* agpas 2)) (- (/ diam 2)))) 

  

     (command "_line" "_non" A2 "_non" A3 "") 

     (AJED) 

     (command "_line" "_non" B2 "_non" B3 "") 

     (AJED) 

     (command "_change" C "" "_pr" "_lt" "axes2" "") 

                                       ;(command "_erase" C "") 

     (if (/= Nbr 1) 

       (command "_array" 

                rsel 

                "" 

                "_p" 

                "_non" cenC 

                Nbr 

                (DGR (- AgC (* agpas 2))) 

                "_y" 

       ) 

     )                                 ;if 

    

 (setq Ex2C (polar cenc Ag2C rayc)) 

 (setq A4 (polar Ex2C Ag2C (/ diam 2))) 

 (setq B4 (polar Ex2C (+ Ag2C PI) (/ diam 2))) 

  

 (command "_line" "_non" A4 "_non" B4 "") 

 (chgcolastent) 


)                                       ; Fin de defun 


;============== Début du programme ========================================== 


(defun C:SP (/ ct r sel k nom typ sb D1 D2 testw vers lang
             
       elast nom nomb i
     ) 


 (setq elast (entlast))    ;;;;;;;;;;

 (setq cmde (getvar "cmdecho")) 

 (setq blip (getvar "blipmode")) 

 (setq pdmd (getvar "pdmode")) 

 (setq pdsz (getvar "pdsize")) 

 (setq osmd (getvar "osmode")) 


 (setvar "cmdecho" 0) 

 (setvar "blipmode" 0) 


   (command "_ucs" "") 

 


;-------------- Vérification de l'échelle de dessin du menu CLIM ------------ 


 (if (= nil echt) 

   (progn 

     (princ "\n** ATTENTION : Echelle de dessin non definie **") 

     (initget 1 "ME CM MM") 

     (setq echt 

            (getkword 

              "\nVeuillez preciser l'echelle de travail [ME/CM/MM] : " 

            ) 

     ) 

     (cond ((= echt "ME") 

            (setq echt 0.001) 

           ) 

           ((= echt "CM") 

            (setq echt 0.1) 

           ) 

           ((= echt "MM") 

            (setq echt 1) 

           ) 

     )                                 ;cond 

                                        

   )                                   ; Fin de progn 

 )                                     ; Fin de if 


;-------------- Test de l'existance d'une valeur pour le diamètre ----------- 


 (if (= nil sp_d) 

   (setq diam 125) 

   (setq diam sp_d) 

 ) 


;-------------- Saisie de la valeur du diamètre de la gaine souple ---------- 


 (setq tx (strcat "\nDiamètre de la gaine <" (rtos diam 2 0) ">:")) 

 (setq rep (getreal tx)) 

 (if (= nil rep) 

   (setq diam (* echt diam)) 

   (setq diam (* echt rep)) 

 ) 

 (setq sp_d (/ diam echt)) 


;============== Initialisation des variables configurables ================= 


; pasR : Pas d'une spire complète en mm en rectiligne 

; pasA : Pas d'une spire complète en mm en arrondi 

; ep : Epaisseur de débordement sur le diamètre en mm 

; coef : Coefficient de tracé du coude (Coef x Diamètre) 


 (setq pasR (* (+ (* 0.36 sp_d) 0.0011) echt)) 

 (if (< (/ pasR echt) 45.0011) 

   (setq pasR (* 45.0011 echt)) 

 ) 

 (setq pasA (- pasR echt)) 

 (setq ep (- pasA echt)) 

 (setq coef 1.5) 

 (setq e1 (entlast)) 



;------------- Dessin par trajet et sélection d'entités ---------------------- 


 (setq sel  nil 

       selE nil 

 ) 

 (setq sel  (ssadd) 

       selE (ssadd) 

 ) 

 

 (initget "Entite") 

 (setq pt1 (getpoint "\nPoint de départ ou [Entite] :")) 

 (cond 


   ((= "Entite" pt1) 

    (setq selE (ssget)) 

    (setq testW "Fin") 

   ) 

 )                                     ; Fin de cond 


 (while (/= "Fin" testw) 

   (initget 32 "SCu SG S30 S45 S60") 

   (setq rep (getpoint pt1 "\nPoint suivant ou [sCu/SG/S30/S45/S60] :")) 


   (SP:SCU rep) 


   (cond 


     ((/= T TSCU) 

      (setq pt rep) 


      (if (/= nil pt) 

        (progn 

           

          (command "_line" "_non" pt1 "_non" pt "") 

           

          (ssadd (entlast) sel) 

          (redraw (entlast) 3) 

          (setq prov pt1 

                pt1  pt 

                pt   prov 

          ) 

        )                              ; fin de progn 


        (setq testw "Fin") 


      ) 

     )                                 ; fin de if et condition 

   )                                   ; Fin de cond 


   (setq TSCU nil) 

 )                                     ; Fin de while 

 (setq testw nil) 


 

 (command "_ucs" "") 

  


;------------- Tri de la sélection entre trajet et Entités ------------------- 


 (if (/= 0 (sslength sel)) 


   (progn 


     ;------------- Création des coudes à partir des entités croisées ------------- 


     (setq k 0) 

     (setq lgsel (sslength sel)) 

     (setvar "FILLETRAD" (* coef diam)) 


     (while (< k (- lgsel 1)) 

       (setq D1 (ssname sel k)) 

       (setq D2 (ssname sel (+ k 1))) 

       (EXT)                           ; recouvrement des extrémités 

       (if (/= nil (inters Ex1D1 Ex2D1 Ex1D2 Ex2D2)) 

         (progn             

           (command "_fillet" D1 D2) 

           (ssadd (entlast) sel)            

         )                             ; Fin de progn 

       )                               ; Fin de if 


       (setq k (1+ k)) 

     )                                 ;Fin de while 


   )                                   ; Fin de progn 


   (setq sel selE) 


 )                                     ; Fin de if 


;============= Vérification de la sélection ================================== 


 (princ "\nTraitement en cours, patientez s.v.p...\n") 


 (setq lst (list (list "LINE") (list "ARC"))) 

 (setq selt (ssadd)) 

 (setq k 0) 


 (while (< k (sslength sel)) 

   (setq nom (ssname sel k) 

         typ (entget nom) 

   ) 

   (if (/= nil (assoc (cdr (assoc 0 typ)) lst)) 

     (ssadd nom selt) 

   )                                   ;Fin de if 

   (setq k (1+ k)) 

 )                                     ;Fin de while 


 (setq pts (assoc 10 (entget (ssname selt 0)))) 


;============= Traitement de la sélection ==================================== 


 (setq k 0) 


 (while (< k (sslength sel)) 

   (setq nom (ssname sel k) 

         typ (entget nom) 

   ) 


   (if (= "LINE" (cdr (assoc 0 typ))) 

     (LG nom) 

   ) 


   (if (= "ARC" (cdr (assoc 0 typ))) 

     (AR nom) 

   ) 


   (setq k (1+ k)) 

 )                                     ;Fin de while 

  

   (command "_ucs" "") 



;============== Fin du Traitement ============================================

;;;;;;;;;;;;;;; création du bloc  ;;;;;;;;;;;;;;;;;;;;;;;;;


 (setq nom (strcat "Gaine_Souple_" (rtos diam) "-" (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)))
 )


 (setq  sel nil sel (ssadd))
 (if elast
  (while (entnext elast)
   (ssadd (entnext elast) sel)
   (setq elast (entnext elast))
  )
  (setq sel (ssget "_x"))
 ) 

(command "_-block" nomb "_non" '(0. 0. 0.) sel  "")
 
(command "_-insert" nomb "_non" '(0. 0. 0.) "" "" "0" ) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

 (princ) 


)

  • 1 mois après...
Posté(e)

Bonjour, :)

 

.........et merci à USEGOMME pour cette amélioration très utile.

Par contre ( ;) et oui !!!) est-ce normal que l'on ne puisse pas sélectionner une "polyligne" comme trajet à l'invitation du choix de l'Entité ?. Seules les lignes et arcs sont autirisés.

Ce serait sympa si cette modification pouvait se faire, dans la mesure du possible bien sûr.

Merci d'avance. :D

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é