Aller au contenu
Problème de lien d'inscription (résolu ?) ×

[RESOLU] - Recherche d'un LISP qui décompose tous les blocs du dessin

LElemurien

Par LElemurien
dans Routines LISP

 Partager

Messages recommandés

LElemurien Apprentice

LElemurien

Posté(e)
Posté(e)

Bonjour,

 

Comme le titre l'indique je recherche un LISP qui décompose tous les blocs du dessin et modifie les attributs en texte.

 

Il me semblait avoir vu un post il y a pas si longtemps sur le sujet mais je n'arrive pas à mettre la main dessus.

 

Si quelqu'un à une idée du post ou encore mieux le LISP en question je suis preneur.

 

Bonne journée!

Lien vers le commentaire
Partager sur d’autres sites
lecrabe Experienced

lecrabe

Posté(e)
Posté(e)

Hello

 

Pour moi, pas besoin de Lisp !?

 

Alors sans AutoCAD et sans trop reflechir !? ... Ca fatigue, il fait CHAUD !

 

1) BURST sur TOUS les Blocs selectionnes - Ainsi les Attributs deviennent des textes

Et par la selection rapide, tu peux "avoir" tous les Blocs du DWG ...

 

2) Decomposer / Exploser TOUS les Blocs selectionnes

Et par la selection rapide, tu peux "avoir" tous les Blocs du DWG ...

 

3) Il faudra peut etre se debarrasser des ATTDEFs

mais facile toujours par la selection rapide !

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites
lecrabe Experienced

lecrabe

Posté(e)
Posté(e)

Hello

 

Bon voici une vieille routine LSP tiree de mon stock de qq milliers de routines !

 

SVP tu nous diras si elle fonctionne et si OUI , sur quelle version de AutoCAD ?

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;;;
;;; BIGBURST.LSP adaptation de burst.lsp  12-03-09 ind D
;;; par  usegomme    le 13/03/2009 - vs 1.1
;;;
;;; Decompose/Explose les blocs/symboles (au 1er niveau) 
;;; en gardant les couleurs / types de ligne / epaisseurs force(e)s 
;;; et en transformant les attributs en textes simples 
;;;
;;; Suggestion de Patrick_35 pour TOUT exploser
;;; (while (ssget "x" (list (cons 0 "insert")))
;;;   (c:bigburst)
;;; )
;;;


(vl-load-com)

(Defun C:BIGBURST (/ item bitset bump att-text lastent burst-one burst    
                 BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME )

  ;-----------------------------------------------------
  ; Item from association list
  ;-----------------------------------------------------
  (Defun ITEM (N E) (CDR (Assoc N E)))
  ;-----------------------------------------------------
  ; Error Handler
  ;-----------------------------------------------------

 (acet-error-init
   (list
     (list "cmdecho" 0
           "highlight" 1
           "regenmode" regenm      ;***
           "dynmode" dynm          ;***
     )
     T     ;flag. True means use undo for error clean up.
   );list
 );acet-error-init


  ;-----------------------------------------------------
  ; BIT SET
  ;-----------------------------------------------------

  (Defun BITSET (A B) (= (Boole 1 A B) B))

  ;-----------------------------------------------------
  ; BUMP
  ;-----------------------------------------------------

  (Setq bcnt 0)
  (Defun bump (prmpt)
     (Princ
        (Nth bcnt '("\r-" "\r\\" "\r|" "\r/"))
     )
     (Setq bcnt (Rem (1+ bcnt) 4))
  )

  ;-----------------------------------------------------
  ; Convert Attribute Entity to Text Entity or MText Entity
  ;-----------------------------------------------------

  (Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
     (setq ANAME (cdr (assoc -1 AENT)))
    ; (if (_MATTS_UTIL ANAME)                            ;***
      ;  (progn                                          ;***
           ; Multiple Line Text Attributes (MATTS) -
           ; make an MTEXT entity from the MATTS data
       ;    (_MATTS_UTIL ANAME 1)                       ;***
       ; )                                               ;***    
       ; (progn                                          ;*** 
           ; else -Single line attribute conversion
           (Setq TENT '((0 . "TEXT")))
           (ForEach INUM '(8
                           6
                           38
                           39
                           62
                           67
                           210
                           10
                           40
                           1
                           50
                           41
                           51
                           7
                           71
                           72
                           73
                           11
                           74
                          )
              (If (Setq ILIST (Assoc INUM AENT))
                  (Setq TENT (Cons ILIST TENT))
              )
           )
           (Setq
              tent (Subst
                      (Cons 73 (item 74 aent))
                      (Assoc 74 tent)
                      tent
                   )
           )
           (EntMake (Reverse TENT))
      ;  )                                              ;***
    ; )                                                ;***
  )

  ;-----------------------------------------------------
  ; Find True last entity
  ;-----------------------------------------------------

  (Defun LASTENT (/ E0 EN)
     (Setq E0 (EntLast))
     (While (Setq EN (EntNext E0))
        (Setq E0 EN)
     )
     E0
  )

  ;-----------------------------------------------------
  ; See if a block is explodable. Return T if it is, 
  ; otherwise return nil
  ;-----------------------------------------------------

  (Defun EXPLODABLE (BNAME / B expld)
     (vl-load-com)
     (setq BLOCKS (vla-get-blocks 
                    (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
     
     (vlax-for B BLOCKS (if (and (= :vlax-false (vla-get-islayout B))
                                 (= (strcase (vla-get-name B)) (strcase BNAME)))
                     (setq expld (= :vlax-true (vla-get-explodable B)))
          )
      )
      expld
   )


  ;-----------------------------------------------------
  ; Burst one entity
  ;-----------------------------------------------------

  (Defun BIGBURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME             
                    ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
                    mlast el-etat bepl EL-COLOR EL-TPL EL-EPL)
     (Setq
        BENT   (EntGet BNAME)
        BLAYER (ITEM 8 BENT)
        BCOLOR (ITEM 62 BENT)
        BBLOCK (ITEM 2 BENT)
        BCOLOR (Cond
                  ((> BCOLOR 0) BCOLOR)
                  ((= BCOLOR 0) "BYLAYER")                      ;***
                  ("BYLAYER")
               )
       BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER")) 
     )
            ;*** rajout
     (if (setq BEPL (item 370 bent)) 
      (if (= bepl -2)                      ;;; -2 = byblock
          (setq bepl nil)
          (if (> bepl 0)(setq bepl (* bepl 0.01)))
      )
     ) 
           ;*** fin rajout
     
     
     (Setq ELAST (LASTENT))
     (If (and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
        (Progn
           (Setq ANAME BNAME)
           (While (Setq
                     ANAME (EntNext ANAME)
                     AENT  (EntGet ANAME)
                     ATYPE (ITEM 0 AENT)
                     AGAIN (= "ATTRIB" ATYPE)
                  )
              (bump "Converting attributes")
              (ATT-TEXT AENT)
           )
        )
     )
        (Progn
           (bump "Exploding block")
           (acet-explode BNAME)
           ;(command "_.explode" bname)
        )
     (Setq   
        SS-LAYER (SsAdd)
        ENAME    ELAST
     )
     (While (Setq ENAME (EntNext ENAME))
        (bump "Gathering pieces")
        (Setq
           ENT   (EntGet ENAME)
           ETYPE (ITEM 0 ENT)
        )
        
        (If (= "ATTDEF" ETYPE)
           (Progn
              (If (BITSET (ITEM 70 ENT) 2)
                 (ATT-TEXT ENT)
              )
              (EntDel ENAME)   
           )
           (Progn
            
             ; propriétés du calque de l'entité avant changement    ;; ajout ***
             (setq el-layer (ITEM 8 ENT))
           (setq EL-COLOR (cdr (assoc 62 (entget (tblobjname "LAYER" (ITEM 8 ENT))))))
           (setq EL-TPL (cdr (assoc 6 (entget (tblobjname "LAYER" (ITEM 8 ENT))))))
           (if (< 0 (setq EL-EPL (cdr (assoc 370 (entget (tblobjname "LAYER" (ITEM 8 ENT)))))))
            (setq EL-EPL (* EL-EPL 0.01)) (if (= EL-EPL -3) (setq EL-EPL "BYLAYER"))
           )
            ; dévérouille calque objet si necessaire
           (setq el-etat (cdr (assoc 70 (tblsearch "LAYER" (ITEM 8 ENT)))))  
           (if (>= el-etat 4)(command "_layer" "_u" (ITEM 8 ENT) "")(setq el-etat nil) )         
               
                   
              (If (= 0 (ITEM 62 ENT))
                 (Command "_.chprop" ename "" "_C" BCOLOR "")
              )
              (If (and (not (ITEM 62 ENT))(/= "0" (ITEM 8 ENT)) )
                  (Command "_.chprop" ename "" "_C" EL-COLOR "")
               )
              
              (If (= "ByBlock" (ITEM 6 ENT))  ;*** remplacé "BYBLOCK" par "ByBlock"
                 (Command "_.chprop" ename "" "_LT" BLTYPE "") 
              )
              (If (and (not (ITEM 6 ENT))(/= "0" (ITEM 8 ENT)))
                  (Command "_.chprop" ename "" "_LT" EL-TPL "")
              )
              
              (If (and (not BEPL) (= -2 (ITEM 370 ENT)))
                 (Command "_.chprop" ename "" "ep" "BYLAYER" "")
              )
              (If (and BEPL (= -2 (ITEM 370 ENT)))
                 (Command "_.chprop" ename "" "ep" BEPL "")
              )
               (If (and (not (ITEM 370 ENT))(/= "0" (ITEM 8 ENT)))
                 (Command "_.chprop" ename "" "ep" EL-EPL "")
               )
                ; toutes les entités seront changées de calque
             (Command "_.chprop" ename "" "_LA" BLAYER "" )
              
              ;restaure etat calque s'il y a lieu
              (if el-etat (command "_layer" "_lo" el-layer ""))  
               
           )
        )
     )            
  )

  ;-----------------------------------------------------
  ; BURST MAIN ROUTINE
  ;-----------------------------------------------------

  (Defun BIGBURST (/ SS1 ca0)                   ;***
     (setq regenm (getvar "REGENMODE"))
     (setvar "REGENMODE" 0)
     
     (setq dynm (getvar "DYNMODE"))
     (setvar "DYNMODE" 0)
     
     (setq PSFLAG (if (= 1 (caar (vports)))
                      1 0
                  )
     )
     (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
     (If SS1
        (Progn
          ;;; dévérouille le calque 0 si besoin
          (setq ca0 (cdr (assoc 70 (tblsearch "layer" "0"))))  ; rajout
          (if (>= ca0 4)(command "_-layer" "_u" "0" ""))        ; rajout
           (Setvar "highlight" 0)
           (terpri)
           (Repeat
              (SsLength SS1)
              (Setq ENAME (SsName SS1 0))
              (SsDel ENAME SS1)
              (BIGBURST-ONE ENAME)          ;*** 
           )
           ;restaure etat calque 0 s'il y a lieu
           (if (>= ca0 4)(command "_-layer" "_lo" "0" "")) ; rajout
           (princ "\n")
        )
     )
  )

  ;-----------------------------------------------------
  ; BURST COMMAND
  ;-----------------------------------------------------

  (BIGBURST)                           ;***

 (acet-error-restore)

);end defun

(princ)

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é