Need help with ssget function for LISP routine

[Anonymous]

Hi everyone,

I found this LISP routine by Peter Jamtgaard on an AUGI. It will take the entities in a block and change them to by "By Block". I find it very useful, but I can only use the command on one block at a time. I want to be able to use the commend on a selection set of blocks to speed things up. From what I have read, I need to change the 'entsel' function to ssget. I have tried a few times, but I dont know very much about writing LISPs and I have definitely doing something wrong with the syntax. Below is original LISP code 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) ; set color byblock
;    (vla-put-linetype EOBJ "ByBlock") if all you want is color byblock
;    (vla-put-Lineweight EOBJ -1) if all you want is color byblock
;    (vla-put-PlotStyleName EOBJ "ByBlock") if all you want is color byblock
   )
  )
 )
 (prin1)
)
(prin1)

[marko_ribar]

Here is quick mod... Untested, though...

(defun c:processblocks ( / *error* BlkByBlock ss i )

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (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) ; set color byblock
  ;    (vla-put-linetype EOBJ "ByBlock") if all you want is color byblock
  ;    (vla-put-Lineweight EOBJ -1) if all you want is color byblock
  ;    (vla-put-PlotStyleName EOBJ "ByBlock") if all you want is color byblock
     )
    )
   )
   (prin1)
  )

  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark *adoc*)
  )
  (vla-startundomark *adoc*)
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (BlkByBlock (ssname ss (setq i (1- i))))
      (entupd (ssname ss i))
    )
  )
  (vla-regen *adoc* acactiveviewport)
  (*error* nil)
)

[Anonymous]

Doesn't seem to be working. When I try to use PROCESSBLOCKS, i get the following error:

bad argument type: VLA-OBJECT nil

[marko_ribar · Accepted solution]

Try it this time, once again... Note that there are no checks for xrefs and dynamic blocks which you may wanted to be excluded from processing... But I suppose you distinguish those and may create correct selection...

(defun c:processblocks ( / *error* BlkByBlock *adoc* ss i )

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun BlkByBlock ( objSelection )
    (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 *adoc*)
                             (vla-get-name objSelection)
                           )

        (vla-put-color objBlock 0) ; set color byblock
   ;    (vla-put-linetype EOBJ "ByBlock") if all you want is color byblock
   ;    (vla-put-Lineweight EOBJ -1) if all you want is color byblock
   ;    (vla-put-PlotStyleName EOBJ "ByBlock") if all you want is color byblock
        )
      )
    )
    (prin1)
  )

  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark *adoc*)
  )
  (vla-startundomark *adoc*)
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (BlkByBlock (ssname ss (setq i (1- i))))
      (entupd (ssname ss i))
    )
  )
  (vla-regen *adoc* acactiveviewport)
  (*error* nil)
)

[cadffm · Accepted solution]

..because Marko forgot one thing from the old code in hurry,

but this code is so ugly. As "better then nothing' or as example for the main program part still okay,

you can edit Marko quick shot

from

(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
       (BlkByBlock (ssname ss (setq i (1- i))))
       (entupd (ssname ss i))
   )
)

to

(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
     (progn
         (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
         (repeat (setq i (sslength ss))
             (BlkByBlock (ssname ss (setq i (1- i))))
             (entupd (ssname ss i))
         )
    )
)

If you selected 99 inserts of block "test" it will edit 99times the same block(test),

and if the Layer is locked.. "crash"

cu

[Anonymous]

Great, that worked!

I have another question now:

If I want this LISP to also modify the Lineweight and Linetype entities to also be "By Block", how would I do that? I see there are a couple of lines that are commented out, I deleted the comment ; to see if that would work but it didn't change anything. Do you know how to modify that? I'm not the best at reading LISP code...

[cadffm]

EDITED all - i read to fast your post, sorry.

If you know that a semicolon marks the rest of the line in Lisp as a comment,
then the answer is: Please read the code !

If not: A semicolon declares everything in the line below as a comment,
read your code once and then you'll see what to do.

Open and edit codes in the VisualLispIDE and you will see comments in other colors, command VLIDE

  ;    (vla-put-linetype EOBJ "ByBlock") if all you want is color byblock
   ;    (vla-put-Lineweight EOBJ -1) if all you want is color byblock

(vla-put-linetype objBlock "ByBlock") ; linetype
(vla-put-Lineweight objBlock -1) ; lineweight

The wrong(old) variable name was the first problem.

[marko_ribar]

My latest revision :

(defun c:processblocks ( / *error* BlkByBlock *adoc* ss i lst )

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun BlkByBlock ( objSelection / blkcoll )
    (if (= (type objSelection) 'ENAME)
      (setq objSelection (vlax-ename->vla-object objSelection))
    )
    (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
      (if (and
            (setq blkcoll (vla-item (vla-get-blocks *adoc*) (vla-get-name objSelection)))
            ;;;(= (vla-get-isdynamicblock blkcoll) :vlax-false) ;;; - if you need to process dynamic blocks as well - if you don't remove comments
            (= (vla-get-isxref blkcoll) :vlax-false)
            (not (vl-position (vla-get-name objSelection) lst))
          )
        (progn
          (setq lst (cons (vla-get-name objSelection) lst))
          (vlax-for objBlock blkcoll
            (vla-put-color objBlock 0)
            (vla-put-linetype objBlock "ByBlock")
            (vla-put-Lineweight objBlock -1)
            ;;;(vla-put-PlotStyleName objBlock "ByBlock") ;;; - if PlotStyle "ByBlock" don't exist - if exist remove comments
          )
        )
      )
    )
  )

  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark *adoc*)
  )
  (vla-startundomark *adoc*)
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (BlkByBlock (ssname ss (setq i (1- i))))
      (entupd (ssname ss i))
    )
  )
  (vla-regen *adoc* acactiveviewport)
  (*error* nil)
)