Modify La-Freeze.lsp

[ccowgill]

I have this routine that I got from the AUGI Exchange, I have sucessfully modified the lisp to allow me to pick the layer extension, the problem is:
When I use the lisp, I want the layers to be created with the same attributes (colors, line types) and then at the end to freeze them. My problem is, I have no Idea how to create new layers with the same attributes, and I have no Idea how to combine a string and a variable to do a search through layers and find all layers ending with the specified layer extension.
Here is the Lisp routine, any help would be greatly appreciated if you wish, please compare it with the original lisp routine on AUGI Exchange it might assist you in seeing what I have modified:

;;; Created by Karl Browning
 ;;; kbrowning@chasebrass.com
 ;;; 16 May 2003
 ;;;
 ;;; This function is used to select an object(s), figure out what layer it is on,
 ;;; make a new layer based on the old one with "-Freeze" appended, change the object
 ;;; to the new layer, then freeze layers *-Freeze. I made this to clean up some vendor
 ;;; prints without losing the data.
 ;;;
 ;;; Feel free to modify the lisp, just send me a copy of it when you are done.
 
 (defun c:la->freeze
 	   (/ sset counter item LayerName NewLayerName Layerext)
   (vl-load-com)
   (initerr) ;Load error trapping
   (setvar "cmdecho" 0)
   (command "undo" "m")
   (setq Layerext (strcase (getstring "\nEnter layername extension ")))
   (setq sset (ssget)) ;get selection set
   (setq counter 0) ;set the counter
   (repeat (sslength sset) ;count number of entities and loop
 	(setq item		(ssname sset counter) ;extract the entity name
 	  item		(vlax-ename->vla-object item)
  ;convert to a vl object
 	  LayerName (vla-get-layer item) ;get the object's layer
 	) ;_ end of setq
 	(if	(= (TBLSEARCH "Layer" (strcat LayerName Layerext)) nil)
  ;check for "layer"-Freeze
 	  (progn
 	(setq NewLayerName (strcat LayerName Layerext))
  ;if not there, create it
 	(command ".layer" "new" NewLayerName "")
 	  ) ;_ end of progn
 	  (setq NewLayerName (strcat LayerName Layerext))
 	) ;_ end of if
 	(vla-put-layer item NewLayerName)
 	(setq counter (1+ counter))
   ) ;_ end of repeat
   (princ)
   (command ".layer" "freeze" *Layerext "")
  ; (load "c:/Program Files/Autocad 2005/express/acetlayr.lsp")
  ; (command "layfrz" (entget (entlast)) "")
   (setq sset nil)
   (reset)
   (princ)
 ) ;_ end of defun
 
 
 (defun error ()
   (prompt "\nGlobal Error Trap Loaded")
   (princ)
 )
 
 ;;;*=================================================================================
 
 (defun initerr ()
   (setq	oldlayer (getvar "clayer")
 	oldsnap	 (getvar "osmode")
 	oldpick	 (getvar "pickbox")
 	temperr	 *error*
 	*error*	 trap
   )
   (princ)
 )
 
 ;;;*=================================================================================
 
 (defun trap (errmsg)
   (command nil nil nil)
   (if (not (member errmsg '("console break" "Function Cancelled"))
 	  )
 	(princ (strcat "\nError: " errmsg))
   )
   (command "undo" "b")
   (setvar "clayer" oldlayer)
   (setvar "menuecho" 0)
   (setvar "highlight" 1)
   (setvar "osmode" oldsnap)
   (setvar "pickbox" oldpick)
   (princ "\nError Resetting Environment ")
   (terpri)
   (setq *error* temperr)
   (princ)
 )
 
 ;;;*=================================================================================
 
 (defun reset ()
   (setq *error* temperr)
   (setvar "clayer" oldlayer)
   (setvar "menuecho" 0)
   (setvar "highlight" 1)
   (setvar "osmode" oldsnap)
   (setvar "pickbox" oldpick)
   (princ)
 )
 
 ;;;*=================================================================================
 
 (princ)

[Mike.Perry]

I have this routine that I got from the AUGI Exchange...

;;; Created by Karl Browning
  ;;; kbrowning@chasebrass.com

Hi

For starters have you tried contacting the author?

Would seem like the right, polite thing to do...

Have a good one, Mike

[ccowgill]

it says right in the coding, feel free to modify it, just send him a copy when I am done. but, I have contacted him, and am awaiting a reply.

[ccowgill]

I recieved a reply, his email address is no longer valid (I would guess he no longer works there), any suggestions?

[kennet.sjoberg]

From a parallel tread "Do we have to clean everything out and close this shop now ?"

Well, as long as I can understand when reading from the copyright info,
ALL WORKING CODE in this forum is under copyright protection.
In other words a "copyright note" in the code is unnecessary if a registration is not done,
and a lawsuit is only possible if a "Copyright Registration" is made.

Nobody has the right to change in my code, except my self. Please correct me if I am wrong.

Do we (not the rest of the world ) have to clean everything out and close this shop now ?

I think this is a hard question for Mike.Perry and his fellows.


: ) Happy Computing !

Copyright links by richardl.25628 :

Copyright in General

U.S. Copyright Office How Long Does Copyright Protection Last?

And here is the main FAQ page for further answers.

[Opie]

From a parallel tread "Do we have to clean everything out and close this shop now ?"

Well, as long as I can understand when reading from the copyright info,
ALL WORKING CODE in this forum is under copyright protection.
In other words a "copyright note" in the code is unnecessary if a registration is not done,
and a lawsuit is only possible if a "Copyright Registration" is made.

Nobody has the right to change in my code, except my self. Please correct me if I am wrong.

Do we (not the rest of the world ) have to clean everything out and close this shop now ?

I think this is a hard question for Mike.Perry and his fellows.


: ) Happy Computing !

Copyright links by richardl.25628 :

Copyright in General

U.S. Copyright Office How Long Does Copyright Protection Last?

And here is the main FAQ page for further answers.

Kennet, I guess so, if that is how you want your code to be handled. Are you not wanting anyone to use your code to help them either 1) learn how to code, or 2) adjust your code to their needs? If the answer to this is No, then why are you posting your code? If you are planning on bringing a lawsuit to anyone that is using your code to accomplish a specific task, then don't post your code. Noone is forcing you to reveal your knowledge.

This is a good question. If you are that concerned with copyright, then post what your wishes are in your code and state that changes to your code are restricted without permission from you.

These comments are my own and not the views of others that I am associated with.

Richard Lawrence

[kennet.sjoberg]

First of all, it is NOT about my code.

No I am not happy with a very strict copyright policy in this thread, it do stop the creativity.

if I upload a code to this forum, my mention is to share it.
if I change any others code, I do it to help and improve.
if I write a copyright note in my code and not register it, I am stupid.
if I write a copyright note in my code and register it, you will never see the code.
If you see a copyright note in a code here, it is probably not registered.
if I change any others code, let the copyright note (if exist) unchanged, add my revision comments and my identification, the author (if exist) do have the opportunity to sue ME if possible. ( not AUGI ).

I want to continue running creative.

: ) Happy Computing !

kennet

[fixo]

I have this routine that I got from the AUGI Exchange, I have sucessfully modified the lisp to allow me to pick the layer extension, the problem is:
When I use the lisp, I want the layers to be created with the same attributes (colors, line types) and then at the end to freeze them. My problem is, I have no Idea how to create new layers with the same attributes, and I have no Idea how to combine a string and a variable to do a search through layers and find all layers ending with the specified layer extension.
Here is the Lisp routine, any help would be greatly appreciated if you wish, please compare it with the original lisp routine on AUGI Exchange it might assist you in seeing what I have modified:

Hi ccowgill

I am again do not understand what you exactly need
maybe you will be try this one

This lisp make a bunch of new layers based on the old names
with apppended prefix on the end of layer name,
with the same attributes as the old layer, then freeze it,
but not delete old one
No warranty
Use it with care do not run this twice

Thank you

Fatty

(defun C:lmg  (/ *error* acapp aclrs adoc clyr lyr-error info_list last_lyr lyr-error lyr_info lyr_list	new_names
	       olderror	pfx)
  (vl-load-com)

  (defun lyr-error  (msg)
    (if
      (vl-position
	msg
	'("console break"
	  "Function cancelled"
	  "quit / exit abort"
	  )
	)
       (princ "Error!")
       (princ msg)
       )
    (vla-endundomark adoc)
    (setq *error* olderror)
    (princ)
    )

  (or acapp
      (setq acapp (vlax-get-acad-object)
	    )
      )

  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       acapp
	       )
	    )
      )
  (or aclrs
      (setq aclrs
	     (vla-get-layers
	       adoc
	       )
	    )
      )
;;;  (setq lyr_list nil info_list nil);for debug only

  (vla-endundomark adoc)
  (vla-startundomark adoc)
  (setq	olderror *error*
	*error*	 lyr-error)


  (vlax-for a  aclrs
    (if	(not (wcmatch (vla-get-name a) "0,Defpoints"))
      (progn
	(setq lyr_info
	       (mapcar (function (lambda (x) (vlax-get a x)))
		       '("Color" "Linetype" "Lineweight")))
	(setq info_list (cons lyr_info info_list))
	(setq lyr_list (cons (vla-get-name a) lyr_list)))))
  (setq	lyr_list  (reverse lyr_list)
	info_list (reverse info_list))
  (setq	pfx (strcase
	      (getstring "\nType layer name prefix (i.e.: _vent) : \n")))
  (setq	new_names (mapcar (function (lambda (x) (strcat x pfx))) lyr_list)
	last_lyr  (last new_names))
  (repeat (length new_names)
    (vla-add aclrs (car new_names))
    (setq clyr (vla-item aclrs (car new_names)))
    (mapcar (function
	      (lambda (x y)
		(progn
		  (vlax-put clyr x y)
		  (if (and (not (eq (vlax-get clyr 'Freeze) :vlax-true))
			   (not (eq (vlax-get clyr 'Name) last_lyr)))
		    (vlax-put clyr 'Freeze :vlax-true)
		    (vlax-put clyr 'Freeze :vlax-false)))))
	    '("Color" "Linetype" "Lineweight")
	    (car info_list))
    (setq new_names (cdr new_names)
	  info_list (cdr info_list)))
  (vla-regen adoc acallviewports)
  (setq	*error*	olderror
	lyr-error nil)
  (vla-endundomark adoc)
  (princ)
  )

			
;;;								;;
(prompt "\n	***	Enter LMG to execute	*** \n")
;;;								;;

[Opie]

First of all, it is NOT about my code.

No I am not happy with a very strict copyright policy in this thread, it do stop the creativity.

if I upload a code to this forum, my mention is to share it.
if I change any others code, I do it to help and improve.
if I write a copyright note in my code and not register it, I am stupid.
if I write a copyright note in my code and register it, you will never see the code.
If you see a copyright note in a code here, it is probably not registered.
if I change any others code, let the copyright note (if exist) unchanged, add my revision comments and my identification, the author (if exist) do have the opportunity to sue ME if possible. ( not AUGI ).

I want to continue running creative.

: ) Happy Computing !

kennet

There is not a copyright notice in the original code posted. The comments allowed modifications to the code. The restriction was to send a copy of the modifications to the original author.

Feel free to modify the lisp, just send me a copy of it when you are done.

[kennet.sjoberg]

....The restriction was to ...

Well you are looking at the mosquito.
The problem is how to treat ALL WORKING CODE in this tread,
no mutter if there is a copyright note or not.
They are all equals, and should be treated equals.

: ) Happy Computing !

kennet