Modification Lisp lexplode de USEGOMME

BIGC-ROMU · le 25 février 2009

Bonjours à tous,

Je viens de trouver sur le forum, le lisp lexplode de usegomme (voir ci-dessous), qui est trés intéressant, mais pour moi, reste incomplet.

Je dessine essentielle mes blocs dans le calque 0 et les propriétés (couleur, type de ligne, épaisseur) de l'ensemble de mes objets sont sur DuBloc (sauf exeptions).

J'insere mes blocs toujour sur un calque autre que le calque 0, et bien souvent je modifie leurs propriétés (couleur, type de ligne, épaisseur).

Je souhaite qu'en décomposant mes blocs:

- Les objets des calques 0 et autre soit sur leur calque d'insertion.

- Les objet avec les propriétés Dublocs (couleur, type de ligne, épaisseur) reprennent leur propriété d'insertion (DuCalque, autre...)

- Les autres objets ayant des propriétés autre que DuBloc, les gardes aprés décomposition

Et le top, se serait que l'on puisse décomposer les attributs en texte (comme la commande des Express).

Bon, je crois que j'en demande un peu beaucoup, mais qui sait...

D'avance merci pour vos réponses...

usegomme si tu nous écoute!

Le lisp de usegomme

 ;; usegomme 08-09-2008
;; decompose en concervant le calque de l'objet
;; et concerve les calques internes au bloc autre que 0
(defun c:lexplode (/ js ent lent  typent ss ca ca0 ca2 i1 i2)
 (setvar "cmdecho" 0)
 (setq ca0 (cdr (assoc 70 (tblsearch "layer" "0"))))
 (if (>= ca0 4)(command "_layer" "_u" "0" ""))
 (setq js (ssget))
 (setq i1 0)
 (repeat (sslength js)
   (setq ent (ssname js i1))
   (setq lent (entget ent))
   (setq typent (cdr (assoc 0 lent)))
   (setq ca (cdr (assoc 8 lent))) 
   (command "_explode" ent)
   (if (not (zerop (getvar "cmdactive")))(command))   
   (if (and (setq ss (ssget "p"))(/= typent "3DSOLID")
     (/= typent "SURFACE")(/= typent "REGION"))
     (progn
       (setq i2 0)
       (repeat (sslength ss)
         (setq ent (ssname ss i2))

        (setq ca2 (cdr (assoc 8 (entget ent))))
        (if ( = ca2 "0")
         (command "_change" ent "" "_p" "_layer" ca "") 
           )       
         (setq i2 (1+ i2))   
       )
     )
   )
   (setq i1 (1+ i1))
 )
 (if (>= ca0 4)(command "_layer" "_lo" "0" "")) 
 (setvar "cmdecho" 1)
 (princ)
)

usegomme · le 26 février 2009

Salut BIGC-ROMU

Je vais voir ce que je peux faire en attendant tu devrais utiliser la 1er version de lexplode qui correspond mieux à ton besoin et qui est dans le même post.

Je la met ci-dessous mais j'ai changé son nom .

;; usegomme 03-09-2008
;; decompose en concervant le calque de l'objet
(defun c:expl2lo (/ js ent lent  typent ss ca ca0 i1 i2)
 (setvar "cmdecho" 0)
 (setq ca0 (cdr (assoc 70 (tblsearch "layer" "0"))))
 (if (>= ca0 4)(command "_layer" "_u" "0" ""))
 (setq js (ssget))
 (setq i1 0)
 (repeat (sslength js)
   (setq ent (ssname js i1))
   (setq lent (entget ent))
   (setq typent (cdr (assoc 0 lent)))
   (setq ca (cdr (assoc 8 lent))) 
   (command "_explode" ent)
   (if (not (zerop (getvar "cmdactive")))(command))   
   (if (and (setq ss (ssget "p"))(/= typent "3DSOLID")
     (/= typent "SURFACE")(/= typent "REGION"))
     (progn
       (setq i2 0)
       (repeat (sslength ss)
         (setq ent (ssname ss i2))
         (command "_change" ent "" "_p" "_layer" ca "")        
         (setq i2 (1+ i2))   
       )
     )
   )
   (setq i1 (1+ i1))
 )
 (if (>= ca0 4)(command "_layer" "_lo" "0" "")) 
 (setvar "cmdecho" 1)
 (princ)
)

