TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jonesy on October 10, 2006, 05:11:39 AM

Title: Teaching Tracey - Creating layers
Post 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
Title: Re: Teaching Tracey - Creating layers
Post by: Kerry on October 10, 2006, 05:43:48 AM
Tracey, Have you tried inserting your template drawing (exploded) into the target drawing ??


// kwb
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 06:10:30 AM
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.

Title: Re: Teaching Tracey - Creating layers
Post by: Kerry on October 10, 2006, 06:15:28 AM
OK, Try this ..
you'll just need to modify the Layer definitions ..
Code: [Select]
;; // 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 <
Title: Re: Teaching Tracey - Creating layers
Post by: Kerry on October 10, 2006, 06:16:51 AM
 ... each of these defines a layer ..
Code: [Select]
           (LIST "ST90"                                          ;LayerName
                 "CONTINUOUS"                                    ;LineType
                 "Outlines 0.90mm"                               ;Description
                 ACBLUE                                          ;Color
           )
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 07:18:12 AM
Thanks Kerry...

I'll look at that this afternoon
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 10, 2006, 09:36:24 AM
Hola Tracey;

This is what I use, super basic:

Code: [Select]
(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)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 09:50:40 AM
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
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 10, 2006, 10:01:35 AM
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?

:)
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 10, 2006, 10:02:31 AM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: jbuzbee on October 10, 2006, 10:02:50 AM
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:

Code: [Select]
(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
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 10:05:13 AM
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)
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 10, 2006, 10:11:00 AM
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.

Code: [Select]
(if (not (tblsearch "layer" "1")) ;; see if the layer name exist.
  (command "_.layer" "_m" "1" "_c" "1" "" "")) ;; is not there - make it.

Code: [Select]
(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
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 10, 2006, 10:29:00 AM
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.


:)
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 11:21:09 AM
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
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 10, 2006, 11:31:16 AM
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!

:)
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 10, 2006, 01:05:54 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 01:13:19 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 01:18:01 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: Krushert on October 10, 2006, 01:21:28 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 01:41:47 PM
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.
Code: [Select]
(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)
)
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 10, 2006, 02:17:49 PM
Nice job Tim, it worked in my short test just fine. :-)
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 02:20:49 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: pmvliet on October 10, 2006, 02:51:06 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: GDF on October 10, 2006, 02:57:17 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 03:06:47 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 04:13:30 PM
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.

Code: [Select]
(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)
)
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 10, 2006, 04:22:23 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 04:30:04 PM
Thanks, I'll do that.
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 10, 2006, 04:47:23 PM
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.

Code: [Select]
;; 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.
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 10, 2006, 05:00:15 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 10, 2006, 05:07:56 PM
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.

 :-)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 10, 2006, 05:17:41 PM
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
Title: Re: Teaching Tracey - Creating layers
Post by: sinc on October 10, 2006, 05:43:22 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: daron on October 10, 2006, 08:05:07 PM
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:
Code: [Select]
(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.
Title: Re: Teaching Tracey - Creating layers
Post by: John Kaul (Se7en) on October 10, 2006, 11:20:11 PM
Tracey,
Food for thought.

Pseudo code:
...
<snip>

CABs gets my vote for the most helpfull post in this thread.  Expand on this.
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 11, 2006, 02:24:50 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. 


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 :-)
Title: Re: Teaching Tracey - Creating layers
Post by: Kerry on October 11, 2006, 05:31:42 AM
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 :-)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 11, 2006, 05:55:13 AM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: Kerry on October 11, 2006, 06:03:22 AM
Sounds like a plan ! :-)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 11, 2006, 06:16:07 AM
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
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 11, 2006, 07:55:41 AM
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.  :-)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 11, 2006, 08:03:19 AM
Thanks CAB.

I'm on it now :-)
Title: Re: Teaching Tracey - Creating layers
Post by: sinc on October 11, 2006, 08:33:30 AM

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.
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 11, 2006, 10:21:03 AM
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:

Code: [Select]
(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
Title: Re: Teaching Tracey - Creating layers
Post by: Maverick® on October 11, 2006, 10:36:24 AM
  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.  :-)
Title: Re: Teaching Tracey - Creating layers
Post by: GDF on October 11, 2006, 10:38:02 AM
  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
Title: Re: Teaching Tracey - Creating layers
Post by: Maverick® on October 11, 2006, 10:40:25 AM
In your spare time  :-D you could write a book. "Beginning programming for .... Mavericks"   :-D
Title: Re: Teaching Tracey - Creating layers
Post by: LE on October 11, 2006, 10:41:37 AM
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....  :-)
Title: Re: Teaching Tracey - Creating layers
Post by: jonesy on October 11, 2006, 11:22:00 AM
Thanks Michael. I have downloaded the pdf, and will start to look at it shortly.
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 11, 2006, 11:30:19 AM
Michael you sure do good work and petty too. :-)
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 11, 2006, 11:52:35 AM
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:
Title: Re: Teaching Tracey - Creating layers
Post by: T.Willey on October 12, 2006, 04:05:12 PM
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.
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 12, 2006, 10:05:28 PM
Oh heck. Fat finger strike again. I owe you an R MP.  8-)
Title: Re: Teaching Tracey - Creating layers
Post by: MP on October 12, 2006, 10:29:11 PM
Still funny.

:)
Title: Re: Teaching Tracey - Creating layers
Post by: CAB on October 13, 2006, 07:31:37 AM
And I'm smilin with you. :-)