TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: diarmuid on November 23, 2012, 08:58:02 AM

Title: Apply layer properties directly to objects
Post by: diarmuid on November 23, 2012, 08:58:02 AM
ok, this is going to sound daft. but here me out.  i am under a contractual obligation to provide a set of CAD files in a particualr client CAD standard.  Which is over 25 years old and is older than half of the CAD users working for me at the moment.  This standard uses 9 layers, for every thing.  yes 9. not 90, but 9 and 9 only.

I have set of services drawings that, accirding to this Fu_ked up standard can only go on 3 layers.  i have over 40 different types of servcies across about 20 drawings.  So, i will have to merge them down to 3 layers. (we were not allowed to use xrefs on this project, stoneage stuff i know)

is there a way that i can take an individual layers properties, and apply them directly to the lines contained on that layer?

So layer "foul_drain" has all lines etc as bylayer.  The layer itself has a dashdot linetype and color cyan.  can i quickly apply the layer settings directyl to the entities.  so that when i merge them i at least retain the color and linetype format.

Your help would be greatly appreciated in this.

Regards

Diarmuid
Title: Re: Apply layer properties directly to objects
Post by: Lee Mac on November 23, 2012, 09:11:05 AM
Very quickly written & untested:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:maplayprop ( / ass def ent inc lay lst prp sel )
  2.     (if (setq sel (ssget "_:L"))
  3.         (repeat (setq inc (sslength sel))
  4.             (setq ent (entget (ssname sel (setq inc (1- inc))))
  5.                   lay (cdr (assoc 8 ent))
  6.             )
  7.             (if (setq prp (cdr (assoc lay lst)))
  8.                 (_substpairs prp ent)
  9.                 (progn
  10.                     (setq def (entget (tblobjname "LAYER" lay))
  11.                           prp nil
  12.                     )
  13.                     (foreach dxf '(6 62 370)
  14.                         (if (setq ass (assoc dxf def))
  15.                             (setq prp (cons ass prp))
  16.                         )
  17.                     )
  18.                     (setq lst (cons (cons lay prp) lst))
  19.                     (_substpairs prp ent)
  20.                 )
  21.             )
  22.         )
  23.     )
  24.     (princ)
  25. )
  26.  
  27. (defun _substpairs ( pairs elst / item )
  28.     (foreach pair pairs
  29.         (if (setq item (assoc (car pair) elst))
  30.             (setq elst (subst pair item elst))
  31.             (setq elst (append elst (list pair)))
  32.         )
  33.     )
  34.     (entmod elst)
  35. )
Title: Re: Apply layer properties directly to objects
Post by: irneb on November 23, 2012, 11:46:33 AM
I thought this sounded familiar: http://forums.augi.com/showthread.php?114899-Converting-Layers-without-changing-color-line-Types-etc&p=1047485&viewfull=1#post1047485
Title: Re: Apply layer properties directly to objects
Post by: diarmuid on November 28, 2012, 04:57:24 AM
Perfect, that is exactly what i need.  Thanks a mil guys!

Regards

Diarmuid
Title: Re: Apply layer properties directly to objects
Post by: Lee Mac on November 28, 2012, 07:14:59 AM
You're welcome Diarmuid  :-)