[Edité le 26/2/2009 par usegomme]

usegomme · le 26 février 2009

Regarde si ça commence à ressembler à ce que tu souhaites.

;; usegomme 26-02-2009 indice A  avec epaisseur ligne
;; decompose en concervant le calque de l'objet et ses propriétés
(defun c:expl2po (/ js ent lent  typent ss ca ca0 i1 i2 CO LT ep epb)
 (setvar "cmdecho" 0)
 (setq ca0 (cdr (assoc 70 (tblsearch "layer" "0"))))
 (if (>= ca0 4)(command "_layer" "_u" "0" ""))
 (setq js (ssget))
 (setq i1 0)
 (repeat (sslength js)
   (setq ent (ssname js i1))
   (setq lent (entget ent))
   (setq typent (cdr (assoc 0 lent)))
   (setq ca (cdr (assoc 8 lent)))
   (if (setq epb (cdr (assoc 370 lent)))(setq epb (* epb 0.01)))
   (command "_explode" ent)
   (if (not (zerop (getvar "cmdactive")))(command))   
   (if (and (setq ss (ssget "p"))(/= typent "3DSOLID")
     (/= typent "SURFACE")(/= typent "REGION"))
     (progn
       (setq i2 0)
       (repeat (sslength ss)
         (setq ent (ssname ss i2))
         (if (= 0 (setq co (cdr (assoc 62 (entget ent))))) (setq co "bylayer"))
         (if (= "ByBlock" (setq lt (cdr (assoc 6 (entget ent))))) (setq lt "bylayer"))
         
         (if (= -2 (cdr (assoc 370 (entget ent)))) (setq ep "bylayer")(setq ep nil))
         
         (command "_change" ent "" "_p" "_layer" ca )
         (if co (command "_co" co))
         (if lt (command "_lt" lt))
         (cond 
           ((and epb ep)(command "ep" epb))
           (ep (command "ep" ep)) 
         )
         (command "")        
         (setq i2 (1+ i2))   
       )
     )
   )
   (setq i1 (1+ i1))
 )
 (if (>= ca0 4)(command "_layer" "_lo" "0" "")) 
 (setvar "cmdecho" 1)
 (princ)
)

[Edité le 26/2/2009 par usegomme]

Tramber · le 26 février 2009

Sans vouloir me méler de ce qui ne me regarde pas, vous ne connaissez pas XPLODE, commande native ?

BIGC-ROMU · le 26 février 2009

Bonjours à tous

Regarde si ça commence à ressembler à ce que tu souhaites.

Merci Usegomme de te pencher sur mon cas, je regarde ça dés que j'ai 5 min.

Sans vouloir me méler de ce qui ne me regarde pas, vous ne connaissez pas XPLODE, commande native ?

Désolé Tramber XPLODE, comme la commande BURST des express, ne récupère pas les propriétés de type de ligne et épaisseur de ligne. Et en plus il ne décompose pas les attributs en texte à l'inverse de BURST... Merci quand même.

Tramber · le 26 février 2009

Extrait de l'aide avec l'option adéquate :

Vous devez entrer le nom d'un type de ligne chargé dans le dessin. Si vous entrez ducalque , les objets composants héritent leur type de ligne du calque de l'objet décomposé. Si vous entrez dubloc , ils héritent du type de ligne de l'objet décomposé.

En fait, ce qui vous gêne c'est la répartition dans les calques d'origne.... qui n'est pas possible.

Bon, j'arrête.

[Edité le 26/2/2009 par Tramber]

BIGC-ROMU · le 26 février 2009

Regarde si ça commence à ressembler à ce que tu souhaites.

