faith_cad Posted November 20, 2009 Share Posted November 20, 2009 Hello! Can someone help me solve this annoing problem? A have to make a script ...that renames the name of some layers.. ex (layer name "102" and layer name "104" must merge into "test1") .. at first...i was just renameing ..each layer... but i receive the error that says that the layer is already existing "duplicate error" ... and now i must copy the content of layer "102" to layer "104" and then rename "104" to "test1" but i'm kind of new into VBA scripting in AutoCAD! PS. I have to process a large number of files..and it can't be done manualy beacuse the lack of time.. i must make it by vba script beacuse vb is the only language a know! Quote Link to comment Share on other sites More sharing options...
David Bethel Posted November 20, 2009 Share Posted November 20, 2009 I'd use something like this ( AutoLisp ) [b][color=BLACK]([/color][/b]defun c:mergel [b][color=FUCHSIA]([/color][/b]/ vlist laylist ss tdef fe fd el[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq vlist '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b][color=#2f4f4f]"ELEVATION"[/color] . 0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"THICKNESS"[/color] . 0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"CELTSCALE"[/color] . 1[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"CECOLOR"[/color] . [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"CELTYPE"[/color] . [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]foreach v vlist [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]getvar [b][color=GREEN]([/color][/b]car v[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setvar [b][color=GREEN]([/color][/b]car v[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cdr v[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq laylist '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b][color=#2f4f4f]"OLD-LAYER"[/color] . [color=#2f4f4f]"NEW-LAYER"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"3D-SZG"[/color] . [color=#2f4f4f]"SNEEZE"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]foreach l laylist [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] [b][color=BLUE]([/color][/b]cdr l[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_New"[/color] [b][color=GREEN]([/color][/b]cdr l[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]""[/color][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]foreach l laylist [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]car l[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_LA"[/color] [b][color=GREEN]([/color][/b]cdr l[b][color=GREEN])[/color][/b] [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq fe [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc -2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake tdef[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]while fe [b][color=MAROON]([/color][/b]setq fd [b][color=GREEN]([/color][/b]entget fe[b][color=GREEN])[/color][/b] el [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 8 fd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]assoc el laylist[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq fd [b][color=BLUE]([/color][/b]subst [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc el laylist[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]assoc 8 fd[b][color=RED])[/color][/b] fd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]entmake fd[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq fe [b][color=GREEN]([/color][/b]entnext fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] You could format the layer list externally and then read it globally into each dwg or just completely compile the list inside the routine as it is now. I'd be careful cause it will destroy the handle data. -David Quote Link to comment Share on other sites More sharing options...
faith_cad Posted November 27, 2009 Author Share Posted November 27, 2009 Thank u David! but as I mentioned I don't know lisp! But thank u for trying to help! I've resolved the problem with finding some pieces of code in VBA like selecting all content of a layer...and then the process was kind simple! For everyone that have the same problem like i did...ask me for the code and i'l give it to u! And sorry for my bad english! Quote Link to comment Share on other sites More sharing options...
AQucsaiJr Posted December 17, 2009 Share Posted December 17, 2009 I am having a similar problem... You think you could post the code so I could try it? Quote Link to comment Share on other sites More sharing options...
faith_cad Posted December 17, 2009 Author Share Posted December 17, 2009 this is the code ... i hope it will help u Private Sub button1_Click() Dim acadDoc As AutoCAD.AcadDocument Set acadDoc = AutoCAD.Documents.Open("C:\test.dwg") Dim lays As AcadLayers Dim layerObj As AcadLayer Dim lay As AcadLayer Dim strLayerName As String On Error Resume Next 'Set lays = ThisDrawing.Layers Set lays = acadDoc.Layers 'set the layer to default ThisDrawing.ActiveLayer = lays.Item(0) 'go trough all the layers For Each lay In lays Set layerObj = acadDoc.Layers(lay.Name) 'listbox1 is the list with the layer names that are initialy 'listbox2 is the list with the layer names that are becoming 'ex: listbox1 contains (103, 150, 160) ' and listbox2 contains (a, b, c) 103 is becoming a .. 150 is becoming b and 160 is becoming c 'if u have ..listbox1(103, 150, 160) and listbox2 (a, a, c) 'then a error..ocurs..and is captured.. then..takes all the elements on 'then layer 150 and copy them to the layer a ..and then deletes the 150 'and so on... 'the listbox u can fill them from a txt file ... For i = 0 To ListBox1.ListCount - 1 If layerObj.Name = ListBox1.List(i) Then layerObj.Name = ListBox2.List(i) If Err.Number = "-2145386405" Then 'Testselectionsetfilter is the sub that copies the information from one layer to the other Testselectionsetfilter ListBox1.List(i), ListBox2.List(i) acadDoc.Layers.Item(ListBox1.List(i)).Delete End If End If Next i Next lay Private Sub Testselectionsetfilter(layer_init As String, layer_dest As String) Dim objss As AcadSelectionSet Dim intcodes(0) As Integer Dim varcodevalues(0) As Variant Dim strname As String On Error GoTo done strname = layer_init If "" = strname Then Exit Sub ''create new selectionset Set objss = ThisDrawing.SelectionSets.Add("Testselectionsetfilter") ''set the code for layer intcodes(0) = 8 ''set the value specified by user varcodevalues(0) = strname ''filter the objects objss.Select acSelectionSetAll, , , intcodes, varcodevalues ''highlight the selected entities objss.Highlight True For i = 0 To objss.Count objss.Item(i).layer = layer_dest Next i done: '' if the selection was created , delete it If Not objss Is Nothing Then objss.Delete End If End Sub End sub Quote Link to comment Share on other sites More sharing options...
faith_cad Posted December 17, 2009 Author Share Posted December 17, 2009 i've posted the code 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.