Looking for a one click or Auto fix for Layer reformatting

[BCrouse]

I am looking for a lisp that I can load that will merge old layers to new layers.

Example. (old layer = B NOTE)
(new layer = A-ANNO-NOTE)


Please let me know where I can modify the lisp to add layers later.

Thank you,

[Mike.Perry]

Hi

How about AutoCAD's built-n command LayTrans

PullDownMenu: Tools -> CAD Standards -> Layer Translator

or

Express Tools command LayMrg

PullDownMenu: Express -> Layer -> Layers Merge

Have a good one, Mike

[kennet.sjoberg]

I am looking for a lisp that I can load that will merge old layers to new layers.
It is more easy to change objects than to "merge layer", here may be something for You to play with.


(defun c:MergeLayer (/ OldLay NewLay SelSet Index EntName EntDxf )
(setq OldLay "B NOTE" )
(setq NewLay "A-ANNO-NOTE" )
(if (not (tblsearch "LAYER" NewLay ))
(alert (strcat "Your merge to layer " NewLay " do not exist\n You have to create it." ) )
(progn
(setq SelSet (ssget "_X" (list (cons 8 OldLay ))) )
(if (and Selset (>= (sslength SelSet ) 1 ) )
(progn
(setq Index 0 )
(while (setq EntName (ssname SelSet Index ) )
(setq EntDxf (entget EntName ) )
(if (= (cdr (assoc 8 EntDxf)) OldLay )
(progn
(setq EntDxf (subst (cons 8 NewLay ) (assoc 8 EntDxf) EntDxf ) )
(entmod EntDxf )
(entupd EntName )
)
(setq Index (1+ Index ) )
)
)
)
(princ (strcat "No objects on layer " OldLay " found !" ) )
)
)
)
(princ)
)
If You have block with objects on OldLay, the program will fail.

: ) Happy Computing !

kennet

[jwanstaett]

If you use the Layer Translator to make a .dws file then you can use (ACET-LAYTRANS "filename.dws") to run the translator

to change layers just edit the filename.dws with the layer Translator

note: for this to work you need to first load laytrans.arx
(arxload "laytrans")

[BCrouse]

How can I modify this lisp to merge more than one layer one click or on the start up? I don't want to always go to the Express tool for every file that I have to merge layers. Please see the attachment.


Thank you,

[kennet.sjoberg]

...mmm I can see my fingerprints in the beauty code :shock:

In the original version, You can append all layers in the ssget "_X" filter list

: ) Happy Computing !

kennet

[BCrouse]

...mmm I can see my fingerprints in the beauty code :shock:

In the original version, You can append all layers in the ssget "_X" filter list

: ) Happy Computing !

kennet

Kennet,

I know this is your code that you wrote. I was not trying do anything except to add more layers to it. I was just not sure how to do it?

Brad

[BCrouse]

Kennet,

Did I do this right? Please see attachement:

[kennet.sjoberg]

Nope, Your code is not OK.
You can have several OldLayer, but if there is more than one NewLayer the program must know where to send the objects. It is much more complex.

I have not tries this code, but there is god help behind the [F1] button in VLIDE.


;;; I send "GENNOTE" and "AN_NOTES" to "A-ANNO-NOTE"
;;; and "DIMENSIONS" and "AN_DIMS" to "A-ANNO-DIMS";;;
(defun c:MergeLayer (/ SelSet NewLay Index EntName EntDxf NewLay )
(if (not (or (tblsearch "LAYER" "A-ANNO-NOTE" )(tblsearch "LAYER" "A-ANNO-DIMS" )))
(alert (strcat "Your merge to layer does not existn You have to create." ) )
(progn
(setq SelSet
(ssget "_X"
'( (-4 . "<OR") ;; collect OldLayer objects
(-4 . "<AND") (8 . "GENNOTE" ) (-4 . "AND>")
(-4 . "<AND") (8 . "AN_NOTES" ) (-4 . "AND>")
(-4 . "<AND") (8 . "DIMENSIONS") (-4 . "AND>")
(-4 . "<AND") (8 . "AN_DIMS" ) (-4 . "AND>")
(-4 . "OR>")
)
)
)
(if (and Selset (>= (sslength SelSet ) 1 ) )
(progn
(setq Index 0 )
(while (setq EntName (ssname SelSet Index ) )
(setq EntDxf (entget EntName ) )
;; chose NewLayer
(if (or (= (cdr (assoc 8 EntDxf) "GENNOTE" )) (= (cdr (assoc 8 EntDxf) "AN_NOTES" )))
(setq NewLay "A-ANNO-NOTE" )
(setq NewLay "A-ANNO-DIMS" )
)
(setq EntDxf (subst (cons 8 NewLay ) (assoc 8 EntDxf) EntDxf ) )
(entmod EntDxf )
(entupd EntName )
(setq Index (1+ Index ) )
)
)
(princ (strcat "No objects on OLD-layer found !" ) )
)
)
)
(princ)
)


: ) Happy Computing !

kennet

[kennet.sjoberg]

OK, here is a checked code, the first one was made in Notepad and was missing parentheses.


;;; I send "GENNOTE" and "AN_NOTES" to "A-ANNO-NOTE"
;;; and "DIMENSIONS" and "AN_DIMS" to "A-ANNO-DIMS";;;
(defun c:MergeLayer (/ SelSet NewLay Index EntName EntDxf NewLay )
(if (not (and (tblsearch "LAYER" "A-ANNO-NOTE" )(tblsearch "LAYER" "A-ANNO-DIMS" )))
(alert (strcat "Your merge to layer does not exist\n You have to create." ) )
(progn
(setq SelSet
(ssget "_X"
'( (-4 . "<OR") ;; collect OldLayer objects
(-4 . "<AND") (8 . "GENNOTE" ) (-4 . "AND>")
(-4 . "<AND") (8 . "AN_NOTES" ) (-4 . "AND>")
(-4 . "<AND") (8 . "DIMENSIONS") (-4 . "AND>")
(-4 . "<AND") (8 . "AN_DIMS" ) (-4 . "AND>")
(-4 . "OR>")
)
)
)
(if (and Selset (>= (sslength SelSet ) 1 ) )
(progn
(setq Index 0 )
(while (setq EntName (ssname SelSet Index ) )
(setq EntDxf (entget EntName ) )
;; chose NewLayer
(if (or (= (cdr (assoc 8 EntDxf )) "GENNOTE" ) (= (cdr (assoc 8 EntDxf )) "AN_NOTES" ))
(setq NewLay "A-ANNO-NOTE" )
(setq NewLay "A-ANNO-DIMS" )
)
(setq EntDxf (subst (cons 8 NewLay ) (assoc 8 EntDxf) EntDxf ) )
(entmod EntDxf )
(entupd EntName )
(setq Index (1+ Index ) )
)
)
(princ (strcat "No objects on OLD-layer found !" ) )
)
)
)
(princ)
)


: ) Happy Computing !

kennet

PS. I hope You enjoyed the [F1] button