2010: Edit the linetype scale of all block sub-entities depending on linetype
Hello Everyone,
I've been using lisp in autocad for about a 18 months now but lately I've started using batch processing to do a lot of the work for me as time is critical.
While I've developed a number of lisp routines to use both on the fly and for batch processing my understanding of the code is fairly basic and i just get lost with vla code.
After having searched the web for 2 weeks for bits of code which would do the things I'm after, i cant put it together properly.
Not having the freedom to pursue this much longer I've finally decided to ask for help.
I found a lisp routine which will edit the sub entities of all blocks setting the layer to "0", color to "By Block" and linetype to "By Block".
This is almost what i want to happen.
What i need to happen:
Load linetypes: hidden, phantom, and Centre (this is from a custom *.lin file)
Change the line type scale of all entities and block sub-entities and according to linetype
ie: where
Linetype = "DGN Style 2" Linetype Scale should =10
Linetype = "DGN Style 3" Linetype Scale should = 10
Linetype = "DGN Style 4" Linetype Scale should =1
Linetype = "DGN Style 6" Linetype Scale should =3
Linetype = "DGN Style 7" Linetype Scale should =1
Change the line type of all entities, block sub-entities and layers
Old Linetype: "DGN Style 2", New Linetype:Hidden
Old Linetype: "DGN Style 3", New Linetype:Hidden
Old Linetype: "DGN Style 4", New Linetype:Centre
Old Linetype: "DGN Style 6", New Linetype:Phantom
Old Linetype: "DGN Style 7", New Linetype:Centre
then change the Block sub entities properties: layer to "0" and color to "By Block"
I dont want them set set to "by block" or "by layer" as both the block's and layer's linetype settings are inconsistent.
The next post contains the code i thought i could adapt, but alas it is beyond me. Thanks to the person who wrote this code in the first place. Sorry i cant remember where i got it from.
1 Attachment(s)
Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype
Thanks Tom, this code works fantastically for the block sub entities and it'll help me understand the code a bit more too.
Is there a way to use this code to
A: also include entities not contained within in blocks
B: change the layers linetype setting
C: automatically select all blocks in the file when called instead of prompting the user to select block
If you need it, Attached is my test file which has all linetypes loaded, in each scenario where the change is required.
After the linetype change you will probably need to set the global linetype scale (lts) to 20 to see the results. (note: this it not required in this code)
Attachment 92562
Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype
This should take care of A & C:
Code:
(vl-load-com)
(defun C:FIXBLKSroy (/ *ERROR* SSET intCount ENAM EOBJ ELST BNAM FLST FIX1)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark thisdrawing)
(defun *ERROR* (err) ; define local handler
(vl-cmdf "undo" "Mark")
(princ "\n\n")
(princ)
); "" is the same message you get when exiting an AutoCAD command.
(defun FIX1 (BNAM / BENAM BONAM)
(if (not (member BNAM FLST))
(progn
(setq FLST (cons BNAM FLST)
BENAM (tblobjname "block" BNAM)
)
(while (setq BENAM (entnext BENAM))
(if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
(fix1 (cdr (assoc 2 (entget BENAM))))
(progn
(setq BONAM(vlax-ename->vla-object BENAM))
(cond
((= "DGN Style 2"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
)
((= "DGN Style 3"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
)
((= "DGN Style 4"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
)
((= "DGN Style 6"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 3))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Phantom"))
)
((= "DGN Style 7"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
)
(T
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
)
)
(vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
(vl-catch-all-apply 'vla-put-color (list BONAM 0))
)
)
)
)
)
)
(setq SSET (ssget "X" (list (cons 6 "DGN Style 2,DGN Style 3"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 10)
(vla-put-Linetype EOBJ "Hidden")
)
(setq SSET (ssget "X" (list (cons 6 "DGN Style 4,DGN Style 7"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 1)
(vla-put-Linetype EOBJ "Hidden")
)
(setq SSET (ssget "X" (list (cons 6 "DGN Style 6"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 3)
(vla-put-Linetype EOBJ "Centre")
)
(setq SSET (ssget "X" (list (cons 0 "INSERT")))) ; every block in drawing
; (setq SSET (ssget (list (cons 0 "INSERT")))) ; pick blocks
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
ELST (entget ENAM)
BNAM (cdr (assoc 2 ELST))
FLST nil
)
(fix1 BNAM)
)
(vl-cmdf "regen")
(vla-endundomark thisdrawing)
(princ)
)
Let me know how that works while I look at the layers table.
Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype
Hi Tom i did a little bit of tweaking and the code seems to work well so far, thanks for your help.
I have added code to change the layers that i know of but would still like to know how to select and edit the layer properties based on their assigned properties (linetypes, etc).
Here is the code I'm currently using
Code:
(vl-load-com)
(defun C:fb (/ *ERROR* SSET intCount ENAM EOBJ ELST BNAM FLST FIX1)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark thisdrawing)
;Roy-Load Linetypes
(if (tblsearch "LTYPE" "centre")
(command "-linetype" "l" "centre" "C:/Program Files/AutoCAD 2010/Support/Linetypes/Centre.lin" "YES" "")
(command "-linetype" "l" "centre" "C:/Program Files/AutoCAD 2010/Support/Linetypes/Centre.lin" "")
)(princ)
(if (tblsearch "LTYPE" "dot2")
(command "-linetype" "l" "dot2" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
(command "-linetype" "l" "dot2" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
)(princ)
(if (tblsearch "LTYPE" "HIDDEN")
(command "-linetype" "l" "HIDDEN" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
(command "-linetype" "l" "HIDDEN" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
)(princ)
(if (tblsearch "LTYPE" "PHANTOM")
(command "-linetype" "l" "PHANTOM" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
(command "-linetype" "l" "PHANTOM" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
)(princ)
(prompt "\n\n")
(prompt "\nLINETYPES LOADED")
(command "resume")
(princ)
;=================
(defun *ERROR* (err) ; define local handler
(vl-cmdf "undo" "Mark")
(princ "\n\n")
(princ)
); "" is the same message you get when exiting an AutoCAD command.
(defun FIX1 (BNAM / BENAM BONAM)
(if (not (member BNAM FLST))
(progn
(setq FLST (cons BNAM FLST)
BENAM (tblobjname "block" BNAM)
)
(while (setq BENAM (entnext BENAM))
(if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
(fix1 (cdr (assoc 2 (entget BENAM))))
(progn
(setq BONAM(vlax-ename->vla-object BENAM))
(cond
; roys code
((= "DGN Style 1"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 5))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Dot2"))
)
; roys code
((= "DGN Style 2"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
)
((= "DGN Style 3"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
)
((= "DGN Style 4"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
)
((= "DGN Style 6"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 3))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Phantom"))
)
((= "DGN Style 7"(vlax-get-property BONAM 'Linetype))
(vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
)
(T
(vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
)
)
(vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
(vl-catch-all-apply 'vla-put-color (list BONAM 0))
;Roy-Set Linetype Generation
(vl-catch-all-apply 'vla-put-linetypegeneration (list BONAM 0))
;===========================
)
)
)
)
)
)
;ALL OBJECTS NOT IN BLOCKS
(PROMPT "\n PROCESSING ALL OBJECTS NOT IN BLOCKS")
(if (setq SSET (ssget "X" (list (cons 6 "DGN Style 2,DGN Style 3"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 10)
(vla-put-Linetype EOBJ "Hidden")
)
(prompt "\n No objects outside of blocks with a linetype of DGN Style 2,DGN Style 3")
)
(if (setq SSET (ssget "X" (list (cons 6 "DGN Style 4,DGN Style 7"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 1)
(vla-put-Linetype EOBJ "CENTRE")
)
(prompt "\n No objects outside of blocks with a linetype of DGN Style 4,DGN Style 7")
)
(if (setq SSET (ssget "X" (list (cons 6 "DGN Style 6"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 3)
(vla-put-Linetype EOBJ "PHANTOM")
)
(prompt "\n No objects outside of blocks with a linetype of DGN Style 6")
)
;Roy-Set Linetype Generation
(if (setq SSET (ssget "x" (list (cons 0 "LWpolyline"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vl-catch-all-apply 'vla-put-linetypegeneration (list EOBJ 0))
)
(prompt "\n No objects outside of blocks that are Polylines")
)
;===================
;Roy-Set Color Correction
(if (setq SSET (ssget "x" (list (cons 62 254))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vl-catch-all-apply 'vla-put-color (list EOBJ 9))
)
(prompt "\n No objects outside of blocks that are Polylines")
)
;===================
;Roy-Set properties of known Layers
(command "-layer" "l" "centre" "centre,1000-Excavation Centre Lines" "")
(princ)
(command "-layer" "l" "Phantom" "phantom,Handrail SingleLine" "")
(princ)
(command "-layer" "l" "hidden" "hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden" "")
(princ)
(command "-layer" "c" "9" "phantom,hatch,hidden" "")
(princ)
(command ^C^C)
;===================
;Roy-Set properties of known Layer Objects
(if (setq SSET (ssget "x" (list (cons 8 "phantom,Handrail SingleLine"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 3)
(vla-put-Linetype EOBJ "bylayer")
)
(prompt "\n No objects on layers named phantom,Handrail SingleLine")
)
(if (setq SSET (ssget "x" (list (cons 8 "hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 10)
(vla-put-Linetype EOBJ "ByLayer")
)
(prompt "\n No objects on layers named hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden")
)
(if (setq SSET (ssget "x" (list (cons 8 "centre,1000-Excavation Centre Lines"))))
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
EOBJ (vlax-ename->vla-object ENAM)
)
(vla-put-LinetypeScale EOBJ 1)
(vla-put-Linetype EOBJ "ByLayer")
)
(prompt "\n No objects on layers named centre,1000-Excavation Centre Lines")
)
;===================
(setq SSET (ssget "X" (list (cons 0 "INSERT")))) ; every block in drawing
;(setq SSET (ssget (list (cons 0 "INSERT")))) ; pick blocks
(repeat (setq intCount (sslength SSET))
(setq intCount (1- intCount)
ENAM (ssname SSET intCOunt)
ELST (entget ENAM)
BNAM (cdr (assoc 2 ELST))
FLST nil
)
(fix1 BNAM)
)
(vl-cmdf "regen")
(vla-endundomark thisdrawing)
(princ)
(command "resume")
)