Jump to content

turn macro script to a lisp for insert block from another drawing

Recommended Posts


^C^C_insert;"Template";^C-insert;"*Block 1";0,0;;;

What this does is to insert 'Block 1' from the Template.dwg into 0,0,0 in current drawing & explode it. I have the folder location in my search path.


Please help to convert this macro script into a lisp. And if possible to allow for more then 1 block choice. Meaning Pressing B1 inserts "Block 1".....press B2 inserts "Block B2"......and so on


Thanks in advance

Edited by tive29

Share this post

Link to post
Share on other sites

Similar to this post http://www.cadtutor.net/forum/showthread.php?100855-LISP-IF-Conditions-Copy-to-Existing-Layer


You could just type B1 or b22 B345 etc and correct block would be inserted, its a case of reworking the reactor that looks for the prefix character in this case B or b.


You can take advantage of Lee-Mac's Steal.lisp


(load "stealV1-6.lsp")
(Steal "P:\\Autodesk\\c3d Templates\\XXXXG.dwt" (list (list "Blocks" "*")))

Share this post

Link to post
Share on other sites

BIGAL, that looks advanced.

If it is easier, I can settle for a simple lisp command that does exactly as my macro script in the first post.

I can then create multiple lisp for different blocks.

Edited by tive29

Share this post

Link to post
Share on other sites

Like the other post its a case of typing a shorthand at the keyboard and then matching it with a block name so you would have b1= block name 1 and so on in a text file. Thinking a bit more it would be easier to wblock out all the blocks to a directory rather than in a nominated dwg. This code exists. I use the reactor every day and it has 5 different functions the method is in the 1st character which in your case would be a B or b as the first character. As an example the fillet function enter any radius you like so long as you put a "F" at the start f123 there is no macro/lisp for F123 the error works it out and sets the fillet radius. Try as is note the decimal is "-" f1-25 as the "." is read as part of the command and not a decimal but you get used to it.


The way it would work for you is that Autocad reports an error say type b56 which is an "Invalid command", the code looks at the b and gets the 56 so it knows you want to insert block "56" which is "stop valve type 56" it will rely on a two item file, shortcut and full name.


I have some time this weekend so will rewrite as a global style function that allows the user to customise but reads a text file for the correct answer.


One of the nice things in lee-macs steal is you can do * for block name and just pull in all the blocks from a dwg. Insert all and purge out what you dont want. I have used it customised to pull in a list of blocks saving heaps of time.


Lastly in simple terms I think you could have 26x2 + 10 of variations. Aa - Zz 0-9


Thinking B27 oh wrong block just type b26 thats the one. How fast was that.


Oh yeah it can even look in different directory areas blocks 2* one directory 3* another and so on I have done this already but not posted.

Share this post

Link to post
Share on other sites

This is a modification of some other code I have it works now as a shortcut for entering blocks as an example B1 would get say "Block1" the only rule is you must use B or b as 1st character, you can use numbers or alphas does not matter, you need to change a couple of things the directory name and make a new lst. This is version one so uses the existing blocks within the current drawing which is expected to be your dwg template. As others have suggested I would load all blocks into the current dwg and just purge them out later on use lee-mac steal.lsp to load all blocks from a dwg first.


; original code and methology by Alan H
; assistance and code that worked by Lee-Mac
; Insert blocks by shortcut June 2017

(   (lambda nil
       (foreach obj (cdar (vlr-reactors :vlr-command-reactor))
           (if (= "Blk-reactor" (vlr-data obj))
               (vlr-remove obj)
       (vlr-command-reactor "Blk-reactor" '((:vlr-unknowncommand . Blk-reactor-callback)))

(defun blkins ( / blkname ans lst len acdoc x pt ptstr fname)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ; open database
(setq lst (list "1" "001" "2" "002" "3" "003" "4" "Northn")) ; test lst of blocks
(setq len (length lst)) ; how many items in lst
(setq ans  (substr com 2)) ; return the characters after B or b
(setq x 0)
(repeat len
(if (= (nth x lst) ans)
(setq blkname (nth (+ x 1) lst)) ; find blockname in lst can be improved with a while
) ; if
(setq x (+ x 2)) ; lst is pairs
) ; repeat
(setq pt (getpoint "Select insertion point"))
(setq ptstr (strcat (rtos (car pt) 2 3) "," (rtos (cadr pt) 2 3))) ; convert pt to xy
(setq fname "C:\\Alan\\blkins.scr") ; script filename
(setq fo (open fname "w"))
(write-line (strcat "-insert " blkname " " ptstr " 1 1 0") fo)
(write-line "filedia 1" fo) ; turn dialouges abck on
(close fo) ; close file
(vla-sendcommand acdoc "filedia 0 ") ; turn off dialouges
(vla-sendcommand acdoc "_.script C:\\Alan\\blkins.scr") ; run script file as insert will read entire line 
(vla-sendcommand acdoc (chr 13)) ; need a Cr press Enter

(defun Blk-reactor-callback ( obj com )
(setq com (vl-string-translate "-" "." (strcase (car com)))) ; strcase so B or b
        (  (and
           (wcmatch com "~*[~B.0-9]*")
           (wcmatch com "B*")
           (wcmatch com "~B*B*")
           (wcmatch com "~*.*.*")
           ) ; and
   ) ; master cond
) ; defun


 ; make block list to file
; by Alan H june 2017
(setq fo (open "c:\\alan\\block-names.txt" "w"))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for blk (vla-get-blocks doc)
(write-line (vla-get-name blk) fo)
(princ (vla-get-name blk))
(close fo)

Edit the file block-names.txt I pasted to excel sorted and removed some block names. 2nd pass adds the number to the block name and makes LST to paste into the code.


; number block list to new file 
; by Alan H June 2017
(setq x 1)
(setq f1 (open "c:\\alan\\block-names.txt" "R"))
(setq f2 (open "c:\\alan\\block-names-lst.txt" "w"))
(write-line "(setq lst (list " f2)
(while (setq newline (read-line f1))
(write-line (strcat (chr 34) (rtos x 2 0) (chr 34) " " (chr 34) newline (chr 34)) f2)
(setq x (+ x 1))
(write-line "))" f2)
(close f1)
(close f2)

Edited by BIGAL

Share this post

Link to post
Share on other sites

Thanks BIGAL. Let me study it.

Share this post

Link to post
Share on other sites

Just post if you get stuck.

Share this post

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now