TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Biscuits on June 10, 2010, 10:15:25 AM
-
Thanks to quite a few of you good folks here at the Swamp, I've managed to cobble these routines and would like to improve them a bit.
The first routine (UPDATEBTITLE2.lsp) simply updates or redefines the border only of our titleblock to match the current one from our network folder.
The second routine (2010_Title2.LSP) updates the attributes of that titleblock and transfers the existing values to the updated attribute block.
The first issue is in the attribute update routine.
All the values get replaced except the drawing number. I got to get this corrected but I am stumped.
Secondly, I'm trying to combine these into one routine with no success.
Any ideas or thought would be greatly appreciated. Thanks
Using Autocad2010 with Windows XP Professional
; pg2 TitleBlock Border Update
(defun c:UPDATEBTITLE2 (/ BlkDwgPath dbxApp oVer bDidError ActDoc BlkCol fromBlkCol Sel EntData BlkName fromBlkDef BlkDef fromObjList)
(vl-load-com)
(defun *error* (msg)
(if dbxApp (vlax-release-object dbxApp))
(setq dbxApp nil)
(if msg (prompt (strcat "\n Error-> " msg)))
)
(setq BlkDwgPath "BTITLE2.dwg")
(setq dbxApp
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(setq bDidError (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp BlkDwgPath))))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq BlkCol (vla-get-Blocks ActDoc))
(setq fromBlkCol (vla-get-Blocks dbxApp))
(setvar 'Errno 0)
(while
(and
(not bDidError)
(not (equal (getvar 'ErrNo) 52))
)
(if
(and
(setq EntData (entget (car Sel)))
(= (cdr (assoc 0 EntData)) "INSERT")
(setq BlkName (cdr (assoc 2 EntData)))
(not
(vl-catch-all-error-p
(setq fromBlkDef (vl-catch-all-apply 'vla-Item (list fromBlkCol BlkName)))
)
)
(setq BlkDef (vla-Item BlkCol BlkName))
)
(progn
(setq fromObjList nil)
(vlax-for obj BlkDef
(vla-Delete obj)
)
(vlax-for obj fromBlkDef
(setq fromObjList (cons obj fromObjList))
)
(vlax-invoke dbxApp 'CopyObjects fromObjList BlkDef)
(vla-Regen ActDoc acActiveViewport)
(prompt (strcat "\n Updated block: " BlkName))
)
)
)
(*error* nil)
(princ)
)
;2010_Title2.LSP 2010 Title Block Attribute Update (FOR pg 2)
(defun C:2010_Title2 (/ TXT TXXT EE E ANS ANS2 OBN SCLX SCLY OLDSNP OLDOSM oldblk oldblk1 IP)
(command "-LAYER" "SET" "BORD" "")
(setvar "cmdecho" 1)
(setvar "snapmode" 0)
(setq EE (entsel "\nSelect Base Block:"))
(if EE
(progn
(setq EE_DEL (CAR EE))
(setq EE (entget (car EE) (list "ACAD")))
(setq ANS (cdr (assoc 0 EE)))
(cond
((eq ANS "INSERT")
(setq OBN (cdr (assoc 2 EE)))
(setq SCLX (cdr (assoc 41 EE)))
(setq SCLY (cdr (assoc 42 EE)))
(setq IP (cdr (assoc 10 EE)))
(setq ANS2 (substr OBN 1 1))
(if (= ANS2 "*")
(progn
(if (= SCLX SCLY)
(princ
(strcat "\n Scale= "
(rtos SCLX 2 3)))
))
))
))
(princ " Nothing selected. "))
(command "-insert" "BTITLE2=BTITLE2.DWG" IP SCLX "" "")
(command "explode" "L")
(SETQ BASELIST (LIST))
(setq ename (entnext EE_DEL))
(setq elist (entget ename))
(command "erase" EE_DEL "" )
(setq ename1 (car (entsel "\nSelect Block To Apply Changes:")))
(while (= ename1 nil)
(princ "\nNothing Picked")
(setq ename1 (car (entsel "\nSelect Block To Apply Changes:")))
);end while
(setq ename (entnext ename))
(setq elist (entget ename)) ;the entity list of the base border
(setq etype (cdr (assoc 0 elist))) ;should be attrib
(while (= etype "ATTRIB") ;puts all the attribute in a list
(setq tag (cdr (assoc 2 elist))) ;the attribute tag
(setq val (cdr (assoc 1 elist)));the attribute value
(setq baselist (append (list (list tag val)) baselist));put the attribute in list
(setq ename (entnext ename)) ;move onto the next attribute
(setq elist (entget ename))
(setq etype (cdr (assoc 0 elist)))
);end while
(setq ename1 (entnext ename1)) ;get the next entity, should be "ATTRIB"
(setq elist1 (entget ename1)) ;the entity list of the border
(setq etype1 (cdr (assoc 0 elist1))) ;should be attrib
(while (= etype1 "ATTRIB")
(setq attval nil)
(setq tag (cdr (assoc 2 elist1)));the attribute tag
(foreach item baselist
(if (= tag (nth 0 item))
(progn
(setq attval (nth 1 item))
);end then
(progn);else do nothing go to next in list till tag matches
);end if
);end foreach
(if (/= attval nil)
(progn (setq elist1 (subst (cons 1 attval) (assoc 1 elist1) elist1))
(entmod elist1));end then
(progn);end else
);end if
(setq ename1 (entnext ename1)) ;move onto the next attribute
(setq elist1 (entget ename1))
(setq etype1 (cdr (assoc 0 elist1)))
);end while
(command "REGEN")
);end defun
(princ "\n 2010_Title2.lsp is loaded. Type \"2010_Title2\" to run. ")
(princ)
-
Biscuits, please read this (http://www.theswamp.org/index.php?topic=4429.0) :-)
-
Thanks Lee. I did read that very post just before posting mine and did an edit almost right away.
Is it looking like it should now? Or am I missing something?
-
You are currently using [quote ] [/quote] tags, these should be [code ] [ /code] tags (without the spaces)
-
Try this ...
The disclaimer is that I have not actually executed the code ...
I've added a few comments to help you understand part of what I did to clean up the code
I noticed you explode the title block you insert ... unless your new one is a nested block, this will fail miserably ... once you explode the title block, any attributes are lost
(defun C:2010_Title2 (/ varlist )
(setq varlist
(list
(getvar "clayer")
(getvar "cmdecho")
(getvar "snapmode")
)
)
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") '("BORD" 0 0))
(setq ee (entsel "\nSelect Base Block: "))
(if ee
(progn
(setq ee_del (car ee) ; sequential setqs combined into one
ee (entget (car ee) (list "ACAD"))
ans (cdr (assoc 0 ee))
)
(if (eq ans "INSERT")
(progn
(setq obn (cdr (assoc 2 ee))
sclx (cdr (assoc 41 ee))
scly (cdr (assoc 42 ee))
ip (cdr (assoc 10 ee))
ans2 (substr obn 1 1)
)
(if (and (= ans2 "*")(= sclx scly)) ; progn not needed when only there is only 1 top level paren wrap
(princ (strcat "\n Scale= " (rtos sclx 2 3)))
)
)
)
)
(princ " Nothing selected. ")
)
(command "-insert" "BTITLE2=BTITLE2.DWG" ip sclx "" "")
(command "explode" "L") ; is this title block nested? If not this will explode the newly inserted title block making the attributes useless
(setq ename (entnext ee_del)) ; remove (setq elist (entget ename)) it is duplicated
(entdel ee_del) ; entdel is preferable over (command "erase" ....)
(setq tb1 (entsel "\nSelect Block To Apply Changes:")) ; remove the (car (entsel ..) portion of code .. if nothing is selected an error is generated
(while (= tb1 nil)
(princ "\nNothing Picked")
(setq tb1 (entsel "\nSelect Block To Apply Changes:"))
);end while
(setq ename1 (car tb1))
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
(while (= etype "ATTRIB") ; puts all the attributes in a list NOTE: baselist can be nil
(setq tag (cdr (assoc 2 elist))
val (cdr (assoc 1 elist))
baselist (append baselist (list (list tag val)))
ename (entnext ename)
)
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
);end while
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
(while (= etype1 "ATTRIB")
(setq tag (cdr (assoc 2 elist1))
att (assoc tag baselist)
)
(if att
(entmod (subst (cons 1 (cdr att)) (assoc 1 elist1) elist1))
)
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
);end while
(entupd (car tb1))
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") varlist)
(princ)
);end defun
(princ "\n 2010_Title2.lsp is loaded. Type \"2010_Title2\" to run. ")
(princ)
-
Lee, I see the light thanks.
Keith, I'll work on this for a while. Thanks
-
Oh, and I forgot to localize the variables in the code .. that needs to happen else the code will be unpredictable.
-
Keith here the results
Old attribute was replaced but not updated with the following in the command line:
Command: (LOAD "2010_TITLE2")
2010_Title2.lsp is loaded. Type "2010_Title2" to run.
Command: 2010_TITLE2
Select Base Block:
Select Block To Apply Changes:; error: bad DXF group: (1 "CD125_")
-
interesting ...
Found the culprit .. your original code had:
(setq baselist (append (list (list tag val)) baselist))
I changed it to:
...
baselist (append baselist (list (list tag val)))
...
It should have been:
...
baselist (append baselist (list (cons tag val)))
...
It works now .. at least in my testing it did .. your blocks may or may not be nested ...
(defun C:2010_Title2 (/ ans ans2 att baselist ee ee_del elist elist1 ename ename1 etype etype1 ip sclx scly tag tb1 val varlist)
(setq varlist
(list
(getvar "clayer")
(getvar "cmdecho")
(getvar "snapmode")
)
)
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") '("BORD" 0 0))
(setq ee (entsel "\nSelect Base Block: "))
(if ee
(progn
(setq ee_del (car ee) ; sequential setqs combined into one
ee (entget (car ee) (list "ACAD"))
ans (cdr (assoc 0 ee))
)
(if (eq ans "INSERT")
(progn
(setq obn (cdr (assoc 2 ee))
sclx (cdr (assoc 41 ee))
scly (cdr (assoc 42 ee))
ip (cdr (assoc 10 ee))
ans2 (substr obn 1 1)
)
(if (and (= ans2 "*")(= sclx scly)) ; progn not needed when only there is only 1 top level paren wrap
(princ (strcat "\n Scale= " (rtos sclx 2 3)))
)
)
)
)
(princ " Nothing selected. ")
)
(command "-insert" "BTITLE2=BTITLE2.DWG" ip sclx "" "")
(command "explode" "L") ; is this title block nested? If not this will explode the newly inserted title block making the attributes useless
(setq ename (entnext ee_del)) ; remove (setq elist (entget ename)) it is duplicated
(entdel ee_del) ; entdel is preferable over (command "erase" ....)
(setq tb1 (entsel "\nSelect Block To Apply Changes:")) ; remove the (car (entsel ..) portion of code .. if nothing is selected an error is generated
(while (= tb1 nil)
(princ "\nNothing Picked")
(setq tb1 (entsel "\nSelect Block To Apply Changes:"))
);end while
(setq ename1 (car tb1))
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
(while (= etype "ATTRIB") ; puts all the attributes in a list NOTE: baselist can be nil
(setq tag (cdr (assoc 2 elist))
val (cdr (assoc 1 elist))
baselist (append baselist (list (cons tag val)))
ename (entnext ename)
)
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
);end while
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
(while (= etype1 "ATTRIB")
(setq tag (cdr (assoc 2 elist1))
att (assoc tag baselist)
)
(if att
(entmod (subst (cons 1 (cdr att)) (assoc 1 elist1) elist1))
)
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
);end while
(entupd (car tb1))
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") varlist)
(princ)
);end defun
(princ "\n 2010_Title2.lsp is loaded. Type \"2010_Title2\" to run. ")
(princ)
-
TA DA!
That was the fix it needed.....thank you very much Keith!
Is it possible to combine the two routines?
-
yeah ...
at the end of the routine, just change the code to look like this:
(entupd (car tb1))
(c:UPDATEBTITLE2)
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") varlist)
(princ)
Of course I have to ask .. if you are redefining the block by inserting TITLE2 from the HD, why do you need to redefine it after you re-insert it .. it doesn't make sense to me ...
-
Works great. Thanks!
Btitle.dwg contains blocks "2010DWGATTRIBUTES2" & "2010X-REFBTITLE2" and we may have multiple instances of this titleblock within a drawing.
So far this has been the only way I can quickly update all of them.
I'm all ears if you have any better methods.
Thank you for all your help.
Capt'n & Cokes are on me
Here's the final product
(defun C:2010_Attrib2 (/ varlist EE E ANS ANS2 OBN SCLX SCLY IP)
(setq varlist
(list
(getvar "clayer")
(getvar "cmdecho")
(getvar "snapmode")
)
)
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") '("BORD" 0 0))
(setq ee (entsel "\nSelect Base Block: "))
(if ee
(progn
(setq ee_del (car ee)
ee (entget (car ee) (list "ACAD"))
ans (cdr (assoc 0 ee))
)
(if (eq ans "INSERT")
(progn
(setq obn (cdr (assoc 2 ee))
sclx (cdr (assoc 41 ee))
scly (cdr (assoc 42 ee))
ip (cdr (assoc 10 ee))
ans2 (substr obn 1 1)
)
(if (and (= ans2 "*")(= sclx scly))
(princ (strcat "\n Scale= " (rtos sclx 2 3)))
)
)
)
)
(princ " Nothing selected. ")
)
(command "-insert" "BTITLE2=//Omaw2kfile02/Lozier/Engineering/Eng_Doc/Drafting/BLOCK/TITLEBLOCKS/BTITLE2.DWG" IP SCLX "" "")
(command "explode" "L")
(setq ename (entnext ee_del))
(entdel ee_del)
(setq tb1 (entsel "\nSelect Block To Apply Changes:"))
(while (= tb1 nil)
(princ "\nNothing Picked")
(setq tb1 (entsel "\nSelect Block To Apply Changes:"))
);end while
(setq ename1 (car tb1))
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
(while (= etype "ATTRIB") ; puts all the attributes in a list NOTE: baselist can be nil
(setq tag (cdr (assoc 2 elist))
val (cdr (assoc 1 elist))
baselist (append baselist (list (cons tag val)))
ename (entnext ename)
)
(if ename
(setq elist (entget ename)
etype (cdr (assoc 0 elist))
)
)
);end while
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
(while (= etype1 "ATTRIB")
(setq tag (cdr (assoc 2 elist1))
att (assoc tag baselist)
)
(if att
(entmod (subst (cons 1 (cdr att)) (assoc 1 elist1) elist1))
)
(setq ename1 (entnext ename1))
(if ename1
(setq elist1 (entget ename1)
etype1 (cdr (assoc 0 elist1))
)
)
);end while
(entupd (car tb1))
(load "2010_Bord2")
(c:2010_Bord2)
(mapcar 'setvar '("clayer" "cmdecho" "snapmode") varlist)
(princ)
);end defun
(princ "\n 2010_Title2.lsp is loaded. Type \"2010_Title2\" to run. ")
(princ)
-
Capt'n & Cokes are on me
if'n I am ever in your neighborhood or you in mine, I'll take you up on that offer
-
Another thought if you will..........
Could the UPDATEBTITLE2.lsp be changed to select block "2010X-REFBTITLE2" without having to physically selecting it?
I've tried but failed miserably.
I would like this to run automatically through my acaddoc.lsp. That I can do.
Thanks
-
uh .. that lisp already loops through the entire block collection in the opened drawing .. interestingly enough, after having looked at the code it looks like it shouldn't work ...
the following line should fail:
(setq EntData (entget (car Sel)))
because Sel is nil (it is localized in the function) and there is nothing setting that value in the function provided ...
If you want to select all of the inserts you can use ssget
i.e.
(setq selectionset (ssget "x" '((0 . "INSERT")(2 . "2010-REFBTITLE2"))))
Of course then you need to loop through each item in the Selection Set
-
I already tried that selection idea.
I'm just not familiar in the looping part of it.
-
well, I don't see where it is selected in that code ... actually there is no selection in the code you have posted. The program iterates through each block in the drawing .. and opens them via DBX .. in which case you wouldn't select anything anyway ... are you talking about the other code or is there something going on I don't know about.
-
Here's what I tried. Like I said....looping is beyond me.
(defun c:2010_Bord2 (/ BlkDwgPath dbxApp oVer bDidError ActDoc BlkCol fromBlkCol selectionset Sel EntData BlkName fromBlkDef BlkDef fromObjList)
;updates Border only for all pg2
(vl-load-com)
(defun *error* (msg)
(if dbxApp (vlax-release-object dbxApp))
(setq dbxApp nil)
(if msg (prompt (strcat "\n Error-> " msg)))
)
;---------------------------------------------
(setq BlkDwgPath "//Omaw2kfile02/Lozier/Engineering/Eng_Doc/Drafting/BLOCK/TitleBlocks/BTITLE2.dwg")
(setq dbxApp
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(setq bDidError (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp BlkDwgPath))))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq BlkCol (vla-get-Blocks ActDoc))
(setq fromBlkCol (vla-get-Blocks dbxApp))
(setvar 'Errno 0)
(while
(and
(not bDidError)
(not (equal (getvar 'ErrNo) 52))
)
(if
(and
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Sel (ssget "x" '((0 . "INSERT") (2 . "2010X-REFBTITLE2"))))
; (setq Sel (entsel "\n Select block to update: "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq EntData (entget (car Sel)))
(= (cdr (assoc 0 EntData)) "INSERT")
(setq BlkName (cdr (assoc 2 EntData)))
(not
(vl-catch-all-error-p
(setq fromBlkDef (vl-catch-all-apply 'vla-Item (list fromBlkCol BlkName)))
)
)
(setq BlkDef (vla-Item BlkCol BlkName))
)
(progn
(setq fromObjList nil)
(vlax-for obj BlkDef
(vla-Delete obj)
)
(vlax-for obj fromBlkDef
(setq fromObjList (cons obj fromObjList))
)
(vlax-invoke dbxApp 'CopyObjects fromObjList BlkDef)
(vla-Regen ActDoc acActiveViewport)
(prompt (strcat "\n Updated block: " BlkName))
)
)
)
(*error* nil)
(princ)
)