Ok c'est un bon début, les objets avec des proprités forcées (couleur, type de ligne, épaisseur) dans le bloc, les gardes bien aprés décomposition.

Mais les objets avec des propriétés en Dubloc, aprés décomposition, se mette en DuCalque pour la couleur et le type de ligne, et reste en Dubloc pour les épaisseur...alors qu'il faudrait qu'ils reprennent les propriétés "forcées" aprés l'insertion...

Je continus à tester...

A+

BIGC-ROMU · le 26 février 2009

En fait, ce qui vous gêne c'est la répartition dans les calques d'origne.... qui n'est pas possible.

Non, pas du tout. Je veut que tous mes objets soit sur le calque d'insertion du bloc, mais que ceux-ci garde leur propriétés qui ont été "forcées" dans le bloc mais aussi aprés insertion.

D'une manière simple, je veux que le bloc aprés décomposition ressemble exactement (couleur, type de ligne, épaisseur) au bloc avant décomposition et que tous les objets soit sur le calque d'insertion....

usegomme · le 26 février 2009

J'ai rajouté la partie change épaisseur au lisp post n°2 , j'espère que c'est correct parce que ça m' a gavé !

A+

BIGC-ROMU · le 27 février 2009

Salut,

La prise en compte des épaisseurs pour les objets en DuBloc marche nikel...

Bon courage pour la suite....je te remercie encore de ton savoir faire et de ta disponibilité...

A+

usegomme · le 27 février 2009

C'est avec plaisir, et ça fait avancer le schmi.. le shmilili..le schmilblick , et je vais pouvoir améliorer mon lexplode . Bon faire et défaire des blocs ça m'a pris un peu la tête mais j'ai vu comment fonctionner épaisseur de ligne que je n'utilise pas ,ce qui est peut être à reconsidérer.

Est-ce que c'est vraiment bien , pratique ?

Pour la suite il faudra attendre un peu , je ne sais pas si l'intégration de burst.lsp va être aisé.

A+

usegomme · le 3 mars 2009

J'ai regardé "burst" des express , il ne décompose que les blocs mais tous les blocs avec ou sans attribut et fait ce que fait lexplode au niveau des calques aussi ce dernier ne sert à rien,

et je suis d'avis d' adapter burst à ton besoin plutôt que de tenter de l'intégrer.

BIGC-ROMU · le 3 mars 2009

Salut,

je suis d'avis d' adapter burst à ton besoin plutôt que de tenter de l'intégrer.

Pourquoi pas... c'est toi le boss...

Pour info, j'utilise les épaisseurs de ligne car s'est une habitude que j'avais prise avec mon ancien logiciel (Powerdraw 6.0 sur MAC), et cela m'évite d'utiliser les fichiers .ctb que je trouve pénnible à gérer... peut être à reconsidérer...

usegomme · le 4 mars 2009

Salut , voilà BURST.LSP des express est modifié pour ton usage , ça semble fonctionner correctement.

si tu t' intêresses au lisp j'ai indiqué les modifs par ;***

JE SIGNALE EN PASSANT UNE ERREUR DANS BURST

Il faut remplacer "BYBLOCK" par "ByBlock" dans la ligne suivante

