Go Back   Cadalyst Discussion Forums > Forums > Hot Tip Harry: AutoCAD Customization
FAQ Members List Social Groups Calendar Search Today's Posts Mark Forums Read

Notices

Hot Tip Harry: AutoCAD Customization Cadalyst's popular Hot Tip Harry and his entourage are here to assist you with AutoCAD customization. Request help with a programming problem, locate a needed routine, or just keep up with Harry's latest activities. You'll find Harry's archive of AutoLISP and VBA code and hatch patterns at www.cadalyst.com/cadtips. Moderated by R.K. McSwain.

 
 
Thread Tools Display Modes
  #1  
Old 03-11-2008, 02:04 PM
Randall13 Randall13 is offline
Junior Member
 
Join Date: Mar 2008
Posts: 4
Default Lisps and Layers

I need some help here; I have a lisp routine (To_Demo.lsp) that my company has been using for years. It changes mutable objects from its current layer to the corresponding demo layer.

For Example: C-BLDG-NEW would change to C-BLDG-DEMO.

C-BLDG-NEW Footprints Of New Buildings To Be Added
C-BLDG-EXST Footprints Of Existing Buildings To Remain
C-BLDG-DEMO Footprints Of Existing Buildings To Be Demolished

It works fine, however the problem is the routine uses the layer table and this changes the line type to “Bylayer”. There are times I need to change the line type to hidden. And then after running the routine, I have to go back and change them back from bylayer.

Any help with this would be very appreciated.

---------------------------------------------------------------------
;;TO_DEMO.LSP - Changes picked objects to the corresponding "Demo" Layer.
(DEFUN QL0(Q&0)

(IF(/= Q&0"Function cancelled")
(PRINC(STRCAT"\nError: "Q&0)
)
)

(IF SELECT(SETQ SELECT NIL)
)


(IF Q10(SETVAR"clayer"Q10)
)

(IF Q#0(SETQ *ERROR* Q#0)
)
(PRINC))

