TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jonesy on October 10, 2006, 05:11:39 AM
-
The colours, layers and linetypes dictated by our clients are currently set up in template files that we use to start new drawings. Some of our users purge their drawings before they are complete, therefore losing all of the unused layer, colour and linetype settings.
I would like to write a lisp routine to set all of this up and reload the layers that have been purged.
Is there anyone out there who would be willing to help me with this project, by guiding me?
I have very little knowledge in lisp, but am more than willing to learn.
Thanks in advance
Tracey
-
Tracey, Have you tried inserting your template drawing (exploded) into the target drawing ??
// kwb
-
Thanks for your reply Kerry
We have used this method for the past year, sometimes successfully, othertimes not.
Sometimes other users then forget to take the tick out of the "explode" box and many more blocks get inserted already exploded. Sometimes I dont catch these until I audit the drawings.
I was hoping to find an alternative.
-
OK, Try this ..
you'll just need to modify the Layer definitions ..
;; // TRACEY_Layers.lsp
;; // last edit kwb : 20061010
;; (c:Tracey_LAYERS)
;;;=====================================================================
(DEFUN c:tracey_layers (/ lintypefile layerdata
onewlayer ltname
;;
*error* _assertitem
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(DEFUN *error* (msg /)
;;----- Cancel any Active Commands -----------------------------
(WHILE (< 0 (GETVAR "cmdactive")) (COMMAND))
;;-----
(VLA-SETVARIABLE kg:iacaddocument "menuecho" 1)
(VLA-ENDUNDOMARK kg:iacaddocument)
;;----- Display error message if applicable _-------------------
(COND
((NOT msg)) ; no error, do nothing
((VL-POSITION
(STRCASE msg T) ; cancel
'("console break" "function cancelled" "quit / exit abort")
)
)
((PRINC (STRCAT "\nApplication Error: "
(ITOA (GETVAR "errno")) ;; <-- edited kwb
" :- "
msg
)
)
(VL-BT)
)
)
(PRINC)
);;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(DEFUN _assertitem (collection item / returnvalue)
(IF (NOT (VL-CATCH-ALL-ERROR-P
(SETQ
returnvalue (VL-CATCH-ALL-APPLY 'VLA-ITEM
(LIST collection item)
)
)
)
)
returnvalue
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(SETQ kg:iacadapplication (VLAX-GET-ACAD-OBJECT)
kg:iacaddocument (VLA-GET-ACTIVEDOCUMENT kg:iacadapplication)
kg:iacadlayers (VLA-GET-LAYERS kg:iacaddocument)
kg:iacadlinetypes (VLA-GET-LINETYPES kg:iacaddocument)
)
(VLA-ENDUNDOMARK kg:iacaddocument) ; end any open undo group
(VLA-STARTUNDOMARK kg:iacaddocument) ; start new group
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(SETQ g:layerslist
(LIST
(LIST "ST90" ;LayerName
"CONTINUOUS" ;LineType
"Outlines 0.90mm" ;Description
ACBLUE ;Color
)
(LIST "ST70"
"CONTINUOUS"
"Outlines 0.70mm"
ACGREEN
)
(LIST "ST50"
"CONTINUOUS"
"Outlines 0.50mm"
ACMAGENTA
)
(LIST "ST35"
"CONTINUOUS"
"Outlines 0.35mm"
ACYELLOW
)
(LIST "ST25" "CONTINUOUS" "Outlines 0.25mm" ACRED)
(LIST "ST18" "CONTINUOUS" "Outlines 0.18mm" ACCYAN)
(LIST "ST00" "CONTINUOUS" "Outlines Mixed" 8)
(LIST "STC18"
"CENTER2"
"Center Lines Short 0.18mm"
ACCYAN
)
(LIST "STC20"
"CENTER"
"Center Lines Medium 0.25mm"
ACRED
)
(LIST "STC25"
"CENTERX2"
"Center Lines Long 0.25mm"
ACRED
)
(LIST "STH18"
"HIDDEN2"
"Hidden Lines Short 0.18mm"
ACCYAN
)
(LIST "STH20"
"HIDDEN"
"Hidden Lines Medium 0.25mm"
ACRED
)
(LIST "STH25"
"HIDDENX2"
"Hidden Lines Long 0.25mm"
ACRED
)
(LIST "STH30"
"DASHEDX2"
"Dashed Lines Long 0.25mm"
ACRED
)
;; text layers
(LIST "STT90" "CONTINUOUS" "Text 0.90mm" ACBLUE)
(LIST "STT70" "CONTINUOUS" "Text 0.70mm" ACGREEN)
(LIST "STT50" "CONTINUOUS" "Text 0.50mm" ACMAGENTA)
(LIST "STT35" "CONTINUOUS" "Text 0.35mm" ACYELLOW)
(LIST "STT25" "CONTINUOUS" "Text 0.25mm" ACRED)
(LIST "STT18" "CONTINUOUS" "Text 0.18mm" ACCYAN)
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(SETQ lintypefile (IF (= 1 (GETVAR "Measurement"))
(FINDFILE "acadiso.lin")
(FINDFILE "acad.lin")
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;; (setq layerdata (car g:layerslist))
(FOREACH layerdata g:layerslist
(SETQ onewlayer (VLA-ADD kg:iacadlayers (CAR layerdata))
ltname (CADR layerdata)
)
(IF (NOT (_assertitem kg:iacadlinetypes ltname))
(VLA-LOAD kg:iacadlinetypes ltname lintypefile)
)
(VLA-PUT-LINETYPE onewlayer ltname)
(VLA-PUT-DESCRIPTION onewlayer (CADDR layerdata))
(VLA-PUT-COLOR onewlayer (LAST layerdata))
)
(PRINC)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(PRINC)
edit : *error* routine modified <
-
... each of these defines a layer ..
(LIST "ST90" ;LayerName
"CONTINUOUS" ;LineType
"Outlines 0.90mm" ;Description
ACBLUE ;Color
)
-
Thanks Kerry...
I'll look at that this afternoon
-
Hola Tracey;
This is what I use, super basic:
(acad-push-dbmod)
;; basic layers
(setvar "cmdecho" 0)
(setq layer (getvar "clayer"))
(if (not (tblsearch "layer" "1"))
(command "_.layer" "_m" "1" "_c" "1" "" ""))
(if (not (tblsearch "layer" "2"))
(command "_.layer" "_m" "2" "_c" "2" "" ""))
(if (not (tblsearch "layer" "3"))
(command "_.layer" "_m" "3" "_c" "3" "" ""))
(if (not (tblsearch "layer" "4"))
(command "_.layer" "_m" "4" "_c" "4" "" ""))
(if (not (tblsearch "layer" "5"))
(command "_.layer" "_m" "5" "_c" "5" "" ""))
(if (not (tblsearch "layer" "6"))
(command "_.layer" "_m" "6" "_c" "6" "" ""))
(if (not (tblsearch "layer" "7"))
(command "_.layer" "_m" "7" "_c" "7" "" ""))
(if (not (tblsearch "layer" "11"))
(command "_.layer" "_m" "11" "_c" "11" "" ""))
(if (not (tblsearch "layer" "A-DIM"))
(command "_.layer" "_m" "A-DIM" "_c" "4" "" ""))
(if (not (tblsearch "layer" "A-TEXT"))
(command "_.layer" "_m" "A-TEXT" "_c" "4" "" ""))
(if (not (tblsearch "layer" "CENTER"))
(command "_.layer" "_m" "CENTER" "_c" "5" "" "_l" "CENTER" "" ""))
(if (not (tblsearch "layer" "HIDDEN"))
(command "_.layer" "_m" "HIDDEN" "_c" "5" "" "_l" "HIDDEN" "" ""))
(if (not (tblsearch "layer" "XR_BASE"))
(command "_.layer" "_m" "XR_BASE" "_c" "7" "" ""))
(if (not (tblsearch "layer" "XR_TITLEBLOCK"))
(command "_.layer" "_m" "XR_TITLEBLOCK" "_c" "7" "" ""))
(if (not (tblsearch "layer" "VIEWPORT"))
(command "_.layer" "_m" "VIEWPORT" "_c" "1" "" "_p" "_n" "" ""))
(if layer
(setvar "clayer" layer))
(setq layer nil)
(setvar "cmdecho" 1)
(acad-pop-dbmod)
(princ)
-
Thanks LE.
I'll look at that one too.
Can I ask a quick question?
What is (acad-push-dbmod) and (acad-pop-dbmod)
Thanks
Tracey
-
Since the standard has already been defined in a template drawing why not use object dbx to read said drawing's layer structure then (intelligently) recreate it n the current document?
:)
-
Those two functions can be use to make a modifications to a drawing and then restored to the original status.
Go to the autocad help and type DBMOD system variable - or type the function's name on the search tab.
For example, I load the lisp code into a new drawing (started from scratch or any other existing one), the lisp does some modifications... but then I make a decision to simple close the drawing.... Those previous modifications will be ignored and it won't show the dialog message of asking to saved changes....
HTH.
-
Another approach:
Create a block that has line segments, circles, or other simple object for each (and on that) layer. Insert it into the drawing and use the following to make the block reference invisible:
(defun c:jbPutInvisible (/ ent)
(setq ent (entsel))
(if ent
(vla-put-Visible (vlax-ename->vla-object (car ent)) :vlax-false)))
(defun c:jbPutAllVisible (/)
(vlax-for b (vla-get-blocks(vla-get-ActiveDocument(vlax-get-acad-object)))
(vlax-for x b
(if (vlax-property-available-p x 'visible T)
(vla-put-Visible x :vlax-true)))))
Now the block reference can't be erased so the block, and included layers, can't be purged. Include any other object table data in the same way: other blocks, textstyles, dimstyles, etc.
Just a thought,
jb
-
Since the standard has already been defined in a template drawing why not use object dbx to read said drawing's layer structure then (intelligently) recreate it n the current document?
:)
Would that be very difficult (for a newbie like me to be able to follow and learn from)
-
Would that be very difficult (for a newbie like me to be able to follow and learn from)
That's why I am posting something that uses the command approach, so you can start by implementing something simple... Then in the future, you can do complex coding if necessary.
(if (not (tblsearch "layer" "1")) ;; see if the layer name exist.
(command "_.layer" "_m" "1" "_c" "1" "" "")) ;; is not there - make it.
(command "_.layer" "_m" "1" "_c" "1" "" "") ;; even you can use just this.
Again, became comfortable with the lisp coding... and add new code lines... as you need them...
<edit> fixed code tags Mav
-
Since the standard has already been defined in a template drawing why not use object dbx to read said drawing's layer structure then (intelligently) recreate it n the current document?
:)
Would that be very difficult (for a newbie like me to be able to follow and learn from)
While I totally think you could handle it (assuming the info were presented logically, methodically etc.) maybe smaller more bite sized pieces would be better right now; sorry.
:)
-
Since the standard has already been defined in a template drawing why not use object dbx to read said drawing's layer structure then (intelligently) recreate it n the current document?
:)
Would that be very difficult (for a newbie like me to be able to follow and learn from)
While I totally think you could handle it (assuming the info were presented logically, methodically etc.) maybe smaller more bite sized pieces would be better right now; sorry.
:)
When ready I have one I can post. Not very pretty, but I can clean it up pretty quickly, I think. I would start with the other ways mentioned here.
Another way that hasn't been mentioned, is to use 'entmake' to make the layers. I have never done this, but I know others have, and could show a better example. Just giving more options. :-D
-
When ready I have one I can post. Not very pretty, but I can clean it up pretty quickly, I think. I would start with the other ways mentioned here.
Sounds good Tim.
Another way that hasn't been mentioned, is to use 'entmake' to make the layers. I have never done this, but I know others have, and could show a better example. Just giving more options. :-D
With Tracey's tutelage (is that a word?) I think it's better if we favour ActiveX techniques over old Dxf style coding as it's pretty much antiquated (and mixing the two can make AutoCAD chuck a wobbly).
Having said that your generous, helpful heart is in the right place Tim!
:)
-
Tracey,
Food for thought.
Pseudo code:
User select Layer Set to load
Get layer Set to be loaded
Load line types as needed, ignore if not found
Load layers that are missing
Existing layers ignored
Error reporting
Done
Questions:
How is user to select Layer Set?
o Hard coded - no choice
o Get key word - hard coded
o File selection by user
Source of Layer data?
o In a DWG file
o In a TXT type file [txt, cvs, etc]
o In Excel File
o Hard coded in the lisp
Source of Linetypes?
o In a DWG file
o In a LIN file
o hard coded
o Ignore missing linetypes
How to treat existing layers?
o Ignore
o Ask to update all or ignore
o Ask at each found to update
How to treat error reporting?
o Ignore errors
o Report on command line
o Use an alert box
o Write to file
-
Since the standard has already been defined in a template drawing why not use object dbx to read said drawing's layer structure then (intelligently) recreate it n the current document?
:)
Would that be very difficult (for a newbie like me to be able to follow and learn from)
While I totally think you could handle it (assuming the info were presented logically, methodically etc.) maybe smaller more bite sized pieces would be better right now; sorry.
:)
Dont apologise MP
It always amazes me how many different ways there are to do anything in AutoCAD, and this obviously extends to the programming side of it too :-)
If this thread develops, someone may be interested in the object dbx version
-
Wow CAB... theres quite a bit there I'd not considered.
Is it quite easy to pull the information from an excel spreadsheet ( I have it in one already as part of the cad manual)
Theres a lot for me to get my brain ticking over. I'll no doubt have some more questions later :-)
Thanks for your help
-
The colours, layers and linetypes dictated by our clients are currently set up in template files that we use to start new drawings. Some of our users purge their drawings before they are complete, therefore losing all of the unused layer, colour and linetype settings.
I would like to write a lisp routine to set all of this up and reload the layers that have been purged.
Is there anyone out there who would be willing to help me with this project, by guiding me?
I have very little knowledge in lisp, but am more than willing to learn.
Thanks in advance
Tracey
Good question Jonsey!!
A good learning experience for me too.
-
Here is the ObjectDBX version I use (just wrote it, easier than cleaning up the old one :ugly:), incase anyone is interested. Attached is the dialog boxes I use, and is called in the routine.
(defun c:CopyLayers (/ *error* ActDoc LtCol FilePath dbxApp oVer LayList DiaRtn LinFile tempLt tempList NewLayList)
; Copies layers selected from one drawing (opened with ObjectDBX) to the current drawing. Tries to load linetypes
; from the acad(iso).lin file depending on how the drawing is set up (measuement system variable). Will not overwrite
; existing layers to match those being imported.
; Subs' - MultiSelect
(defun *error* (msg)
(if dbxApp
(vlax-release-object dbxApp)
)
(setq dbxApp nil)
(prompt (strcat "\n Error--> " msg))
)
;-----------------------------------------------------------------------
(defun MultiSelect (Listof Message Toggle / DiaLoad tmpStr tmpTog tmpList)
(setq DiaLoad (load_dialog "MyDialogs.dcl"))
(if (new_dialog "MultiSelect" DiaLOad)
(progn
(start_list "listbox" 3)
(mapcar 'add_list Listof)
(end_list)
(if Message
(set_tile "text1" Message)
)
(if (not Toggle)
(mode_tile "toggle1" 1)
)
(mode_tile "listbox" 2)
(action_tile "accept"
"(progn
(setq tmpStr (get_tile \"listbox\"))
(if Toggle
(setq tmpTog (get_tile \"toggle1\"))
)
(done_dialog 1)
)"
)
(action_tile "cancel" "(done_dialog 0)")
(if (= (start_dialog) 1)
(progn
(setq tmpList (read (strcat "(" tmpStr ")")))
(if (= tmpTog "1")
(cons T tmpList)
tmpList
)
)
)
)
)
)
;-----------------------------------------------------------------------
(if
(and
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LtCol (vla-get-Linetypes ActDoc))
(setq FilePath (getfiled "" "" "dwg" 4))
(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))
)
)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp FilePath))))
(or
(vlax-for Lay (vla-get-Layers dbxApp)
(if (not (vl-string-search "*|*" (vla-get-Name Lay)))
(setq LayList (cons (cons (vla-get-Name Lay) Lay) LayList))
)
)
(setq LayList (vl-sort LayList '(lambda (a b) (< (strcase (car a)) (strcase (car b))))))
)
(setq DiaRtn (MultiSelect (mapcar 'car LayList) "Select toggle to copy all layers." T))
(setq LinFile
(findfile
(if (equal (getvar "measurement") 0)
"acad.lin"
"acadiso.lin"
)
)
)
)
(progn
(if (= (car DiaRtn) T)
(foreach pair LayList
(setq tempLt (vla-get-Linetype (cdr pair)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list LtCol tempLt)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Load (list LtCol tempLt LinFile)))
(prompt (strcat "\n Couldn't load linetype \"" tempLt "\" from \"" (vl-filename-base LinFile) ".lin\""))
)
)
)
(progn
(foreach Num DiaRtn
(setq tempList (nth Num LayList))
(setq tempLt (vla-get-Linetype (cdr tempList)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list LtCol tempLt)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Load (list LtCol tempLt LinFile)))
(prompt (strcat "\n Couldn't load linetype \"" tempLt "\" from \"" (vl-filename-base LinFile) ".lin\""))
)
)
(setq NewLayList (cons tempList NewLayList))
)
(setq LayList NewLayList)
)
)
(vlax-invoke dbxApp 'CopyObjects (mapcar 'cdr LayList) (vla-get-Layers ActDoc))
)
(prompt "\n Didn't copy any layers.")
)
(vlax-release-object dbxApp)
(setq dbxApp nil)
(princ)
)
-
Nice job Tim, it worked in my short test just fine. :-)
-
Nice job Tim, it worked in my short test just fine. :-)
Thanks for testing it Alan. Hope it is useful to others. I might code it to ask if you want to overwrite the existing layers later, but for now it works.
-
Tracey,
Not to add to the confusion or take away from learning some code, another option could be the use of Tim Spangler's layer creator. When he got some of the bugs worked out, I was going to implement it where I worked. Being I am no longer there, that didn't happen.
It is nice in that you have have layers broken out by discipline. Depending on the number of layers you are working with, you could have them sorted by client just as easily. I can't remember what it does with layers that are already existing, but that can be figured out easily.
you can read more here:
http://www.theswamp.org/index.php?topic=2414.0 (http://www.theswamp.org/index.php?topic=2414.0)
for what it's worth, I just loaded his latest and I'm getting error's. :|
Pieter
-
Nice job Tim, it worked in my short test just fine. :-)
Thanks for testing it Alan. Hope it is useful to others. I might code it to ask if you want to overwrite the existing layers later, but for now it works.
Tim
Very, very nice job...I can make use of this one.
Gary
-
Nice job Tim, it worked in my short test just fine. :-)
Thanks for testing it Alan. Hope it is useful to others. I might code it to ask if you want to overwrite the existing layers later, but for now it works.
Tim
Very, very nice job...I can make use of this one.
Gary
Thanks Gary.
And to all who can find a use for the routine, have fun with it.
-
Here is the revisied routine that will prompt you if you want to over write the existing layer properties. Same dialog box as the one attached before.
(defun c:CopyLayers (/ *error* ActDoc LtCol FilePath dbxApp oVer LayList DiaRtn LinFile tempLt tempList NewLayList
OvrWrtOpt LayCol)
; Copies layers selected from one drawing (opened with ObjectDBX) to the current drawing. Tries to load linetypes
; from the acad(iso).lin file depending on how the drawing is set up (measuement system variable). Will not overwrite
; existing layers to match those being imported.
; Subs' - MultiSelect
; Revision - Added the option to overwrite the existing layers. Can be prompted per existing layer, or can select to
; change them all, or change none.
(defun *error* (msg)
(if dbxApp
(vlax-release-object dbxApp)
)
(setq dbxApp nil)
(prompt (strcat "\n Error--> " msg))
)
;-----------------------------------------------------------------------
(defun MultiSelect (Listof Message Toggle / DiaLoad tmpStr tmpTog tmpList)
(setq DiaLoad (load_dialog "MyDialogs.dcl"))
(if (new_dialog "MultiSelect" DiaLOad)
(progn
(start_list "listbox" 3)
(mapcar 'add_list Listof)
(end_list)
(if Message
(set_tile "text1" Message)
)
(if (not Toggle)
(mode_tile "toggle1" 1)
)
(mode_tile "listbox" 2)
(action_tile "accept"
"(progn
(setq tmpStr (get_tile \"listbox\"))
(if Toggle
(setq tmpTog (get_tile \"toggle1\"))
)
(done_dialog 1)
)"
)
(action_tile "cancel" "(done_dialog 0)")
(if (= (start_dialog) 1)
(progn
(setq tmpList (read (strcat "(" tmpStr ")")))
(if (= tmpTog "1")
(cons T tmpList)
tmpList
)
)
)
)
)
)
;-----------------------------------------------------------------------
(if
(and
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LtCol (vla-get-Linetypes ActDoc))
(setq LayCol (vla-get-Layers ActDoc))
(setq FilePath (getfiled "" "" "dwg" 4))
(not (initget "Single All None"))
(setq OvrWrtOpt
(if
(not
(setq OvrWrtOpt (getkword "\n Overwrite existing layer information option [<S>ingle confirmation/All/None]: "))
)
(setq OvrWrtOpt "Single")
OvrWrtOpt
)
)
(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))
)
)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp FilePath))))
(or
(vlax-for Lay (vla-get-Layers dbxApp)
(if
(and
(not (vl-string-search "*|*" (vla-get-Name Lay)))
(/= (vla-get-Name Lay) "0")
(/= (strcase (vla-get-Name Lay)) "DEFPOINTS")
)
(setq LayList (cons (cons (vla-get-Name Lay) Lay) LayList))
)
)
T
)
(setq LayList (vl-sort LayList '(lambda (a b) (< (strcase (car a)) (strcase (car b))))))
(setq DiaRtn (MultiSelect (mapcar 'car LayList) "Select toggle to copy all layers." T))
(setq LinFile
(findfile
(if (equal (getvar "measurement") 0)
"acad.lin"
"acadiso.lin"
)
)
)
)
(progn
(if (= (car DiaRtn) T)
(foreach pair LayList
(setq tempLt (vla-get-Linetype (cdr pair)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list LtCol tempLt)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Load (list LtCol tempLt LinFile)))
(prompt (strcat "\n Couldn't load linetype \"" tempLt "\" from \"" (vl-filename-base LinFile) ".lin\""))
)
)
)
(progn
(foreach Num DiaRtn
(setq tempList (nth Num LayList))
(setq tempLt (vla-get-Linetype (cdr tempList)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list LtCol tempLt)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Load (list LtCol tempLt LinFile)))
(prompt (strcat "\n Couldn't load linetype \"" tempLt "\" from \"" (vl-filename-base LinFile) ".lin\""))
)
)
(setq NewLayList (cons tempList NewLayList))
)
(setq LayList NewLayList)
)
)
(cond
((= OvrWrtOpt "None")
(vlax-invoke dbxApp 'CopyObjects (mapcar 'cdr LayList) LayCol)
)
((= OvrWrtOpt "All")
(foreach pair LayList
(if (vl-catch-all-error-p (setq LayObj (vl-catch-all-apply 'vla-Item (list LayCol (vla-get-Name (cdr pair))))))
(vlax-invoke dbxApp 'CopyObjects (list (cdr pair)) LayCol)
(mapcar '(lambda (x) (vl-catch-all-apply 'vlax-put (list LayObj x (vlax-get (cdr pair) x)))) '("Color" "Linetype" "Lineweight" "Plottable" "PlotStyleName"))
)
)
)
((= OvrWrtOpt "Single")
(foreach pair LayList
(if (vl-catch-all-error-p (setq LayObj (vl-catch-all-apply 'vla-Item (list LayCol (vla-get-Name (cdr pair))))))
(vlax-invoke dbxApp 'CopyObjects (list (cdr pair)) LayCol)
(progn
(initget "Yes No")
(if (/= (getkword (strcat "\n \"" (vla-get-Name LayObj) "\" alread exist, over write it [<Y>es/No]: ")) "No")
(mapcar '(lambda (x) (vl-catch-all-apply 'vlax-put (list LayObj x (vlax-get (cdr pair) x)))) '("Color" "Linetype" "Lineweight" "Plottable" "PlotStyleName"))
)
)
)
)
)
)
)
(prompt "\n Didn't copy any layers.")
)
(vlax-release-object dbxApp)
(setq dbxApp nil)
(princ)
)
-
Tracey,
You may find this a useful excise, I did.
Take Tim's code & add comments. First comment what each subroutine does.
Then start with the MAIN code & break down each line or small group of lines &
comment what it does. Then move to the subroutines & do the same.
I'm sure Tim will help you with any items that are not clear to you.
Just a suggestion.
-
Thanks, I'll do that.
-
OK... All the ideas are pretty good... but I will recommend to start from step 1.
Using the command (function) approach first, that way you will understand every step/argument a command is asking.
Then, for step 2.... I will recommend to use entmake and the entget , entsel, setq, car functions (open the autolisp help and read about them) first i.e.
;; for example select a line...
Command: (setq ename (car (entsel "\nSelect an entity: ")))
Command: (entget ename)
;; it will retun something like this:
((-1 . <Entity name: 7bf506b8>)
(0 . "LINE")
(330 . <Entity name: 7de67cd8>)
(5 . "6332CCB540837")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "CONDUIT")
(100 . "AcDbLine")
(10 -5502.45 556.187 0.0)
(11 -5315.0 648.508 0.0)
(210 0.0 0.0 1.0))
;; then remove the unnacessary data from the list
(
;;; (-1 . <Entity name: 7bf506b8>)
(0 . "LINE")
;;; (330 . <Entity name: 7de67cd8>)
;;; (5 . "6332CCB540837")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "CONDUIT")
(100 . "AcDbLine")
(10 -5502.45 556.187 0.0)
(11 -5315.0 648.508 0.0)
(210 0.0 0.0 1.0))
;; erase, first manually the selected line, then call entmake
(entmake
'((0 . "LINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "CONDUIT")
(100 . "AcDbLine")
(10 -5502.45 556.187 0.0)
(11 -5315.0 648.508 0.0)
(210 0.0 0.0 1.0))
);; end of entmake
Study each of the DXF data... became familiar... and then move to a complex approach, when you feel comfortable.
HTH.
-
I can help, no problem. :-) Just let me know what needs some explaining.
I still think Luis has a good approach. There are still things I don't understand, even though I use them. I like having a good basic understanding, and then building from there.
-
Yep...
(but I am not saying that what I posted is the best or the way to go)
I am more concern in trying to make the lisping readable or easy as much is possible to T.
And the same... if I can answer a question... T. let us know.
:-)
-
I like the idea of starting at ground level, then building up.Hopefully there will be fewer holes in my knowledge. It'll take me longer to get there, but, hopefully I'll get fewer problems.
You guys are great.
Its late here in the UK, I'll be back with questions, probably tomorrow :-)
Thanks for your time
Tracey
-
The colours, layers and linetypes dictated by our clients are currently set up in template files that we use to start new drawings. Some of our users purge their drawings before they are complete, therefore losing all of the unused layer, colour and linetype settings.
I would like to write a lisp routine to set all of this up and reload the layers that have been purged.
There's yet another simple solution that doesn't require any Lisp. You can open your template drawing in Design Center and then simply drag'n'drop any missing layers into your current drawing.
-
Great ideas (non-lispy), however, Tracey's trying to learn by asking questions. I'm sure anyone who can write code can whip out what she's asked for or spell out 20 different ways..., but she'd like to learn by doing. I think one of the first lisps I ever did was a rectangle. Rectangle was already in existence, so why write it again? For the learning experience. One of the earliest lisps I ever wrote was very simple and I actually found myself using it today on a bunch of line connections. It was this:
(DEFUN C:L1 (/ A)
(WHILE
(SETQ A (GETPOINT "\nFrom Point: ")
)
(COMMAND "LINE" A PAUSE "")
) ;WHILE
(PRINC)
)
Boy, what ugly code, but I learned from it. It allows you to draw multiple, dual-vertice lines. Simple, ugly, effective.
-
Tracey,
Food for thought.
Pseudo code:
...
<snip>
CABs gets my vote for the most helpfull post in this thread. Expand on this.
-
The colours, layers and linetypes dictated by our clients are currently set up in template files that we use to start new drawings. Some of our users purge their drawings before they are complete, therefore losing all of the unused layer, colour and linetype settings.
I would like to write a lisp routine to set all of this up and reload the layers that have been purged.
There's yet another simple solution that doesn't require any Lisp. You can open your template drawing in Design Center and then simply drag'n'drop any missing layers into your current drawing.
As Daron said, I'm trying to use a real world example to learn, and make me remember lisp. Also some of the templates have over 50 layers purged before they should have been, making it a laborious task to add them.
I'll be looking at all the examples over the next couple of days, asking some very basic questions in the process.
Thanks everyone... I'll be back :-)
-
Tracey, If you find yourself short of study time, Express tools has a Layer Manager which can import layer setting previously saved <exported> from the same interface.
... It doesn't restore the Layer descriptions though .. { no big deal }
The saved file is a text format and is easily editable.
Good luck :-)
-
Thanks Kerry, time is not too much of an issue here.
The way we currently do it is OK, but I want better. So if it takes me a few weeks/months to sort through it all, it wont matter to me. As long as I can keep coming back to this topic and asking questions I'll be OK.
I thought I'd try to learn lisp on something that I want to change here, that way I might understand it a bit better.
-
Sounds like a plan ! :-)
-
Tracey,
You may find this a useful excise, I did.
Take Tim's code & add comments. First comment what each subroutine does.
Then start with the MAIN code & break down each line or small group of lines &
comment what it does. Then move to the subroutines & do the same.
I'm sure Tim will help you with any items that are not clear to you.
Just a suggestion.
Quick question CAB, if you dont mind
Did you mean TWilley, or TimSpanglers layer creation program?
thanks
-
I was referring to Tim Willey.
Tim Spanglers code is too large for this biginner project.
You may want to comment the other lisp routines offered here as well. :-)
-
Thanks CAB.
I'm on it now :-)
-
As Daron said, I'm trying to use a real world example to learn, and make me remember lisp. Also some of the templates have over 50 layers purged before they should have been, making it a laborious task to add them.
I just tried it. I opened a drawing that has most of its layers purged. Then I opened the template in Design Center, selected all layers, and drag'n'dropped them into my drawing. Problem solved. Not laborious at all, and it took less than ten seconds.
But if your main goal is learning to program, and you can't think of any Lisp routine that would be more useful to you, then by all means carry on. Programming skills are handy to have.
-
I couldn't sleep last night so I coded up this framework. It's not a solution <tho it works>, more a demonstration of one way to frame up an application and some development techniques. I didn't complete the documentation but now I'm too tired. Overkill at this point in Tracey's learning journey? Probably. I ante it up anyway for what it's worth. Have a look at your leisure.
First a coloroized pdf file: MakeLayers.pdf (http://www.theswamp.org/screens/mp/MakeLayers.pdf)
And now in good ol' ascii:
(defun c:MakeLayers
;; Written by M.Puckett for T. Jones. Not a solution per
;; se but examples of some techniques one can use during
;; development, particularly when there are some unknowns.
( /
*error*
*debug*
_BreadCrumb
_GetActiveClient
_GetLayerDefinitions
_LoadLinetypes
_CleanClientLayerDefinition
_AddLayers
_Main
)
(defun *error* ( msg )
;; A verbose error handler that will ante up some
;; debugging info if we bomb somewhere.
(vl-bt)
)
(defun _BreadCrumb ( location )
;; We'll use this to flag where we are in program
;; execution. If we're debugging it will echo our
;; location, otherwise it will be quiet.
(if *debug*
(mapcar 'princ
(list "===== Location <" location "> =====\n")
)
)
(princ)
)
(defun _GetActiveClient ( )
(_BreadCrumb "_GetActiveClient [not done]")
;; At this point we don't know how we will get or
;; determine the client's name as it's not been
;; defined (all we know is that our layer system
;; is client centric). Until we know how the client
;; is determined let's return a typical value
;; so the solution can be developed.
;;
;; This technique is sometimes called "stubbing",
;; see http://en.wikipedia.org/wiki/Method_stub
"CLIENT 1"
)
(defun _GetLayerDefinitions ( )
(_BreadCrumb "_GetLayerDefinitions [not done]")
;; At this point we don't know if we are going to
;; get the layer definitions, be it by reading a
;; template file via objectdbx, by reading a simple
;; text file, hard coded values ... whatever. What
;; we do know is the format we intend to use, so
;; let's return sample data formatted accordingly
;; for now (noting the capitalized client names is
;; part of the format we need to honour).
;;
;; Also, we've include some data that, while in the
;; proper format, is in error so we can test the
;; solutions's ability to deal with typical errant
;; data.
'( ( "DEFAULT"
("Layer1" 001 "Continuous")
("Layer2" 002 "Continuous")
("Layer3" 003 "Continuous")
)
( "INVALID"
("|*Ackk" 011 "Hidden") ;; invalid name
("Layer2" 999 "Hidden") ;; invalid color
("Layer3" 013 "Bogus!") ;; invalid linetype
)
( "CLIENT 1"
("Layer1" 011 "Center")
("Layer2" 012 "Center")
("Layer3" 013 "Center")
)
( "CLIENT 2"
("Layer1" 101 "Dashed")
("Layer2" 102 "Dashed")
("Layer3" 103 "Dashed")
)
)
)
(defun _LoadLinetypes ( activeDocument clientName / linefile result )
(_BreadCrumb "_LoadLinetypes [not done]")
;; At this point we don't know if we'll use custom
;; linetypes associated with a client (a frequent
;; norm) or not. Let's assume that's something we
;; need to incorporate (i.e. require the function to
;; take the client name as an argument, but ignore it
;; for now. In the interim let's have it attempt to
;; load the standard AutoCAD linetypes, returning the
;; load status to the caller.
(if
(setq linefile
(findfile
(if (zerop (getvar "measurement"))
"acad.lin"
"acadiso.lin"
)
)
)
(vl-catch-all-apply
'(lambda ( )
(vla-load
(vla-get-linetypes activeDocument)
"*"
linefile
)
;; we'll only get here on
;; a successfull load
(setq result t)
)
)
)
result
)
(defun _CleanClientLayerDefinition
( clientLayerData
lineTypeCollection
/
loadedLinetypes
)
(_BreadCrumb "_CleanClientLayerDefinition [done]")
;; Our intent is to ensure layer data is clean --
;; layernames pass a snvalid test, colors are in
;; the range 1 - 255, and linetypes are available
;; in the drawing. In the case of the latter two
;; properties invalid entries will be replaced with
;; default values of 7 and "Continuous" respectively.
;; In the case of an invalid layer name the entry
;; will be removed in it's entirety. As we go inform
;; the user of any problems so they might be able to
;; fix them.
;;
;; Recall the format of the data for a given client
;; is expected to be --
;;
;; ( ("Layer1" 001 "Continuous")
;; ("Layer2" 002 "Continuous")
;; ("Layer3" 003 "Continuous")
;; ...
;; )
;; Remove any entries that are not in the
;; proper format.
(setq clientLayerData
(vl-remove-if-not
'(lambda ( lst / result )
(if
(not
(setq result
(equal '(str int str)
(mapcar 'type lst)
)
)
)
(princ
(strcat
"Removing invalid entry: "
(vl-prin1-to-string lst)
" <incorrect format>.\n"
)
)
)
result
)
clientLayerData
)
)
;; Remove any entries with invalid layer names.
(setq clientLayerData
(vl-remove-if-not
'(lambda ( lst / result )
(if (setq result (snvalid (car lst)))
result
(progn
(princ
(strcat
"Removing invalid entry: "
(vl-prin1-to-string lst)
" <invalid name>.\n"
)
)
result
)
)
)
clientLayerData
)
)
;; Let's get all the linetypes loaded in
;; this document, force to uppercase.
(vlax-for lineTypeObject lineTypeCollection
(setq loadedLinetypes
(cons
(strcase (vla-get-name lineTypeObject))
loadedLinetypes
)
)
)
;; Now lets check the color and lintype
;; on the layer definitions that remain
;; and return to the caller.
(mapcar
'(lambda ( lst / name color linetype )
(mapcar 'set '(name color linetype) lst)
(if (null (< 0 color 256))
(progn
(princ
(strcat
"Invalid color in "
(vl-prin1-to-string lst)
" forcing value of 7.\n"
)
)
(setq color 7)
)
)
(if (null (member (strcase linetype) loadedLinetypes))
(progn
(princ
(strcat
"Invalid linetype in "
(vl-prin1-to-string lst)
" forcing value of \"Continuous\".\n"
)
)
(setq linetype "Continuous")
)
)
(list name color linetype)
)
clientLayerData
)
)
(defun _AddLayers
(
layersCollection
layerDefinitions
/
layerObject
name
color
linetype
)
(_BreadCrumb "_AddLayers [done]")
;; LayerDefinitions is expected to be valid data
;; (proper name, color and linetype) in the form --
;;
;; ( (LayerName Color Linetype)
;; (LayerName Color Linetype)
;; ...
;; )
;;
;; Example --
;;
;; ( ("Layer1" 001 "Continuous")
;; ("Layer2" 002 "Continuous")
;; ...
;; )
(foreach layerDefinition layerDefinitions
;; Pull out the individual properties.
(mapcar 'set
'(name color linetype)
layerDefinition
)
;; Get the existing layer if posible.
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ( )
(setq layerObject
(vla-item
layersCollection
name
)
)
)
)
)
;; Layer didn't exist, let's add it
;; to the layer collection.
(setq layerObject
(vla-add
layersCollection
name
)
)
)
;; Set the color and linetype. Remember, we've
;; cleaned the layerDefinition so there should
;; be no need to trap for invalid colors and
;; linetypes in this function -- it is expected
;; to be passed proper data.
(vla-put-color layerObject color)
(vla-put-linetype layerObject linetype)
)
)
(defun _Main
( activeDocument
/
clientName
layerDefinitions
clientLayerDefinitions
)
(_BreadCrumb "_Main [not done because of dependencies]")
;; This function wraps up all functionality
;; that defines the MakeLayers solution.
;; We don't know how _GetActiveClient determines the
;; active client's name, all we know is it returns said
;; data as a string (or nil).
(setq clientName (_GetActiveClient))
;; If an active client name was not found force the active
;; client name to "Default". This will indicate in-house
;; works.
(if (null clientName)
(setq clientName "Default")
)
;; We don't know how _GetLayerDefinitions gets the layer
;; definitions, all we know is that it returns data as a
;; list in the form --
;;
;; ( ( "CLIENTNAME"
;; ("LayerName" Color "LineType")
;; ("LayerName" Color "LineType")
;; ...
;; )
;; ( "CLIENTNAME"
;; ("LayerName" Color "LineType")
;; ("LayerName" Color "LineType")
;; ...
;; )
;; ...
;; )
;;
;; noting that the client name is always uppercase.
(setq layerDefinitions (_GetLayerDefinitions))
;; Get the layer definitions associated with the
;; client name.
(setq clientLayerDefinitions
(cdr
(assoc
(strcase clientName)
layerDefinitions
)
)
)
;; Proceded if we actually have layer definitions
;; for the active client.
(cond
( clientLayerDefinitions
;; Load up the linetypes.
(_LoadLinetypes activeDocument clientName)
;; Clean the client layer definitions (remember
;; to do this *after* the linetype have been loaded.
(setq clientLayerDefinitions
(_CleanClientLayerDefinition
clientLayerDefinitions
(vla-get-linetypes activeDocument)
)
)
;; It's possible no linetype remained after cleanup,
;; deal with that possibility.
(cond
( clientLayerDefinitions
(strcat
"Adding layers for client <"
clientName
">.\n"
)
(_AddLayers
(vla-get-layers activeDocument)
clientLayerDefinitions
)
)
( (strcat
"All entries for clinet <"
clientName
"> were invalid.\n"
)
)
)
)
;; No clients layer definitions but we did get a client
;; name, inform the user.
( clientName
(princ
(strcat
"No (clean) layer definitions found for client <"
clientName
">.\n"
)
)
)
;; Active client name could not be determined, inform
;; the user.
( t
(princ "Active client could not be determined.\n")
)
)
(princ)
)
;; Turn on debug mode by setting *debug* to any non
;; nil value, turn off debug mode by setting *debug*
;; to nil.
(setq *debug* t)
;; Call _Main passing the active document.
(_Main (vla-get-activedocument (vlax-get-acad-object)))
)
To see how the program deals with errant data edit the _GetActiveClient function and have it return "INVALID".
zzz
-
MP, Thanks for taking the time to make that. For someone who knows that guy "Jack Squat" about programming I actually understood what you were doing. Kinda. :-)
-
MP, Thanks for taking the time to make that. For someone who knows that guy "Jack Squat" about programming I actually understood what you were doing. Kinda. :-)
Michael
*ditto*
Thanks for the lesson, I can sure learn from it.
Gary
-
In your spare time :-D you could write a book. "Beginning programming for .... Mavericks" :-D
-
Yes.... He is the Maestro
I remember reading posts by MP, in my early days of lisping many moons ago, and got impress of how he did the coding (readable for everyone)... And continues.... :-)
-
Thanks Michael. I have downloaded the pdf, and will start to look at it shortly.
-
Michael you sure do good work and petty too. :-)
-
Thanks for the very kind and generous words folks!!
<hoping it doesn't turn out to be riddled with mistakes>
:lol:
Michael you sure do good work and petty too. :-)
Anal perhaps, but petty?
:lmao:
-
Thanks for asking this question jonesy, and in turn making me update my code. I am having to use it quite often today. Updating older consultant drawings to our current layer standards. Works well. Mostly the layer color is wrong.
-
Oh heck. Fat finger strike again. I owe you an R MP. 8-)
-
Still funny.
:)
-
And I'm smilin with you. :-)