Message 1 of 12
autocad electric 2013 vba runtime error -214741811 (80010001)

Not applicable
07-08-2012
01:49 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Pls somebody can helps me with this issue ?
I got an automation error in a VBA routine thath manage the files (open a flile search with selectioset an objetc, modify, save and close for underd files).
Attached the routrine, for your info, but seems the error hang the routine in random point without a precise instruction.
Thank you
Private Function LineCount(FileName As String) As Long i = 0 Open FileName For Input As #1 Do While Not EOF(1) i = i + 1 Line Input #1, Dado Loop Close #1 MyLineCount = i End Function Sub CambiaNome() MyPath = "D:\111111 - ZZZZ_New\ID11STD3604_rev1\" Dim Ssnew As Object Dim Entity As Object Call LineCount(MyPath & "DWG_NEW.txt") ReDim Preserve SourceDWG(MyLineCount) ReDim Preserve DestinationDWG(MyLineCount) MyDestinationPath = MyPath & "DWG_NEW.txt" Open MyDestinationPath For Input As #1 X = 0 Do While Not EOF(1) ' Loop until end of file. Input #1, SourceDWG(X) ' Read data into two variables. Input #1, DestinationDWG(X) ' Read data into two variables. X = X + 1 Loop Close #1 'IntGroupCode(0) = -4 'VarGroupValue(0) = "<OR" IntGroupCode(0) = 0 VarGroupValue(0) = "INSERT" IntGroupCode(1) = 2 VarGroupValue(1) = "NUMFG,NUMFGS" 'IntGroupCode(3) = 0 'VarGroupValue(3) = "TEXT" 'IntGroupCode(4) = 0 'VarGroupValue(4) = "MTEXT" 'IntGroupCode(5) = "-4" 'VarGroupValue(5) = "OR>" 'intGroupCode(0) = 0 'varGroupValue(0) = "INSERT" 'intGroupCode(1) = 2 'varGroupValue(1) = "NEW_SAIPEM" Dim MyNewPath As String For i = 0 To MyLineCount - 1 For Each Pippo In ThisDrawing.SelectionSets If Pippo.Name = "BOM1" Then ThisDrawing.SelectionSets("BOM1").Delete Exit For End If Next If SourceDWG(i) <> "" Then MyNewPath = MyPath & SourceDWG(i) ThisDrawing.Application.Documents.Open (MyNewPath) ThisDrawing.SelectionSets.Add ("BOM1") Set Ssnew = ThisDrawing.SelectionSets("BOM1") Ssnew.Select acSelectionSetAll, , , IntGroupCode, VarGroupValue For Each Entity In Ssnew If TypeOf Entity Is AcadBlockReference Then Select Case Entity.Name Case "NUMFG" Numero = Entity.GetAttributes Numero(0).TextString = Str$(i) + 1 Case "NUMFGS" Numero = Entity.GetAttributes If i = 56 Then Numero(0).TextString = 56 Else Numero(0).TextString = Str$(i) + 2 End If End Select End If Next End If MyDestinationPath = (MyPath & "NuoviNumeri\" & DestinationDWG(i)) ThisDrawing.SaveAs (MyDestinationPath) ThisDrawing.Close Set Ssnew = Nothing Next End Sub