(DEFUN C:TO_DEMO(/ CLTYPE SELECT QOQ Q0Q Q$Q ENAME Q32 Q|Q Q%Q Q?L QJL Q@L QQL QLL)
(SETQ Q#0 *ERROR* Q00 QL0)(SETVAR"cmdecho"0)(SETQ Q10(GETVAR"clayer")
)
(SETQ SELECT(SSGET)
)

(IF SELECT(PROGN(SETQ Q0Q(SSLENGTH SELECT)Q$Q 0 QOQ 1)

(REPEAT Q0Q(SETQ ENAME(SSNAME SELECT Q$Q)Q|Q(ENTGET ENAME)Q%Q(CDR(ASSOC 62 Q|Q)
)

Q?L(CDR(ASSOC 6 Q|Q))

QJL(CDR(ASSOC 8 Q|Q))

Q@L(TBLSEARCH"layer"QJL)QQL(CDR(ASSOC 62 Q@L))

QLL(CDR(ASSOC 6 Q@L)))(IF(/=(WCMATCH QJL"*_demo")T)

(PROGN(SETQ Q%(STRLEN QJL))
(SETQ Q?J NIL)(WHILE(/= Q?J"_")
(SETQ Q?J(SUBSTR QJL Q% 1))
(SETQ Q%(- Q% 1))(IF(= Q% 0)

(PROGN(SETQ QJL(STRCAT"wrong-"QJL))
(SETQ Q?J"_"Q%(STRLEN QJL)
) ;;; End
)
)
(SETQ CLTYPE(GETVAR "CELTYPE")))

(SETQ QJL(SUBSTR QJL 1 Q%))
(SETQ Q%Q 256)
(setq Q?L "BYLAYER")
(SETQ Q|Q(SUBST(CONS 8(STRCAT QJL"_demo"))

(ASSOC 8 Q|Q)Q|Q)Q|Q(APPEND Q|Q(LIST(CONS 62 Q%Q)
(CONS 6 Q?L)
)
)
)

(SETQ QL@(STRCASE(CDR(ASSOC 8 Q|Q))T))

(IF(=(TBLSEARCH"layer"QL@)NIL)(Q&@))
(IF(= Q1@ 1)(COMMAND"layer""m"QO@"c"QJQ QO@"l"Q@Q QO@""))

(SETQ Q1@ NIL)(ENTMOD Q|Q)))

(SETQ QOQ(1+ QOQ))
(SETQ Q$Q(1+ Q$Q)))
(SETQ SELECT NIL))(PROMPT"\007\n\nNothing in selection set. "))

(SETVAR"clayer"Q10)(SETQ *ERROR* Q#0)

(PRINC)

) ;;; End of Lisp
Attached Files
File Type: txt 2_DEMO.txt (2.1 KB, 10 views)
  #2  
Old 03-11-2008, 06:47 PM
Harry_Is_Alive's Avatar
Harry_Is_Alive Harry_Is_Alive is offline
Guest
 
Join Date: Jan 2006
Location: Silicon Cornfields, OH
Posts: 277
Default

Toss that old trash out.. here is a new way to do it. The code you provided is encrypted (kind of) with funny variable names that are meaningless. It is quite old.

This version uses Visual LISP. Copy-clip the source into a LSP file, load into AutoCAD and type DemoLayer at the command line. It will prompt you to select objects to be changed.

This version only duplicates the properties of the layer table. Individual entity overrides will still remain.

Hot Tip Harry (Bill Kramer)

Code:
;;DemoLayer.LSP - Changes picked objects to layer with _DEMO suffix.
;;Bill Kramer 2008
;;
;; Visual LISP Example utility to change objects selected. This example
;; changes the layer name of the selected objects (appends "_DEMO") and
;; duplicates the layer definition if needed for the new layer.
;;
(vl-load-com)
(defun C:DemoLayer ( / SS CNT LYR vEN EN LyrNew LyrTab oLayers)
  (prompt "\nChange selected objects layer by appending _DEMO to name.")
  (setq SS (ssget))
  (if (and SS (> (sslength SS) 0))
    (progn
      (setq oLayers ;;get layer table link
	     (vla-get-layers
	       (vla-get-activedocument
		 (vlax-get-acad-object))))
      ;;
      ;;Got the objects, now stream through them
      (repeat (setq CNT (sslength SS))
	;;
	(setq En (ssname SS (setq CNT (1- CNT))) ;;Entity name from set
	      vEN (vlax-ename->vla-object En) ;;entity object reference
	      LYR (vla-get-layer vEN);;get the layer name
	      )
	;;check to see if _DEMO already there
	(if (not (wcmatch LYR "*_DEMO")) ;;layer name already _DEMO type?
	  (progn
	    ;;
	    ;; No, first check to see if the layer with _DEMO already exists
	    ;;
	    (if (not (tblsearch "LAYER" (strcat LYR "_DEMO")))
	      (progn ;;add the new layer
	        (setq LyrNew (vla-add oLayers (strcat LYR "_DEMO"))
		      LyrTab (vla-item oLayers LYR)
		      )
		;; Clone the properties
		(vla-put-linetype LyrNew (vla-get-linetype LyrTab))
		(vla-put-truecolor LyrNew (vla-get-truecolor LyrTab))
		(vla-put-freeze LyrNew (vla-get-freeze LyrTab))
		(vla-put-layeron LyrNew (vla-get-layeron LyrTab))
		(vla-put-lineweight LyrNew (vla-get-lineweight LyrTab))
		(vla-put-lock LyrNew (vla-get-lock LyrTab))
		(vla-put-material LyrNew (vla-get-material LyrTab))
		;(vla-put-plotstylename LyrNew (vla-get-plotstylename LyrTab))
		)) ;;end layer add
	    ;;
	    ;; Update the layer name of the object
	    (vla-put-layer vEN (strcat LYR "_DEMO"))
	    )) ;;end if _DEMO already there
	) ;;end REPEAT
      )) ;;end SS test
  (princ)
  )
;; Keep on programmin
  #3  
Old 03-12-2008, 08:07 AM
alanjt's Avatar
alanjt alanjt is offline
Senior Member
 
Join Date: Nov 2007
Posts: 307
Default

nice coding HTH

i'm wondering, could this be modified to move the selected objects to a newly created layer as this one does, but instead of adding a suffix, remove a string of text at the beginning of the layer and replace with a new prefix?

ie: select objects on the "S-CONC" layer, move all selected objects to a newly created layer called "S2-CONC"?
  #4  
Old 03-12-2008, 09:54 AM
Harry_Is_Alive's Avatar
Harry_Is_Alive Harry_Is_Alive is offline
Guest
 
Join Date: Jan 2006
Location: Silicon Cornfields, OH
Posts: 277
Default

Of course it can be modified for various string comparisons and pattern matching. In fact one could get quite carried away with such things.

Perhaps the simplest modification is to take out the "_DEMO" stuff replacing it with a variable setq'd by the operator. You could start by picking an entity, get the layer, ask the user for a new layer name to use, then build a selection set using the layer name in a filter. This would remove the need for the WCMATCH test looking for the pattern "*_DEMO" and poof - a bit more generic.

Keep on programmin'
  #5  
Old 03-12-2008, 12:34 PM
clntnco clntnco is offline
Junior Member
 
Join Date: Oct 2007
Posts: 17
Default layer linetype

You could take a shortcut and just change the layer linetype to hidden (or what ever type is required) and keep the object linetype bylayer. This way you don't have to keep changing the linetype prop. It also makes it easier to know if the object is on the right layer just by looking at it.

Last edited by clntnco; 03-12-2008 at 12:36 PM.
  #6  
Old 03-13-2008, 07:17 AM
Randall13 Randall13 is offline
Junior Member
 
Join Date: Mar 2008
Posts: 4
Default

Harry,

Thank you your time and code, however this is not the end result I am need. In steed of renaming the current layer or just adding the _demo to the end of the current layer, I need to change the layer, see the layers are pre-load and existing. Let me see if I can walk you through what happens in the "old" code.

There are many layers, however I will list only 4....

h-equipa_new
h-equipa_exst
h-equipa_demo
h-equipa_futr

These layers exist in the drawing and have specific properties, lets say there is an object on every layer. I would run the lisp and be able to choose all of the objects and they would all change to the corresponding demo layer.

h-duct_ret_new would change to h-duct_ret_demo
h-text_duct_exst would change to h-text_duct_demo

Again the old code does this and works fine, however if any object has a different line type other than bylayer, it set it to bylayer and I would like it to stay "as is".

Is this something you can help me?

Again thank you for your time!!!!
  #7  
Old 03-13-2008, 08:06 AM
alanjt's Avatar
alanjt alanjt is offline
Senior Member
 
Join Date: Nov 2007
Posts: 307
Default

so really, what you need is to rename all your layers.
everything that's on h-equipa_new would just need to be on a layer called h-equipa_demo.

you could open "rename", type in "*_exst" (old name) and then type "*_demo" (rename to).
if you only have a few (ie: exst, futr, new) this would only take a minute - no lisp required.

Last edited by alanjt; 03-13-2008 at 08:08 AM.
  #8  
Old 03-13-2008, 09:04 AM
Randall13 Randall13 is offline
Junior Member
 
Join Date: Mar 2008
Posts: 4
Default

Sorry if my post is confusing, I am not just renaming the layer. I am choosing 1- to 100 objects from a drawing of over 1,000 objects and changing them from the currant layer to a corresponding _demo layer. If you load the to_demo.lsp from above and create the layers below in Autocad. Draw an object on each layer, if you run the lisp you will see how it works. Then change the line type from bylayer, run the lisp again, notice that it change the line type back to bylayer. this is what I would like to fix, I would like the line type to stay "as is"

h-equipa_new --- color red
h-equipa_exst ---- color blue
h-equipa_demo ---- color gree
h-equipa_futr ---- color white/black

Thank you again.
  #9  
Old 03-13-2008, 12:30 PM
Harry_Is_Alive's Avatar
Harry_Is_Alive Harry_Is_Alive is offline
Guest
 
Join Date: Jan 2006
Location: Silicon Cornfields, OH
Posts: 277
Smile A second shot

Actually, what has been requested is not hard to program. Here is another variation for you all to learn from and experiment with. (AlanJT note the use of a suffix or a prefix or both!).

Code:
;;DemoLayer.LSP - Changes picked objects to a new layer
;;Bill Kramer 2008
;;
;; Demonstration of how object layers can be manipulated.
;; Also demonstrates string parsing, destruction, and reconstruction
;; tricks available in Visual LISP.
;;
(vl-load-com)
(defun C:DemoLayer ( / SS CNT LYR SLYR vEN EN LyrNew LyrTab oLayers tChr nSuf nPre)
  (prompt "\nChange selected objects layer by changing the suffix.")
  ;;
  (setq tChr "_") ;;<<-- variable delimiter
  (setq nSuf "DEMO") ;;<<--- your new suffix
  (setq nPre "") ;;<<--- your new prefix
  ;;
  (setq SS (ssget))
  (if (and SS (> (sslength SS) 0))
    (progn
      (setq oLayers ;;get layer table link
	     (vla-get-layers
	       (vla-get-activedocument
		 (vlax-get-acad-object))))
      ;;
      ;;Got the objects, now stream through them
      (repeat (setq CNT (sslength SS))
	;;
	(setq En (ssname SS (setq CNT (1- CNT))) ;;Entity name from set
	      vEN (vlax-ename->vla-object En) ;;entity object reference
	      LYR (vla-get-layer vEN);;get the layer name
	      sLYR LYR
	      )
	;;
	;;check to see if already changed
	;;
	(if (not (wcmatch LYR (strcat nPre "*" nSuf)))
	  (progn
	    ;;
	    ;; LYR does not match the pattern test
	    ;;
	    ;; Change the prefix only if nPRE is not empty and the
	    ;; delimeter can be found in the source layer name.
	    ;;
	    (if (/= nPRE "") ;;change the prefix?
	      (progn
		(if (wcmatch LYR (strcat "*" tChr "*")) ;;find the delim?
		    (setq LYR (vl-string->list LYR) ;;change to list
			  LYR (member (ascii tChr) LYR) ;;trim to delim
			  LYR (vl-list->string LYR)) ;;back to string
		  )
		(setq LYR (strcat nPRE LYR)) ;;add new prefix
		)) ;;end IF nPRE progn
	    ;;
	    (if (/= nSUF "") ;;change the suffix?
	      (progn
		(if (wcmatch LYR (strcat "*" tChr "*")) ;;find the delim okay?
		    (setq LYR (vl-string->list LYR) ;;convert LYR name to list of ASCIIs
			  LYR (reverse LYR)         ;;flip it around
			  LYR (member (ascii tChr) LYR) ;;trim to delim
		          LYR (reverse LYR) ;;flip it back to forward
			  LYR (vl-list->string LYR)) ;;back to string
		    )
		(setq LYR (strcat LYR nSUF))
		)) ;;end IF nSUF progn
	    ;;
	    ;; Check to see if the new layer exists
	    ;;
	    (if (not (tblsearch "LAYER" LYR))
	      (progn ;;add the new layer
	        (setq LyrNew (vla-add oLayers LYR)
		      LyrTab (vla-item oLayers sLYR)
		      )
		;; Clone the properties
		(vla-put-linetype LyrNew (vla-get-linetype LyrTab))
		(vla-put-truecolor LyrNew (vla-get-truecolor LyrTab))
		(vla-put-freeze LyrNew (vla-get-freeze LyrTab))
		(vla-put-layeron LyrNew (vla-get-layeron LyrTab))
		(vla-put-lineweight LyrNew (vla-get-lineweight LyrTab))
		(vla-put-lock LyrNew (vla-get-lock LyrTab))
		(vla-put-material LyrNew (vla-get-material LyrTab))
		;(vla-put-plotstylename LyrNew (vla-get-plotstylename LyrTab))
		)) ;;end layer add
	    ;;
	    ;; Update the layer name of the object
	    (vla-put-layer vEN LYR)
	    )) ;;end if _DEMO already there
	) ;;end REPEAT
      )) ;;end SS test
  (princ)
  )
;; Keep on programmin

More examples can be found at my website: www.autocode.com/lisp/autolisp.html

Hot Tip Harry (Bill Kramer)
  #10  
Old 03-13-2008, 02:10 PM
Randall13 Randall13 is offline
Junior Member
 
Join Date: Mar 2008
Posts: 4
Default

Harry,

Works great and thank alot!

Randall
 

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -6. The time now is 05:55 AM.





Powered by vBulletin® Version 3.8.4
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.