Looking for a Lisp routine

[designerstuart]

hi all

did anyone alter this code to allow selection of specific blocks?

ps. i am partly answering as when i click 'page2' i get a 404 forbidden error

[MSasu]

ps. i am partly answering as when i click 'page2' i get a 404 forbidden error

The issue is from the title of this thread, more precisely the "..." parts; this cause conflicts (at least) with IE browser. To fix it just go to address bar and remove the title part and press :

http://www.cadtutor.net/forum/showthread.php?13295-Looking-for-a-Lisp-routine..../page2

 

Hope that a moderator will fix this.

[SLW210]

Should be fixed now.

 

You can always set to display more threads per page in your settings.

[designerstuart]

You can always set to display more threads per page in your settings.

ooooh will do

thanks.

[designerstuart]

still looking for the lisp that changes specific blocks' entities to layer0 though!

[tzframpton]

still looking for the lisp that changes specific blocks' entities to layer0 though!

Since this thread, Autodesk incorporated the SETBYLAYER command which was not available when I was looking for this original LISP routine. Try this instead, it works really well.

 

More info: http://exchange.autodesk.com/autocad/enu/online-help/search#WS1a9193826455f5ffa23ce210c875431154102.htm

[irneb]

still looking for the lisp that changes specific blocks' entities to layer0 though!

Like this?

(defun c:BlkToLay0 (/ ss n eo bLst bCol)
 (vl-load-com)
 (if (setq ss (ssget '((0 . "INSERT"))))
   (progn (repeat (setq n (sslength ss))
            (setq eo (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
            (if (not (vl-position (vla-get-EffectiveName eo) bLst))
              (setq bLst (cons (vla-get-EffectiveName eo) bLst))))
     (setq bCol (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
     (foreach bName bLst
       (setq eo (vla-Item bCol bName))
       (vlax-for obj eo (vl-catch-all-apply 'vla-put-Layer (list obj "0"))))))
 (princ))

[designerstuart]

styk - that's great for setting objects 'by layer', but doesn't go the whole hog and put them on layer0.

irneb - i'm maybe doing sth wrong, but your code did nothing for me!

 

thanks all

[designerstuart]

i'm looking to alter a bit of the former script's code so the default is my prefered choice:

 

(initget "byLayer byBlock")
     (setq atype (getkword "\nSet block contents to [byLayer/byBlock] <[color=red]byBlock[/color]>:"))
     (initget "Yes No")
     (setq ans0 (getkword "\nChange entity layers to layer0? [Yes/No] <[color=red]No[/color]>:"))

 

i want and instead. obviously i can change the words, but can someone pls tell me what bit of the code i need to alter to make it work? thanks chaps

[Lee Mac]

Here is an old function of mine which may help:

 

http://lee-mac.com/applytoblockobjects.html

[designerstuart]

okay thanks lee. should have known to look on your site first!

i don't understand the first bit - but have taken the test bit, which ofc works brill like.

ta

 

still interested to learn about how to alter the code above if it's easy!

[Lee Mac]

okay thanks lee. should have known to look on your site first!

i don't understand the first bit - but have taken the test bit, which ofc works brill like.

ta

 

still interested to learn about how to alter the code above if it's easy!

 

You're welcome designerstuart.

 

Note that you needn't modify the LM:ApplytoBlockObjects function, since this is simply a wrapper function that allows you to operate on the subentities within a block definition.

 

The example program calls this function with the block collection, the block name and a function to be applied to every object within the block definition. In the example, this function merely changes the layer of every object to layer "0".

[irneb]

irneb - i'm maybe doing sth wrong, but your code did nothing for me!

Could you provide a sample DWG where my code does not change the entities inside the block to layer 0? If I run it it works perfectly for me. Note, that's all it does - it leaves colour / linetype / etc. as is (though these could be added as well).

 

Or did I read your post wrong? Did you mean you want to set only certain objects inside the block to Layer 0?

 

The principle behind my code is much the same as Lee's code (aslo VVA's in post #6), though mine simply finds all blocknames from the selection then loops through each name. Lee's is a bit more of a "functional" approach, whereas VVA's & mine is more of an "imperative" approach.

[Lee Mac]

I see nothing wrong with your code Irne - perhaps designerstuart didn't do a regen to update the references.

[irneb]

I see nothing wrong with your code Irne - perhaps designerstuart didn't do a regen to update the references.

That's why I've asked for a sample DWG. I'd like to know where my code won't work, if such exists I'd like to learn about it.

 

You might be correct about the regen - it seems to be the most plausible reason. Thanks for checking though

[dober]

Hello

 

How would that go if everything is on layer 0 only the hatching remain as it is.

Thank you

 

Hallo

 

Wie würde das gehn wenn alles auf Layer 0 nur die Schraffur soll bleiben wie sie ist.

Danke

[Lee Mac]

Hi dober,

 

To exclude Hatch Objects from the layer change, use the following program with my LM:ApplytoBlockObjects function:

 

(defun c:test ( / s )
   (if (setq s (LM:ssget "\nSelect Block: " '("_+.:E:S" ((0 . "INSERT")))))
       (LM:ApplytoBlockObjects
           (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
           (cdr (assoc 2 (entget (ssname s 0))))
          '(lambda ( obj )
               (if (not (eq "AcDbHatch" (vla-get-objectname obj)))
                   (vla-put-layer obj "0")
               )
           )
       )
   )
   (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg    - selection prompt
;; params - list of ssget arguments

(defun LM:ssget ( msg params / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget params))
   (setvar 'nomutt 0)
   (if (and sel (not (vl-catch-all-error-p sel)))
       sel
   )
)

 

Remember to Regen to see the changes.

[dober]

Thank you Lee has been running

Danke Lee läuft schon

Edited July 18, 2012 by dober