Author Topic: Blocks modify: attrib to text, change layer, color, linetype (exploded or not)  (Read 2846 times)

0 Members and 1 Guest are viewing this topic.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1453
  • Marco


I use this old function to explode all blocks with attributes, transform visible attributes into text, and modify  layer, color, linetype of resulting entities.
I would need to speed up this process that needs to be executed on hundreds of blocks and it is very slow and I would need some advice on the path I must follow.


Question1: before exploding the block it is better to change its definition for change the layer, color, and line type of entities that it is composed so that already get the correct entities after the explosion of each INSERT of that block definition?

Question2: A) is it possible to have a second function that does the same while maintaining the block definition?
                B) to do this is better to explode and rebuild or modify the block definition?


Code: [Select]
(defun Ale_CleanAtt ( / SelSet TxtDat EntDat EntNam BlkDat SSIndx BlkENm Dxf__1 BlkLyr)
  (if (setq SelSet (ssget "_X" '((0 . "INSERT") (66 . 1)(67 . 0))));con attributi spazio modello
    (progn
      (setq SSIndx 0)
      (repeat (sslength SelSet)
        (setq
          BlkENm (ssname SelSet SSIndx)   SSIndx (1+ SSIndx)      BlkDat (entget BlkENm)  BlkLyr (DXF 8 BlkDat)
          EntNam (entnext BlkENm)         EntDat (entget EntNam)
        )
        (while (= (DXF 0 EntDat) "ATTRIB")
          (if
            (and
              (/= 1 (logand 1 (DXF 70 EntDat)))                   ;; ignora attributi invisibili
              (not (wcmatch (setq Dxf__1 (DXF 1 EntDat)) " ,,"))  ;; ignora testi nulli
            )
            (progn
              (setq
                TxtDat
                (list
                  (assoc  1 EntDat)  ;valore testo
                  (assoc  8 EntDat)  ;layer
                  (assoc 10 EntDat)  ;punto di insert
                  (assoc 40 EntDat)  ;altezza testo
                  (assoc 50 EntDat)  ;rotazione
                  (assoc 41 EntDat)  ;fattore di larghezza
                  (assoc 51 EntDat)  ;angolo inclinazione
                  (assoc  7 EntDat)  ;nome stile di testo
                  (assoc 71 EntDat)  ;flags generazione
                )
              )
              (if (assoc  6 EntDat) (setq TxtDat (cons (assoc  6 EntDat) TxtDat)));tipolinea
              (if (assoc 62 EntDat) (setq TxtDat (cons (assoc 62 EntDat) TxtDat)));colore
              (if (assoc 11 EntDat) (setq TxtDat (cons (assoc 11 EntDat) TxtDat)));punto di all.
              (if (assoc 72 EntDat) (setq TxtDat (cons (assoc 72 EntDat) TxtDat)));all. orr.
              (if (assoc 74 EntDat) (setq TxtDat (cons (cons 73 (DXF 74 EntDat)) TxtDat)));al.ver.
              (setq TxtDat (cons '(0 . "TEXT") TxtDat))
              (if (not (entmake TxtDat)) (alert "Text ENTMAKE Error."))
            )
          )
          (setq EntNam (entnext EntNam)  EntDat (entget EntNam))
        )
        (command "_.EXPLODE" BlkENm "")
      )
    )
  )
)
(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
  (vl-catch-all-apply
   '(lambda ( )
      (setq VlaObj (vla-item VlaCol KeyNam))
    )
  )
  VlaObj
)
(defun C:Ale_CleanChange ( / SelSet)
  (setq
        *AcadApp* (vlax-get-Acad-Object)
        *AcAcDwg* (vla-get-ActiveDocument *AcadApp*)
        *AcLayrs* (vla-get-Layers         *AcAcDwg*)
  )
  (or (ALE_Utl_GetItem *AcLayrs* "HD") (vla-add *AcLayrs* "HD")); this is only a sample
  (or (ALE_Utl_GetItem *AcLayrs* "CE") (vla-add *AcLayrs* "CE")); I have many
  (or (ALE_Utl_GetItem *AcLayrs* "TH") (vla-add *AcLayrs* "TH")); Layers to change
  (repeat 3 ; for nested blocks
    (Ale_CleanAtt)
  )
  (and (setq SelSet (ssget "_X" '((0 . "ATTDEF")   (67 . 0)))) (command "_.ERASE" SelSet ""))
  (and (setq SelSet (ssget "_X" '((62 . 0)         (67 . 0)))) (command "_.CHPROP" SelSet "" "_COLOR" "_BYLAYER" ""))
  (and (setq SelSet (ssget "_X" '((6 . "BYBLOCK" ) (67 . 0)))) (command "_.CHPROP" SelSet "" "_LTYPE" "_BYLAYER" ""))
  (and (setq SelSet (ssget "_X" '((8 . "*HIDDEN*") (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "HD" ""))
  (and (setq SelSet (ssget "_X" '((8 . "*CENTER*") (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "CE" ""))
  (and (setq SelSet (ssget "_X" '((8 . "*THIN*"  ) (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "TH" ""))
)

Grrr1337

  • Swamp Rat
  • Posts: 812
Unable to answer to your questions yet, just a quick glance:

Maybe if you get rid of the command calls, it will affect the overall speed - like instead of:
Code: [Select]
(and (setq SelSet (ssget "_X" '((0 . "ATTDEF")   (67 . 0)))) (command "_.ERASE" SelSet ""))
(and (setq SelSet (ssget "_X" '((62 . 0)         (67 . 0)))) (command "_.CHPROP" SelSet "" "_COLOR" "_BYLAYER" ""))
(and (setq SelSet (ssget "_X" '((6 . "BYBLOCK" ) (67 . 0)))) (command "_.CHPROP" SelSet "" "_LTYPE" "_BYLAYER" ""))
(and (setq SelSet (ssget "_X" '((8 . "*HIDDEN*") (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "HD" ""))
(and (setq SelSet (ssget "_X" '((8 . "*CENTER*") (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "CE" ""))
(and (setq SelSet (ssget "_X" '((8 . "*THIN*"  ) (67 . 0)))) (command "_.CHPROP" SelSet "" "_LAYER" "TH" ""))

Try something like (UNTESTED) :
Code: [Select]
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(foreach x
  '( ; assoc list: [CAR] = ssget filter list | [CADR] = custom test | [CADDR] = function to map
    ( ((0 . "ATTDEF")   (67 . 0)) T                        vla-Delete )
    ( ((62 . 0)         (67 . 0)) T                        (lambda (x) (vla-put-Color x 256)) ) ; 256 = ByLayer
    ( ((6 . "BYBLOCK" ) (67 . 0)) T                        (lambda (x) (vla-put-LineType x "ByLayer")) )
    ( ((8 . "*HIDDEN*") (67 . 0)) (tblsearch "LAYER" "HD") (lambda (x) (vla-put-Layer x "HD")) )
    ( ((8 . "*CENTER*") (67 . 0)) (tblsearch "LAYER" "CE") (lambda (x) (vla-put-Layer x "CE")) )
    ( ((8 . "*THIN*"  ) (67 . 0)) (tblsearch "LAYER" "TH") (lambda (x) (vla-put-Layer x "TH")) )
  ); list
  (and
    (ssget "_X" (car x))
    (eval (cadr x))
    (setq f (caddr x))
    (progn (vlax-for o (setq SS (vla-get-ActiveSelectionSet acDoc)) (f o)) (vla-Delete SS))
  ); and
); foreach

My 2c.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1453
  • Marco

Unable to answer to your questions yet, just a quick glance:
Try something like (UNTESTED) :
...
My 2c.
Thanks Grrr1337, interesting solution.
I'm trying to see if changing the block definition is faster, this is a small example:
[/size][/size][/color]
Code: [Select]
(defun C:Test1 ( / BlkNam LyrObj)
  (or
    (setq LyrObj (ALE_Utl_GetItem *AcLayrs* "TH"))
    (progn
      (setq LyrObj (vla-add *AcLayrs* "TH"))
      (vla-Put-Color LyrObj 100)
    )
  )
  (vlax-for BlkFor (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (or
      (= "*MODEL_SPACE" (setq BlkNam (strcase (vla-get-name BlkFor))))
      (wcmatch BlkNam "*PAPER_SPACE*")
      (vlax-for ObjFor BlkFor
        (if (wcmatch (strcase (vla-get-Layer ObjFor)) (strcase "Test1"))
          (progn
            (vla-Put-Layer     ObjFor "TH")
            (vla-Put-Color     ObjFor acByLayer)
            (vla-Put-Linetype  ObjFor "BYLAYER")
          )
        )
      )
    )
  )
)


roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
If in anyway feasible I would always keep the block references intact. This would have priority over any speed considerations.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1453
  • Marco

If in anyway feasible I would always keep the block references intact. This would have priority over any speed considerations.
What do you mean I do not understand? Does it mean that it is better to explode, changing objects and rebuilding the block? (explode> change prop> block> insert)
I have two scenarios:
Code: [Select]
Foo.dwg (original dwg)
a) export FooA.dwg > all block     exploded, all visible attribs to text - others attribs deleted, modify  layer, color, linetype of resulting entities
b) export FooB.dwg > all block NOT exploded, all visible attribs to text - others attribs deleted, modify  layer, color, linetype of entities in blocks



roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
If the data in the drawing is organised in blocks with linked attributes then that structure should not be destroyed. So: do NOT explode inserts and do NOT change attributes to loose texts.

Grrr1337

  • Swamp Rat
  • Posts: 812
@Roy,
I think that the reason behind all exploding and purging block definiton is preventing someone else using them somewhere else / copyright if you will.

How about:
1. Copy the block definitions.
2. Modify the block definitions as required (but do not touch the attribute definitions).
3. For every block reference that will be modified - substitute its groupcode 2 / or change its 'Name property to the newly created block definition.
Use ATTSYNC in the end.

However I'm not sure if this trick will work to pass different attribute definitions for these block references.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
@Roy,
I think that the reason behind all exploding and purging block definiton is preventing someone else using them somewhere else / copyright if you will.
That does not seem to be the scenario. Why would you then use _ChProp? Maybe the OP can clarify?

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1453
  • Marco

@Roy,
I think that the reason behind all exploding and purging block definiton is preventing someone else using them somewhere else / copyright if you will.
That does not seem to be the scenario. Why would you then use _ChProp? Maybe the OP can clarify?
I have two scenarios:

Foo.dwg (original dwg)
a) I NEED to export a FooA.dwg > all block     EXPLODED, ALL VISIBLE ATTRIBS TO TEXT - others attribs deleted, modify  layer, color, linetype of resulting entities
b) I NEED to export a FooB.dwg > all block NOT exploded, ALL VISIBLE ATTRIBS TO TEXT - others attribs deleted, modify  layer, color, linetype of entities in blocks


FooA.dwg and FooB.dwg MUST NOT HAVE Blocks with attributes see my
Ale_CleanAtt in my fist post.