setbyblock slow routine

[jim78b]

I have several drawings with many blocks and every time I start setbyblock.lsp it is very slow, isn't there a way to speed up the listing? a thousand thanks

 

(defun c:setbyblock ( / _byblock e n x a sel c)

    (defun _byblock ( n l / a e x )
        (if (and (setq e (tblobjname "BLOCK" n)) (not (member n l)))
            (while (setq e (entnext e))
                (setq x (entget e))
                (if (setq a (assoc 420 x))
                    (setq x (vl-remove (assoc 420 x) x))
                )
                (if (setq a (assoc 62 x))
                    (entmod (subst '(62 . 0) a x))
                    (entmod (append x '((62 . 0))))
                )
                (if (= "INSERT" (cdr (assoc 0 x)))
                    (_byblock (cdr (assoc 2 x)) (cons n l))
                )
            )
        )
        nil
    )

    (prompt "\nSelect Blocks: ")
    (setq sel (ssget (list (cons 0 "INSERT"))))
    (setq c 0)
    (repeat (sslength sel)
        (setq n (ssname sel c))       
        (_byblock (cdr (assoc 2 (entget n))) nil)
        (setq c (1+ c))
    )
    
    (command "_.regen")
    (princ)
    
)

 

[tombu]

Try this one by Peter Jamtgaard

; Written By: Peter Jamtgaard 12/20/2006
;^P(or C:BlkByBlock (load "BlkByBlock.lsp"));BlkByBlock
(defun C:BlkByBlock (/ colBlockReference
                    ActDoc dprSelection
                    objSelection strBlockName
                 )
 (if (setq dprSelection (entsel "\nSelect Block: "))
  (progn
   (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
         dprSelection (car dprSelection)
         objSelection (vlax-ename->vla-object dprSelection)
   )
   (vla-StartUndoMark ActDoc)
   (BlkByBlock objSelection)
   (entupd dprSelection)
   (vla-EndUndoMark ActDoc)
  )
 )
 (prin1)
)

(defun BlkByBlock (objSelection / colBlockReference objBlock
                    strBlockName
                 )
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection)))
 (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
  (progn
   (vlax-for objBlock (vla-item
                       (vla-get-blocks ActDoc)
                       (vla-get-name objSelection)
                      )

    (vla-put-Color objBlock 0)
    (vla-put-Layer objBlock "0")
    (vla-put-linetype objBlock "ByBlock")
    (vla-put-Lineweight objBlock -1)
    (if(=(getvar 'PStyleMode)0)(vla-put-PlotStyleName objBlock "ByBlock"))
   )
  )
 )
 (prin1)
)
(prin1)

 

Edited September 14, 2022 by tombu

[jim78b]

Wow ...is more quick ?even for nested blocks ?

[jim78b]

I need only color =byblock

[Steven P]

7 minutes ago, jim78b said:

I need only color =byblock

 

 

I reckon you can change it,  this line here changes the color.

 

(vla-put-Color objBlock 0)

 

Perhaps if you put a ; at the start of the lines that change for example layer and linetype, that might do what you want? You'd have to work out what to do from there though. The ; stops that line being implemented in the LISP

 

 

 

[jim78b]

I don't know lisp ...only nerd color byblock and other bylayer or  can remove lines...

[tombu]

1 hour ago, jim78b said:

I don't know lisp ...only nerd color byblock and other bylayer or  can remove lines...

Try

; Written By: Peter Jamtgaard 12/20/2006
;^P(or C:BlkByBlock (load "BlkByBlock.lsp"));BlkByBlock
(defun C:BlkByBlock (/ colBlockReference
                    ActDoc dprSelection
                    objSelection strBlockName
                 )
 (if (setq dprSelection (entsel "\nSelect Block: "))
  (progn
   (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
         dprSelection (car dprSelection)
         objSelection (vlax-ename->vla-object dprSelection)
   )
   (vla-StartUndoMark ActDoc)
   (BlkByBlock objSelection)
   (entupd dprSelection)
   (vla-EndUndoMark ActDoc)
  )
 )
 (prin1)
)

(defun BlkByBlock (objSelection / colBlockReference objBlock
                    strBlockName
                 )
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection)))
 (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
  (progn
   (vlax-for objBlock (vla-item
                       (vla-get-blocks ActDoc)
                       (vla-get-name objSelection)
                      )

    (vla-put-Color objBlock 0)
;    (vla-put-Layer objBlock "0")
;    (vla-put-linetype objBlock "ByBlock")
;    (vla-put-Lineweight objBlock -1)
;    (if(=(getvar 'PStyleMode)0)(vla-put-PlotStyleName objBlock "ByBlock"))
   )
  )
 )
 (prin1)
)
(prin1)
 

 

Edited September 14, 2022 by tombu
removed errant line

[Steven P]

34 minutes ago, jim78b said:

I don't know lisp ...only nerd color byblock and other bylayer or  can remove lines...

 

 

But you can learn and are more likely to get better help if you show that you want to learn rather than asking for a complete solution every time, 

[jim78b]

40 minutes ago, tombu said:

Try

; Written By: Peter Jamtgaard 12/20/2006
;^P(or C:BlkByBlock (load "BlkByBlock.lsp"));BlkByBlock
(defun C:BlkByBlock (/ colBlockReference
                    ActDoc dprSelection
                    objSelection strBlockName
                 )
 (if (setq dprSelection (entsel "\nSelect Block: "))
  (progn
   (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
         dprSelection (car dprSelection)
         objSelection (vlax-ename->vla-object dprSelection)
   )
   (vla-StartUndoMark ActDoc)
   (BlkByBlock objSelection)
   (entupd dprSelection)
   (vla-EndUndoMark ActDoc)
  )
 )
 (prin1)
)

(defun BlkByBlock (objSelection / colBlockReference objBlock
                    strBlockName
                 )
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection)))
 (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
  (progn
   (vlax-for objBlock (vla-item
                       (vla-get-blocks ActDoc)
                       (vla-get-name objSelection)
                      )

    (vla-put-Color objBlock 0)
;    (vla-put-Layer objBlock "0")
;    (vla-put-linetype objBlock "ByBlock")
;    (vla-put-Lineweight objBlock -1)
;    (if(vla-get-Lineweight objBlock -1)
;    (if(=(getvar 'PStyleMode)0)(vla-put-PlotStyleName objBlock "ByBlock"))
   )
  )
 )
 (prin1)
)
(prin1)
 

 

this lisp not go well , because don't select all blocks only one at a time

[mhupp]

Should stream line the code.

;;----------------------------------------------------------------------;;
;; SET ALL ENTITYS COLOR TO BYBLOCK
(defun C:ALL-BlkByBlock (/ colBlockReference ActDoc dprSelection objSelection strBlockName)
  (setq Drawing (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (vla-StartUndoMark Drawing)
  (if (setq sel (ssget "_X" '((0 . "INSERT") (410 . "Model"))))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq obj (vlax-ename->vla-object ent))
      (vlax-for objBlock (vla-item (vla-get-blocks Drawing) (vla-get-name obj))
        (vla-put-Color objBlock 0)
      )
    )
  )
  (vla-Regen Drawing acAllViewports)
  (vla-EndUndoMark Drawing)
  (princ)
)

Edited September 15, 2022 by mhupp
updated code

[jim78b]

ok resolve thanks very much!!!