(If (= "BYBLOCK" (ITEM 6 ENT))

-------------------------

 ;;;
;;;    BIGBURST.LSP adaptation de BURST.LSP      04-03-09 modifié le 05-03-09
;;;    
(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
     )
     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)
     (Setq
        BENT   (EntGet BNAME)
        BLAYER (ITEM 8 BENT)
        BCOLOR (ITEM 62 BENT)
        BBLOCK (ITEM 2 BENT)
        BCOLOR (Cond
                  ((> BCOLOR 0) BCOLOR)
                 ;;;  ((= BCOLOR 0) "BYBLOCK")                  ;***
                  ((= BCOLOR 0) "BYLAYER")                      ;***
                  ("BYLAYER")
               )
       BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER")) 
     )
            ;*** rajout
     (if (setq bepl (item 370 bent)) 
      (if (= bepl -2)
          (setq bepl nil)
          (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-epl   (SsAdd)                ;*** rajout
        SS-LAYER (SsAdd)
        SS-COLOR (SsAdd)
        SS-LTYPE (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
                (if (= -2 (item 370 ent)) (ssadd ename ss-epl))   ;*** rajout
           
             ;; (If (= "0" (ITEM 8 ENT)) ;***
                 (SsAdd ENAME SS-LAYER)
             ;; )                        ;***
              (If (= 0 (ITEM 62 ENT))
                 (SsAdd ENAME SS-COLOR)
              )
              (If (= "ByBlock" (ITEM 6 ENT))  ;*** remplacé "BYBLOCK" par "ByBlock"
                 (SsAdd ENAME SS-LTYPE) 
              )
           )
        )
     )
     (If (> (SsLength SS-LAYER) 0)
        (Progn
           (bump "Fixing layers")
           (Command
              "_.chprop" SS-LAYER "" "_LA" BLAYER ""
           )
        )
     )
     (If (> (SsLength SS-COLOR) 0)
        (Progn
           (bump "Fixing colors")
           (Command
              "_.chprop" SS-COLOR "" "_C" BCOLOR ""
           )
        )
     )
     (If (> (SsLength SS-LTYPE) 0)
        (Progn
           (bump "Fixing linetypes")
           (Command
              "_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
           )
        )
     )
         ;***  rajouté
     (If (> (SsLength SS-EPL) 0)                                
        (Progn                                                        
           (bump "Fixing Epaisseur_ligne")                            
           (Command "_.chprop" SS-EPL "" )                            
           (if bepl (command "ep" bepl) (command "ep" "BYLAYER"))   ; pas trouvé "ep" en anglais "_.."  ?   
           (command "")                                                 
        )                                                            
     )                                                          
        ;*** fin rajout
  )

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

  (Defun BIGBURST (/ SS1)                   ;***
     (setq PSFLAG (if (= 1 (caar (vports)))
                      1 0
                  )
     )
     (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
     (If SS1
        (Progn
           (Setvar "highlight" 0)
           (terpri)
           (Repeat
              (SsLength SS1)
              (Setq ENAME (SsName SS1 0))
              (SsDel ENAME SS1)
              (BIGBURST-ONE ENAME)          ;*** 
           )
           (princ "\n")
        )
     )
  )

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

  (BIGBURST)                           ;***

 (acet-error-restore)

);end defun

(princ)

[Edité le 5/3/2009 par usegomme]

BIGC-ROMU · le 5 mars 2009

Salut,

J'ai un problème quand je lance Bigburst.lsp

Voici le détail de ma fenêtre de ligne de commande

Commande: bigburst
Choix des objets: 1 trouvé(s)
Choix des objets:
-
no function definition: _MATTS_UTIL
Commande:

usegomme · le 5 mars 2009

Bonjour , envoie -moi le burst de la 2007 pour que je regarde ce qui change par rapport à 2008.

usegomme chez hotmail.fr

A+

usegomme · le 5 mars 2009

Tout compte fait , on n'a pas besoin de ce _MATTS_UTIL , aussi je l'ai désactivé dans le lisp.

je le met à jour dans le post au dessus.

BIGC-ROMU · le 5 mars 2009

Ok ça marche, enfin presque...

Je te passe un dwg avec un bloc type inséré 2 fois. La 1er insertion, j'ai forcé la couleur, type de ligne et épaisseur, et la seconde, je l'ai laissé en DuCalque.

Le but du jeu, c'est qu'aprés décomposition, les objets des blocs soit tous sur le calque d'insertion et qu'ils aient le même aspect visuel (couleur, type de ligne, épaisseur de ligne) d'avant la décomposition des blocs ...

le fichier est ici : http:// http://cjoint.com/?dhnTAIZ2to

Tiens moi au courrant...

usegomme · le 10 mars 2009

