[Help me please] i want to change some layers become only one layer with Script.

i have a Script

Sub ChangeLayer(ByVal FullDwgName)
On Error Resume Next
Dim AcadApp
Dim Thisdrawing
Set AcadApp = GetObject(,"Autocad.Application")
If Err Then
	Err.Clear
	Set AcadApp =CreateObject("Autocad.Application")
End If
Dim LayerObj
	
Dim strOldLayerName(4)	'old name of Layer
strOldLayerName(0) ="STV-DIM"
strOldLayerName(1) ="STV-CENTER"
strOldLayerName(2) ="STV-HIDDEN"
strOldLayerName(3) ="STV-REF"
strOldLayerName(4) ="STV-PRIMARY"

Dim strNewLayerName(4)	'New Name of Layer
strNewLayerName(0) ="PT-DIM"		'Name for new Layer 1
strNewLayerName(1) ="PT-CENTER"		'Name for new Layer 2
strNewLayerName(2) ="PT-HIDDEN"		'Name for new Layer 3
strNewLayerName(3) ="PT-REF"		'Name for new Layer 4
strNewLayerName(4) ="PT-PRIMARY"	'Name for new Layer 5

Dim intNewLayerColor(4)
intNewLayerColor(0)=1	'Color for Layer 1
intNewLayerColor(1)=2	'Color for Layer 2
intNewLayerColor(2)=3	'Color for Layer 3
intNewLayerColor(3)=4	'Color for Layer 4
intNewLayerColor(4)=5	'Color for Layer 5

Dim strNewLayerLineType(4)
strNewLayerLineType(0)="CENTER"
strNewLayerLineType(1)="Continuous"
strNewLayerLineType(2)="HIDDEN"
strNewLayerLineType(3)="PHANTOM"
strNewLayerLineType(4)="Continuous"

Set Thisdrawing = AcadApp.Documents.Open(FullDwgName)
Dim intA
For Each LayerObj In Thisdrawing.Layers
		
		For intA=0 To 4
			If LayerObj.Name = strOldLayerName(intA) Then
				
				LayerObj.Name = strNewLayerName(intA)
				LayerObj.color = intNewLayerColor(intA)
				Thisdrawing.Linetypes.Load strNewLayerLineType(intA),"acad.lin"
				LayerObj.Linetype=strNewLayerLineType(intA)
				AcadApp.Update
			End If
		Next
Next

'Close drawing
Thisdrawing.Close True

End Sub

Old layer: A1, A2, A3, A4, A5, A6, A7, A8, A9

New layer: B1, B2, B3, B4

So i want to change A1, A3, A5 become B1

A2, A4, A6, A7 => B2

A8 => B3

A9 => B4

How do i must?

Thank you in advance

1st you have vba code not a script, think of lisp, script, vba & .net

The code above changes the layer properties not the objects, you want to take 4 layers of objects and make one layer, you can not rename 4 layers to be one.

Manually use layiso select the 4 layers select all objects, chprop or use properties.

A script example

(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)

1st you have vba code not a script, think of lisp, script, vba & .net

 

The code above changes the layer properties not the objects, you want to take 4 layers of objects and make one layer, you can not rename 4 layers to be one.

 

Manually use layiso select the 4 layers select all objects, chprop or use properties.

 

This my file ChangeLayer.rar

How can i do if i want to take 4 layers of objects and make one layer? because i want to change many CAD file.

Help me change this file.

Thank you in advance

Just make the script I posted do all the work, yes a lisp would do it better but a real quick answer.

Open dwg1
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y
Open dwg2
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y
Open dwg3
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y

Just make the script I posted do all the work, yes a lips would do it better but a real quick answer.

 

can you help me to take your code into my script file?

Please

I posted the script file all ready dwg1 = drawing name 1 and so on.

Save the 3 lines in my first post as layers4321.scr by copying and pasting via notepad. Type SCRIPT at the command line choose layers4321 it should change your current drawing.