Author Topic: Teaching Tracey - Creating layers  (Read 14824 times)

0 Members and 1 Guest are viewing this topic.

MP

  • Seagull
  • Posts: 17423
Re: Teaching Tracey - Creating layers
« Reply #15 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!

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Re: Teaching Tracey - Creating layers
« Reply #16 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
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jonesy

  • SuperMod
  • Seagull
  • Posts: 15502
Re: Teaching Tracey - Creating layers
« Reply #17 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
Thanks for explaining the word "many" to me, it means a lot.

jonesy

  • SuperMod
  • Seagull
  • Posts: 15502
Re: Teaching Tracey - Creating layers
« Reply #18 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
Thanks for explaining the word "many" to me, it means a lot.

Krushert

  • Seagull
  • Posts: 13573
  • FREE BEER Tomorrow!!
Re: Teaching Tracey - Creating layers
« Reply #19 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.
I + XI = X is true ...
... if you change your perspective.

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Teaching Tracey - Creating layers
« Reply #20 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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Re: Teaching Tracey - Creating layers
« Reply #21 on: October 10, 2006, 02:17:49 PM »
Nice job Tim, it worked in my short test just fine. :-)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Teaching Tracey - Creating layers
« Reply #22 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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

pmvliet

  • Guest
Re: Teaching Tracey - Creating layers
« Reply #23 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

for what it's worth, I just loaded his latest and I'm getting error's.  :|



Pieter

GDF

  • Water Moccasin
  • Posts: 1991
Re: Teaching Tracey - Creating layers
« Reply #24 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
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Teaching Tracey - Creating layers
« Reply #25 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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Teaching Tracey - Creating layers
« Reply #26 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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Re: Teaching Tracey - Creating layers
« Reply #27 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.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jonesy

  • SuperMod
  • Seagull
  • Posts: 15502
Re: Teaching Tracey - Creating layers
« Reply #28 on: October 10, 2006, 04:30:04 PM »
Thanks, I'll do that.
Thanks for explaining the word "many" to me, it means a lot.

LE

  • Guest
Re: Teaching Tracey - Creating layers
« Reply #29 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.