ollie Posted July 18, 2009 Posted July 18, 2009 Hi folks I am trying to write a block replacement tool in autolisp. (I've wrote the tool in vba which was easy enough) Sadly lisp isn't quite as easygoing as the vba. The script so far follows this procedure -select all of the specific type of block "SSGET" -Create a list for each block ((inpoint)(Attribute details)(Att....)) -Create new block -Add extra attribute Problem is i can't find a practical method for inserting the newblocks. if a block has four attributes then the (command"insert") need 9 parameter (5 default) This isn't very practical as the re insert function would need to be rewritten for each attribute block. Is there anywhere I can find out about using entmake to insert the block> Any thoughts on the subject would be greatly appreciated EDIT: Even if there was a way to use defaults without knowing the number of attributes the problem could be resolved EDIT: Found this Thanks to Buzzard http://www.cadtutor.net/forum/showthread.php?t=36793 Thanks Ollie Quote
Lee Mac Posted July 18, 2009 Posted July 18, 2009 Yes, there are three (maybe more ways) that I see to do it: 1) (setvar "ATTREQ" 0) ;; Do not prompt for attributes, then (command "_.-insert"... 2) Entmake the INSERT definition (providing the block definition exists in the table): Something like: (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt))) A nice example of this in action: (defun c:obj2blk1 (/ ss bn pt i ent elist) ; Get Entities (while (not ss) (princ "\nSelect Objects to Convert to Blocks:") (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))) ) ;_ end while ; Get Block Name and Base Point (while (or (not bn) (not (snvalid bn)) ) ;_ end or (setq bn (getstring "Specify Block Name: ")) ) ;_ end while (initget 1) (setq pt (getpoint "Specify Base Point for Block: ")) ;;; Create BLOCK Header (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0))) ;;;STEP THRU THE SET (setq i (sslength ss)) (while (>= i (setq i (1- i)) 0) (setq ent (ssname ss i) elist (entget ent) ) ;_ end setq (entmake elist) ) ;_ end while ;;;FINISH THE BLOCK DEFINITION (entmake (list (cons 0 "ENDBLK") (cons 8 "0"))) ;;;Insert the Block & Delete Originals (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt))) (command "_.ERASE" ss "") (redraw) (prin1) ) ;_ end defun The above is a code I worked on with David Bethel that will automatically make a block from a selection set of objects. 3) Use a VL method: (vla-insertblock <space> <pt>... etc) Hope this helps Lee Quote
ollie Posted July 18, 2009 Author Posted July 18, 2009 Thanks Lee Unfortunately I'm still having trouble this is the function I have so far (defun InsertBlock (attlist bname / c ent tag) (entmake (list (cons 0 "INSERT") (cons 2 bname) (cons 66 1) (cons 10 (car attlist)) ) ) (entupd (entlast)) (redraw) (setq ent (vlax-ename->vla-object (entlast))) (if (= (vla-get-hasattributes ent) :vlax-true) (progn (foreach c (vlax-safearray->list (variant-value (vla-getattributes ent))) (setq tag (vla-get-tagstring c)) (princ (strcat "\n" tag)) (foreach n attlist (if (= (car n ) tag) (vla-put-textstring c (cadr n)) ) ) ) ) ) ) This is now returning Command: ; error: ActiveX Server returned the error: unknown name: HasAttributes At one point this returned :vla-false for hasattribtues Ollie Quote
Lee Mac Posted July 18, 2009 Posted July 18, 2009 Ollie, what is the format of the "attlist" argument? Quote
ollie Posted July 18, 2009 Author Posted July 18, 2009 Ollie, what is the format of the "attlist" argument? this is the list format ( (63562.0 82951.4 0.0) (Tag Textvalue height visible LAYERNAME "prompt") (Tag Textvalue 300.0 :vlax-false LAYERNAME "prompt") (Tag Textvalue 300.0 :vlax-false LAYERNAME "prompt") (Tag Textvalue 300.0 :vlax-true LAYERNAME "prompt") (Tag Textvalue 300.0 :vlax-true LAYERNAME "prompt") (Tag Textvalue 300.0 :vlax-true LAYERNAME "prompt") ) Quote
Lee Mac Posted July 18, 2009 Posted July 18, 2009 Try this as an alternative: (defun InsertBlock (attlist bname / c ent tag) (if (and (setq blk (entmake[color=Red][b]x[/b][/color] (list (cons 0 "INSERT") (cons 2 bname) (cons 66 1) (cons 10 (car attlist))))) (setq blk (vlax-ename->vla-object blk))) (if (eq (vla-get-hasattributes blk) :vlax-true) (progn (foreach att (vlax-safearray->list (vlax-variant-value (vla-getattributes blk))) (setq tag (vla-get-tagstring att)) (princ (strcat "\n" tag)) (foreach n attlist (if (= (car n) tag) (vla-put-textstring att (cadr n))))))))) Quote
Lee Mac Posted July 18, 2009 Posted July 18, 2009 Another, using VL: [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] InsertBlock [b][color=RED]([/color][/b]attlst bname [b][color=BLUE]/[/color][/b] c ent tag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-p[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] blk [b][color=RED]([/color][/b][b][color=BLUE]vla-insertblock[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] attlst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] bName [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [color=Blue][b]:vlax-true[/b][/color] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-HasAttributes[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] att [b][color=RED]([/color][/b][b][color=BLUE]vlax-safearray->list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-variant-value[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-getAttributes[/color][/b] blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\n"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tag [b][color=RED]([/color][/b][b][color=BLUE]vla-get-tagString[/color][/b] att[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] x [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] attlst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] tag [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-put-TextString[/color][/b] att [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Quote
The Buzzard Posted July 18, 2009 Posted July 18, 2009 Hi folks I am trying to write a block replacement tool in autolisp. (I've wrote the tool in vba which was easy enough) Sadly lisp isn't quite as easygoing as the vba. The script so far follows this procedure -select all of the specific type of block "SSGET" -Create a list for each block ((inpoint)(Attribute details)(Att....)) -Create new block -Add extra attribute Problem is i can't find a practical method for inserting the newblocks. if a block has four attributes then the (command"insert") need 9 parameter (5 default) This isn't very practical as the re insert function would need to be rewritten for each attribute block. Is there anywhere I can find out about using entmake to insert the block> Any thoughts on the subject would be greatly appreciated EDIT: Even if there was a way to use defaults without knowing the number of attributes the problem could be resolved EDIT: Found this Thanks to Buzzard http://www.cadtutor.net/forum/showthread.php?t=36793 Thanks Ollie ollie, The thread I put out on entmake for blocks I found not to be a very practical method. You will be doing double the work and making a long drawn out process just to make one block. Not very ideal. While it was interesting to create a block that way and a good learning experience, I would frown on that method. I am trying now to learn some VL methods as an alternative to this. VL although as complex as it may look, you will most likely save yourself headaches in the long run. The methods below are using insert command. These are not VL programs. They will give you an idea as to what I went thru. Look them over. You may want to learn VL after seeing these routines. Good Luck, The Buzzard SL.zip IDS_V1.03.zip Quote
Lee Mac Posted July 18, 2009 Posted July 18, 2009 I think Ollie only wants to entmake the INSERT definition, not the BLOCK defintion, so I don't think it'll be too bad for him. Quote
The Buzzard Posted July 18, 2009 Posted July 18, 2009 I think Ollie only wants to entmake the INSERT definition, not the BLOCK defintion, so I don't think it'll be too bad for him. I was'nt sure, no problem. He is in good hands. Quote
The Buzzard Posted July 18, 2009 Posted July 18, 2009 I think Ollie only wants to entmake the INSERT definition, not the BLOCK defintion, so I don't think it'll be too bad for him. Lee, Just out of curiosity, If you just use only entmake insert, would the attribute portion of the code still be required since it is outside of the program? And if so, Would this be a conflict waiting to happen if someone were to change the block definition? I never tried it that way, So I am unsure of the results. Quote
ollie Posted July 20, 2009 Author Posted July 20, 2009 Thaniks Lee I have got the script runing the way i want it to. I'll post it once I change it to less specific. at the moment it is only built for one function Regards, Ollie Quote
Lee Mac Posted July 20, 2009 Posted July 20, 2009 Lee, Just out of curiosity, If you just use only entmake insert, would the attribute portion of the code still be required since it is outside of the program? And if so, Would this be a conflict waiting to happen if someone were to change the block definition? I never tried it that way, So I am unsure of the results. Good point - I must admit, I have never personally used the entmake INSERT method for blocks with attributes, I just use vla-insertblock most of the time now. But, we shall have to see the route that Ollie took Quote
The Buzzard Posted July 20, 2009 Posted July 20, 2009 Good point - I must admit, I have never personally used the entmake INSERT method for blocks with attributes, I just use vla-insertblock most of the time now. But, we shall have to see the route that Ollie took The only reason I brought it up was that I thought he was using a list with the attribute tags. If someone were to modify these tags in the block outside the program then of course the program will not function correctly. In most cases I have seen programs of this sort make the attributes. It was just a thought. He will need to remember to adjust his program accordingly, No big deal anyway. Quote
ollie Posted July 20, 2009 Author Posted July 20, 2009 The stirpped down fruits of the collective labour (Defun tee(/ sset cntr Ratt attlist blk blklist blkdef c) (vl-load-com) (setq bname "Attblock") (setq cntr -1) (setq sset (ssget "X" (list(cons 2 bname)))) (while (< (setq cntr (+ cntr 1)) (sslength sset)) (setq blk (vlax-ename->vla-object (ssname sset cntr))) (setq attlist (list(cdr (assoc 10 (entget (vlax-vla-object->ename blk)))))) (if (= (vla-get-hasattributes blk) :vlax-true) (progn (foreach c (vlax-safearray->list (variant-value (vla-getattributes blk))) (setq attlist (append attlist (list(list (vla-get-tagstring c) (vla-get-textstring c) (vla-get-height c) (vla-get-invisible c) (vla-get-layer c) (getpmt bname (vla-get-tagstring c)))))) ) (setq blklist (append blklist (list attlist))) (setq attlist nil) ) ) ) (command"erase" sset"") (setq Blkdef (cdar blklist)) (CreateBlock blkdef bname) (foreach c blklist (InsertBlock c bname) ) (command"qsave") ) (defun CreateBlock (attlist name / ent p1 ) (setq sset (ssadd)) (foreach c attlist (setq tag (car c) text (nth 5 c) height (caddr c) visible (cadddr c) layer (nth 4 c ) ) (if (= p1 nil) (setq p1 (list 0.0 0.0 0.0)) (setq p1 (list (car p1 )(- (cadr p1) (+ height (/ height 2)))(caddr p1))) ) (entmake (list (cons 0 "ATTDEF") (cons 10 p1) (cons 40 height) (cons 8 layer) (cons 1 "") (cons 3 text) (cons 7 (getvar "TEXTSTYLE")) (cons 2 tag) (cons 70 1) ) ) (setq ent (entget (entlast))) (setq ent(subst (cons 8 layer)(assoc 8 ent)ent)) (setq ent(subst (cons 40 height)(assoc 40 ent)ent)) (if (eq visible :vlax-true) ( (setq ent(subst (cons 70 0)(assoc 70 ent)ent)) ) ) (entmod ent) (ssadd (entlast) sset) ) (setq p1 (list (car p1 )(- (cadr p1) (+ height (/ height 2)))(caddr p1))) (entmake (list (cons 0 "ATTDEF") (cons 10 p1) (cons 40 300) (cons 8 layer) (cons 1 "") (cons 3 "F2") (cons 7 (getvar "TEXTSTYLE")) (cons 2 "FLOOR") (cons 70 1) ) ) (setq ent (entget (entlast))) (setq ent(subst (cons 8 layer)(assoc 8 ent)ent)) (entmod ent) (ssadd (entlast) sset) (command"block" name "y" (list 0.0 -450.0 0.0) sset "") ) (defun getpmt (blk aname) (if (tblsearch "BLOCK" blk) (vlax-for Obj (vla-item (vla-get-Blocks (vla-get-Activedocument (vlax-get-acad-object))) blk) (if (eq "AcDbAttributeDefinition" (vla-get-ObjectName Obj)) (if (= (vla-get-tagstring obj) aname) (setq pmt (vla-get-PromptString Obj))))) ) pmt) (defun InsertBlock (attlst bname / c ent tag) (vl-load-com) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (setq blk (vla-insertblock (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point (car attlst)) bName 1. 1. 1. 0.)))))) nil (if (eq :vlax-true (vla-get-HasAttributes blk)) (foreach att (vlax-safearray->list (vlax-variant-value (vla-getAttributes blk))) (setq tag (vla-get-tagString att)) (foreach x (cdr attlst) (if (eq tag (car x)) (vla-put-TextString att (cadr x))) ) (if(eq tag "HEAD") (progn (setq lvl (substr (vla-get-textstring att )9 2)) (vla-put-TextString att (substr (vla-get-textstring att) 1 7)) ) ) (if (eq tag "FLOOR") (vla-put-textstring att lvl) ) )))) It may seem like a lot of code for little return but the main group of functions (Posted) have already proven useful and the learning experience was worth every one of the many hours put into it [sic] This as used to recreate and attribute block with one new attribute and divide the value of another attribute value for the new attributes value. Thanks to all that helped Ollie Quote
Lee Mac Posted July 20, 2009 Posted July 20, 2009 No problem Ollie, I see you used the VL method in the end On a side not, something like this could be used to recreate a block - i used it to rename a block in fact. http://www.cadtutor.net/forum/showthread.php?t=36729 This post: http://www.cadtutor.net/forum/showpost.php?p=242147&postcount=24 Quote
ollie Posted July 20, 2009 Author Posted July 20, 2009 No problem Ollie, I see you used the VL method in the end On a side not, something like this could be used to recreate a block - i used it to rename a block in fact. http://www.cadtutor.net/forum/showthread.php?t=36729 This post: http://www.cadtutor.net/forum/showpost.php?p=242147&postcount=24 I have a vba script replaces blocks by referencing template files that would have allow me to do the above as well. I only really needed to split on of the attribute values into two fields. In the end the lisp method was a lot more hassle. Yeah thanks for the vl- method for block insertion. I had hoped to try and use the entmake method but wasn't confident about putting a for loop in the middle of the entmake statement for the attribute difinitions Thanks Ollie Quote
Lee Mac Posted July 20, 2009 Posted July 20, 2009 No problem, as long as it works for you I suppose it doens't matter how you get there (within reason!), Lee Quote
hawstom Posted August 17, 2010 Posted August 17, 2010 Lee Mac, Your solution is new and interesting to me, and I am very grateful that you took the time to post it. As I reviewed the code and the documentation for the error catching, I thought it might be possible to make the following change to the code. Would you be able to comment about this? I want to start implementing this style of coding more (ActiveX with exception handling). Basically, I removed the (function) and (lambda) functions. Any reason why not? p.s. I wish I knew how to do code highlighting. (VL-CATCH-ALL-ERROR-P (SETQ BLK (VL-CATCH-ALL-APPLY 'VLA-INSERTBLOCK (LIST MODELSPACEOBJECT (VLAX-3D-POINT (POLAR (CAR COORDSYS) (CADR COORDSYS) (CDR (ASSOC "Distance" BLOCKLIST)) ) ) (CDR (ASSOC "Name" BLOCKLIST)) (CADR (ASSOC "Scale" BLOCKLIST)) (CADDR (ASSOC "Scale" BLOCKLIST)) (CADDDR (ASSOC "Scale" BLOCKLIST)) (CADR COORDSYS) ) ) ) ) Quote
Lee Mac Posted August 17, 2010 Posted August 17, 2010 I too would code it that way also if I rewrote it - I seem to have learnt a bit more since Jul 2009 lol Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.