bienda Posted August 16, 2016 Share Posted August 16, 2016 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 16, 2016 Share Posted August 16, 2016 (edited) 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) Edited August 16, 2016 by BIGAL Quote Link to comment Share on other sites More sharing options...
bienda Posted August 16, 2016 Author Share Posted August 16, 2016 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 16, 2016 Share Posted August 16, 2016 (edited) 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 Edited August 16, 2016 by BIGAL Quote Link to comment Share on other sites More sharing options...
bienda Posted August 16, 2016 Author Share Posted August 16, 2016 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 16, 2016 Share Posted August 16, 2016 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.