Modification Lisp lexplode de USEGOMME

[BIGC-ROMU]

Salut,

 

Pour moi, ça correspond exactement à mon souhait. Tous marche parfaitement...

 

Un Grand MERCI usegomme :)

 

mais je viens de trouver une faille dans l'attribution des couleurs

 

Quelle problème cela peut il engendrer (avant que je l'utilise à tous va)?

 

 

[usegomme]

En fait c'est quand il y a un bloc dans le bloc à décomposer , c'est donc pas un problème pour toi et de toute manière je ne suis pas assez bon pour aller plus loin.

Reste quand même le problème des calques verrouillés qui peuvent bloquer le lisp.

Sinon je suis content que ça fasse ton affaire.

 

[BIGC-ROMU]

c'est quand il y a un bloc dans le bloc à décomposer

 

Apparemment, il suffit juste de lancer bigburst autant de fois qu'il y a d'imbrication, et ça ne me gène pas.

 

Reste quand même le problème des calques verrouillés qui peuvent bloquer le lisp.

 

Effectivement, c'est marrant...

 

Une idée, en passant.

Pourquoi ne pas detecter l'ensemble des calques verrouillés dans une liste pour tous les dévérouillés en début de programme, et les revérouiller en fin de programme? :casstet:

 

[Patrick_35]

En fait c'est quand il y a un bloc dans le bloc à décomposer

Une autre idée en passant

(while (ssget "x" (list (cons 0 "insert")))
 (c:bigburst)
)

 

@+

[usegomme]

Patrick_35 , voudrais-tu dire qu'il faudrait décomposer les blocs inclus ? aie aie misère.

 

Sinon j'ai réglé le problème des calques verrouillés ,mais pour que ce changement d'état ne ralentisse pas l'exécution du lisp , je désactive temporairement REGENMODE et DYNMODE.

Ca ne pose pas de problème sauf que je ne sais pas si DYNMODE existe sur autocad 2006

aussi avant d'envoyer la mise à jour je fais appel à notre DECAPODE TESTEUR pour cette info.

Merci.

[lecrabe]

 

Hello

 

DRAGMODE = 0 - 2

et

DYNMODE = 0 - 3

 

existent en AutoCAD / MAP version 2006

 

Le Decapode

 

[usegomme]

Bonjour

Bon j'ai vu dans les nouveautés 2006 présentées par Patrick que c'est ok pour dynmode.

 

 ;;;    BIGBURST.LSP adaptation de burst.lsp  12-03-09 ind D, 21-04-09 ind E
;;;    

(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 sauf si Defpoints
              (if  (/= "Defpoints" el-layer)
               (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)

 

[Edité le 21/4/2009 par usegomme]

[usegomme]

Merci Lecrabe, on était en même temps sur le post et je n'avais pas vu ta réponse.

[Patrick_35]

Salut

 

Patrick_35 , voudrais-tu dire qu'il faudrait décomposer les blocs inclus ? aie aie misère.

Ce que je voulais indiquer, c'est que tant que je trouve un bloc dans le dessin, je lance la routine de décomposition. De cette manière, tu n'as pas besoin de faire joujou avec les niveaux d"imbrications.

CQFD

 

@+

[BIGC-ROMU]

Bonjours à tous,

 

Aprés quelque jours de tests auprés de mes collaborateurs, tous semble bien marché.

 

Une seul remarque me revient à chaque fois:

- dans certain blocs, des objets sont dessinés sur le calque Defpoint. Ces objets sont des "aides au dessins". Par conséquent, je souhaiterait que les objets dessinés sur ce calque, le reste aprés décomposition...

 

Si c'est trop compliqué, ou si ça te "gonfle" , je comprendrais.

 

Patrick_35, ou doit on insérer ce code dans le lisp bigburst

 (while (ssget "x" (list (cons 0 "insert")))
 (c:bigburst)
)

 

Merci, pour tous retours...

 

 

[usegomme]

Bonjour , mon silence n'était pas pour raison de "gonflage" , mais simplement parce que je n'avais pas vu ta demande. J'ai modifié le lisp , il te reste à vérifier si c'est ok.

a+

[BIGC-ROMU]

Bonjour,

excuse moi pour le petit retard.

Après vérif., Bigburst marche parfaitement suivant mes souhaits.

Je te remercie encore Usegomme de t'être penché sur mon problème.

 

Excuse moi encore pour le retard...

 

A+

[usegomme]

Salut ,

excuse moi pour le petit retard

Il n'y a pas de souci , je n'en ai pas pris "ombrage".

A+ et meilleurs voeux pour 2010.