Salut , il y a du progrés .

voici le dernier jus.

 ;;;    BIGBURST.LSP adaptation de burst.lsp  12-03-09  ind C
;;;    
(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
     )
     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)
     (Setq
        BENT   (EntGet BNAME)
        BLAYER (ITEM 8 BENT)
        BCOLOR (ITEM 62 BENT)
        BBLOCK (ITEM 2 BENT)
        BCOLOR (Cond
                  ((> BCOLOR 0) BCOLOR)
                 ;;;  ((= BCOLOR 0) "BYBLOCK")   ;;; 0 = byblock ;***
                  ((= 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
             ;; (If (= "0" (ITEM 8 ENT)) ;***
                 (SsAdd ENAME SS-LAYER)   ; toutes les entités seront changées de calque
             ;; )
             ; propriétés du calque de l'entité avant changement    ;; ajout ***
           (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"))
           )
               
                   
              (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 "")
               )
                
              
           )
        )
     )
     (If (> (SsLength SS-LAYER) 0)
        (Progn
           (bump "Fixing layers")
           (Command
              "_.chprop" SS-LAYER "" "_LA" BLAYER ""
           )
        )
     )
                
  )

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

  (Defun BIGBURST (/ SS1)                   ;***
     (setq PSFLAG (if (= 1 (caar (vports)))
                      1 0
                  )
     )
     (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
     (If SS1
        (Progn
           (Setvar "highlight" 0)
           (terpri)
           (Repeat
              (SsLength SS1)
              (Setq ENAME (SsName SS1 0))
              (SsDel ENAME SS1)
              (BIGBURST-ONE ENAME)          ;*** 
           )
           (princ "\n")
        )
     )
  )

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

  (BIGBURST)                           ;***

 (acet-error-restore)

);end defun

(princ)

[Edité le 10/3/2009 par usegomme]

[Edité le 12/3/2009 par usegomme]

usegomme · le 10 mars 2009

Ah! je viens de trouver mon bug , je corrige au-dessus, et j'espère qu'il n'y en a pas d'autre.

BIGC-ROMU · le 10 mars 2009

Salut, et un grand bravo...

Tu touche presque au but.

Et en plus ça marche même sur les blocs dynamique avec ou sans attributs...

A quand ton post "Les Lisps de usegomme" ?

Je t'encourage encore, pour la suite, et merci...

A+

usegomme · le 10 mars 2009

Merci pour les encouragements.

Tu touche presque au but

Essaye de faire un peu plus précis comme critique , car je ne suis pas un rapide en lisp et mon temps libre est limité , alors il vaut mieux que j'évite de me perdre en conjonctures.

a+

BIGC-ROMU · le 11 mars 2009

Salut,

Essaye de faire un peu plus précis comme critique

Les objets, avec une épaisseur DuBloc, dans un blocs, insérés avec une épaisseur DuCalque, restent en épaisseur DuBloc aprés décomposition alors qu'ils devraient avoir une épaisseur DuCalque.

Ce n'est pas trés important, mais bon...

D'ailleur je ne saisi pas trés bien, en espace papier ou objet, la propriété DuBloc pour des objets à l'extérieure d'un bloc. Il semblerait que pour ces objets, DuBloc = DuCalque . Est que j'ai raison , ou y a t'il une différence que je n'ai pas encore trouvé?[Edité le 11/3/2009 par BIGC-ROMU]

[Edité le 11/3/2009 par BIGC-ROMU]

lecrabe · le 11 mars 2009

Hello

Je viens de jouer un peu avec BIGBURST, une micro remarque :

- Cette routine exige un AutoCAD / MAP version 2006 minimum

Merci à USEGOMME,Le Decapode

usegomme · le 12 mars 2009

Bonjour, j'ai réparé , je pense, le problème d'épaisseur , mais je viens de trouver une faille dans l'attribution des couleurs que je rafistolerai dqp.

a+

Modification Lisp lexplode de USEGOMME

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante