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 (http://www.copyright.gov/help/faq/faq-general.html)

U.S. Copyright Office How Long Does Copyright Protection Last? (http://www.copyright.gov/help/faq/faq-duration.html#duration)

And here is the main FAQ page for further answers. (http://www.copyright.gov/help/faq/)

[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 (http://www.copyright.gov/help/faq/faq-general.html)

U.S. Copyright Office How Long Does Copyright Protection Last? (http://www.copyright.gov/help/faq/faq-duration.html#duration)

And here is the main FAQ page for further answers. (http://www.copyright.gov/help/faq/)
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

[kennet.sjoberg]

...I want the layers to be created with the same attributes...

(defun c:FLC ( / LayDxf FirstLay ) ;; FCF = Freeze Layer Copy
;;; Example: layer ABD123 will have a frozen copy with the name ABD123_freeze without any objects.
;;; Copyright is the right to copy to the right and to the left, at least my code ; )
(setq LayDxf (tblnext "LAYER" T ) )
(while LayDxf
(if (not FirstLay ) (setq FirstLay (strcat (cdr (assoc 2 LayDxf )) "_freeze" )) ( ) )
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord" )
(cons 100 "AcDbLayerTableRecord" )
(cons 2 (strcat (cdr (assoc 2 LayDxf )) "_freeze" ) ) ;; Name
(cons 70 1 ) ;; Freezed
(cons 62 (cdr (assoc 62 LayDxf )) ) ;; Color
(cons 6 (cdr (assoc 6 LayDxf )) ) ;; Linetype
)
)
(princ (strcat "\nLayer " (cdr (assoc 2 LayDxf )) "_freeze is created. " ) ) ;; message
(setq LayDxf (tblnext "LAYER" nil ) ) ;; set next layer
(if (= (cdr (assoc 2 LayDxf )) FirstLay ) (setq LayDxf nil ) ( ) ) ;; stop the infinite loop
)
(princ)
)

: ) Happy Computing !

kennet

[Opie]

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
Kennet,

You may want to Ask the BOD (http://forums.augi.com/forumdisplay.php?f=167) on this one and its stance regarding copyright and the code posted in these forums.

Copyright is an issue best left up to others more knowledgable on the subject than me.

Have a good one Kennet. And enjoy your weekend. ;)

[kennet.sjoberg]

...Copyright is an issue best left up to others more knowledgable on the subject...
Yes that was what I was trying to say earlier in this thread
I think this is a hard question for Mike.Perry and his fellows.

Well Richard, enjoy the weekend yourself :beer:

: ) Happy Computing !

kennet

[ccowgill]

This issue is more like what to do when you can not contact the author to receive permission to modify their code, as Mike stated, the right thing and polite thing for me to do is to contact the original author and ask him if it is ok, or if he can help me modify the code. There is a similar post in the forum in which someone else asked for help modifying the exact same code and received it without a fuss. As far as I see it, if you dont want your code modified, dont post it, because there are always ways to make things better, or to conform them to ones needs. And as always, if you should give credit where credit is due.