TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: litss on January 07, 2011, 01:29:16 AM
-
Company's requirement: New drawings take the new rule of layer settings. While too many sample works were done according to the old standard, too many habits are not that easy to be changed ....
Can we just put these two layer systems together in a drawing while working, and then, combine them through lisp before delivery?
Like, I have the old layer name list :(OL1 OL2 OL3 OL4...) and the new name list:(NL1 NL2 NL3 NL4...).
Can I move all the stuff (including stuff in blocks) of OL1/OL2... to the NL1 NL2..., and remove all the old layers from the drawing.
That is OL1&NL1==>NL1, OL2&NL2==>NL2,...
Many thanks!
-
You could use Layer Translate, where you can create a layer translation set. You can save that set for later use.
-
LayTrans is miles better, but I'm happily re-inventing the wheel :-)
(defun LayerTrans ( layerlist / _lst->str doc blocks layers locked ss ) (vl-load-com)
;; Example by Lee Mac 2011 - www.lee-mac.com
;; LayerList should be in the form:
;; '(
;; ( "OldLayer1" . "NewLayer1" )
;; ( "OldLayer2" . "NewLayer2" )
;; ( "OldLayer3" . "NewLayer3" )
;; ...
;; ( "OldLayerN" . "NewLayerN" )
;; )
;; Layers are case-sensitive
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
blocks (vla-get-Blocks doc)
layers (vla-get-Layers doc)
)
(defun _lst->str ( lst del )
(if (cdr lst)
(strcat (car lst) del (_lst->str (cdr lst) del))
(car lst)
)
)
(vla-StartUndoMark doc)
(mapcar
(function
(lambda ( item ) (vla-Add layers (cdr item)))
)
layerlist
)
(vlax-for layer layers
(if (eq :vlax-true (vla-get-lock layer))
(vla-put-lock (car (setq locked (cons layer locked))) :vlax-false)
)
)
(vlax-for block blocks
(vlax-for obj block
(if (setq layer (cdr (assoc (vla-get-layer obj) layerlist)))
(vla-put-layer obj layer)
)
)
)
(if (ssget "_X" (list (cons 8 (_lst->str (mapcar 'car layerlist) ","))))
(progn
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
(if (setq layer (cdr (assoc (vla-get-layer obj) layerlist)))
(vla-put-layer obj layer)
)
)
(vla-delete ss)
)
)
(foreach layer locked (vla-put-lock layer :vlax-true))
(vl-cmdf "_.-purge" "_LA" (_lst->str (mapcar 'car layerlist) ",") "_N") ;; Thanks CAB!
(vla-regen doc acAllViewports)
(vla-EndUndoMark doc)
(princ)
)
(LayerTrans '(("OL1" . "NL1") ("OL2" . "NL2")))
Lee
-
Here is on OLD one 8-)
http://www.theswamp.org/index.php?topic=4699.msg59371#msg59371
-
another thing you could do is assign a cad standard to your template drawing and from there on out, it will let users know when their layers dont meet standards. I like Lee's idea, it looks like it would work much better (and be more user friendly) than the built in layer translator.
-
I like Lee's idea, it looks like it would work much better (and be more user friendly) than the built in layer translator.
That's mighty kind of you Chris :-)
-
Old thread with example using LayMrg: http://www.cadtutor.net/forum/showthread.php?43156-Too-many-layers
It's not the best example, since my head wasn't screwed on right that day and I didn't use a dotted pair set of lists.
Also, Lee, I wouldn't just blindly run purge on all layers, what if the user had several layers - from template - that they didn't want removed. Seems you'd be better off just deleting specific ones from the layer collection - another reason why LayMrg is a nice way to cheat.
-
Also, Lee, I wouldn't just blindly run purge on all layers, what if the user had several layers - from template - that they didn't want removed. Seems you'd be better off just deleting specific ones from the layer collection - another reason why LayMrg is a nice way to cheat.
Good point, I did take the lazy-man's route on that one :lol:
-
the only problem with layer trans and merge is you have to do everything individually, I was just thinking that Lee's routine would be much quicker, because it automates everything. of course that is assuming that you are translating from one standard to another, and not from a bunch of random layer names to a standard name list.
-
Also, Lee, I wouldn't just blindly run purge on all layers, what if the user had several layers - from template - that they didn't want removed. Seems you'd be better off just deleting specific ones from the layer collection - another reason why LayMrg is a nice way to cheat.
Good point, I did take the lazy-man's route on that one :lol:
(vl-cmdf "_.-purge" "LA" (_lst->str (mapcar 'car layerlist) ",") "_N")
:roll:
-
Also, Lee, I wouldn't just blindly run purge on all layers, what if the user had several layers - from template - that they didn't want removed. Seems you'd be better off just deleting specific ones from the layer collection - another reason why LayMrg is a nice way to cheat.
Good point, I did take the lazy-man's route on that one :lol:
(vl-cmdf "_.-purge" "LA" (_lst->str (mapcar 'car layerlist) ",") "_N")
:roll:
Now why didn't think of that! Thanks Alan! Code updated :-)
-
Too busy these days, almost forgot my post.
Many thanks to all you guys! Especially Lee. Nice routine. I will try it soon. I guess my boss might give me a smile.
To Chris:
Actually, we do have a template (New or Old) for each drawing. What I asked was not a tool for the beginner or for the long-term future. It is just some compensation for this special period. I am now trying to get used to the new rule. It need some time :)
-
You're welcome litss, happy to help out - let me know how you get on :-)
-
Lee: I've tried your routine, it works perfectly for me. And, I wrote some pre-works to cooperate with yours. See the code below.
1) run the "Layers";
2) run the "editlst";
3) run the "cblayers";
It's quite dirty, coz I am not quite good at coding:(
;=================================================================================
;;;;Function: Generate two lists of existing layernames for edit
;;;;Thanks to Hasan M. Asous's great routine
;;;;I've made some revision according to my need
;;;;Edit by litss 2011-01-12
;=================================================================================
;;-------------------=={ Layers List }==----------------;;
;; ;;
;; Create a line & text for each layer and have ;;
;; layer properties and text string is layer name ;;
;; for each layer ;;
;; ;;
;;------------------------------------------------------;;
;; Author: Hasan M. Asous, 2010 ;;
;; ;;
;; Copyright ? 2010 by HasanCAD, All Rights Reserved. ;;
;; Contact: HasanCAD @ TheSwamp.org, ;;
;; asos2000 @ CADTutor.net ;;
;;------------------------------------------------------;;
;; Version: 1 20100928 ;;
;;------------------------------------------------------;;
;; o_l_ll \_ll o_l l \_l ;;
;;
(defun c:Layers (/ AcObj ActDoc Cntr Pnt0 e l Pnt1 Pnt2 LyrName LyrLType
LyrClr
)
(vl-load-com)
(setq AcObj (vlax-get-Acad-Object))
(setq ActDoc (vla-get-ActiveDocument AcObj))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq Cntr -1)
(setq Pnt0 (trans (getpoint "\nBase point") 1 0))
(setq Pnt1 (list (+ (car pnt0) 3000) (cadr pnt0) (caddr pnt0)))
(setq Pnt2 (list (+ (car pnt0) 6000) (cadr pnt0) (caddr pnt0)));SETQ
;;-----HEADER------
(entmakex (list (cons 0 "TEXT") (cons 1 "OLD-LAYER") (cons 8 "0")
(cons 10 Pnt0) (cons 40 220) (cons 41 0.8) (cons 62 1)
)
)
(entmakex (list (cons 0 "TEXT") (cons 1 "NEW-LAYER") (cons 8 "0")
(cons 10 Pnt1) (cons 40 220) (cons 41 0.8) (cons 62 2)
)
)
(entmakex (list (cons 0 "TEXT") (cons 1 "OLD ==> NEW") (cons 8 "0")
(cons 10 Pnt2) (cons 40 220) (cons 41 0.8) (cons 62 3)
)
) ;;-----LAYERS LIST------
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -200) (caddr pnt0)))
(while (setq Lyr (tblnext "LAYER" (null Lyr)))
(setq LyrName (cdr (assoc 2 Lyr)))
(setq LyrLType (cdr (assoc 6 Lyr)))
(setq LyrClr (cdr (assoc 62 Lyr)))
(if (setq Pnt1 (list (+ (car pnt0) 3000) (cadr pnt0) (caddr pnt0)))
(progn
(entmakex (list (cons 0 "TEXT") (cons 1 LyrName) (cons 8 LyrName)
(cons 10 Pnt0) (cons 40 110) (cons 41 0.8)
)
)
(entmakex (list (cons 0 "TEXT") (cons 1 LyrName) (cons 8 LyrName)
(cons 10 Pnt1) (cons 40 110) (cons 41 0.8)
)
)
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -200) (caddr pnt0)))
)
)
(vla-EndUndoMark ActDoc)
)
(princ)
)
;defun ;;
;; o_l_ll \_ll o_l l \_l ;;
;=================================================================================
;;;;Function: Specify the layers that should be combined
;;;;Written by litss 2011-01-12
;=================================================================================
(defun C:editlst (/ cblay flag newlay oldent oldlay oldx oldy pnt2)
(setq flag nil)
(setvar "osmode" 0)
(while (not flag)
(setq oldent (car (entsel "\nSelect old-layer item from the list:")))
(setq oldlay (cdr (assoc 1 (entget oldent))))
(setq oldX (nth 0 (cdr (assoc 10 (entget oldent)))))
(setq oldY (nth 1 (cdr (assoc 10 (entget oldent)))))
(setq newent (car (entsel "\nSelect new-layer item from the list:")))
(setq newlay (cdr (assoc 1 (entget newent))))
(setq newXY (cdr (assoc 10 (entget newent))))
(if (and
oldlay
newlay
)
(progn
(setq Pnt2 (list (+ oldX 6000) oldY 0))
(setq cblay (strcat oldlay " ==> " newlay))
(entmakex (list (cons 0 "TEXT") (cons 1 cblay) (cons 8 newlay)
(cons 10 Pnt2) (cons 40 110) (cons 41 0.8)
)
)
(command "line" (list oldX oldY) newXY Pnt2 "")
);progn
(setq flag t)
);if
);while
;;-----Prepare Trans LIST------
)
;=================================================================================
;;;;Function: Combine layers by selecting the editlst
;;;;Thanks to Lee Mac whose routine is the core function.
;;;;Written by litss 2011-01-12
;=================================================================================
(defun c:cblayers (/ ent n posi ss1 str0 translst)
(setq ss1 (ssget))
(setq n 0)
(setq translst '())
(repeat (sslength ss1)
(setq ent (ssname ss1 n))
(setq str0 (cdr (assoc 1 (entget ent))))
(setq posi (vl-string-search " ==> " str0))
(setq translst (cons (cons (substr str0 1 posi) (substr str0 (+ posi 6)))
translst
)
)
(setq n (1+ n))
);repeat
(princ translst)
(layertrans translst)
(princ)
)
;=================================================================================
;;;;Subroutine by Lee Mac
;;;;The core function
;;;;Written by Lee Mac
;=================================================================================
(defun LayerTrans (layerlist / _lst->str doc blocks layers locked ss)
(vl-load-com) ;; Example by Lee Mac 2011 - www.lee-mac.com
;; LayerList should be in the form:
;; '(
;; ( "OldLayer1" . "NewLayer1" )
;; ( "OldLayer2" . "NewLayer2" )
;; ( "OldLayer3" . "NewLayer3" )
;; ...
;; ( "OldLayerN" . "NewLayerN" )
;; )
;; Layers are case-sensitive
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
blocks (vla-get-Blocks doc)
layers (vla-get-Layers doc)
)
(defun _lst->str (lst del)
(if (cdr lst)
(strcat (car lst) del (_lst->str (cdr lst) del))
(car lst)
)
)
(vla-StartUndoMark doc)
(mapcar
(function (lambda (item)
(vla-Add layers (cdr item))
)
)
layerlist
)
(vlax-for layer layers (if (eq :vlax-true (vla-get-lock layer))
(vla-put-lock (car (setq locked (cons layer
locked
)
)
) :vlax-false
)
)
)
(vlax-for block blocks (vlax-for obj block (if (setq layer (cdr
(assoc
(vla-get-layer obj) layerlist
)
)
)
(vla-put-layer obj layer)
)
)
)
(if (ssget "_X" (list (cons 8 (_lst->str (mapcar
'car
layerlist
) ","
)
)
)
)
(progn
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
(if (setq layer (cdr (assoc (vla-get-layer obj) layerlist)))
(vla-put-layer obj layer)
)
)
(vla-delete ss)
)
)
(foreach layer locked
(vla-put-lock layer :vlax-true)
)
(vl-cmdf "_.-purge" "_LA" (_lst->str (mapcar
'car
layerlist
) ","
) "_N"
) ;; Thanks CAB!
(vla-regen doc acAllViewports)
(vla-EndUndoMark doc)
(princ)
)