VBA Causes DWG Recovery

[brad.moon126662]

Hi,

Has anyone come across a problem where some files processed in a VBA routine need to be recovered? The following errors are the majority:

AcDbLine(AEC4) Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbHatch(AEC5) Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbPolyline(AEC6) Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbHatch(AEC7) Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbPolyline(AEC Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbLine(AEC9) Invalid layer eNullObjectId $AUDIT-BAD-LAYER
AcDbLine(AEC9) Invalid linetype eNullObjectId changed to ByLayer
AcDbPolyline(AECA) Invalid layer eNullObjectId $AUDIT-BAD-LAYER

Thanks,

Brad

[kdayman]

What kind of "Processing" are you doing to the files?

[brad.moon126662]

Storing all attribute Tags and Values from the current title blocks (two in each file), erasing and purging the blocks, inserting new versions, storing all attributes Tags and Values from the new versions of the blocks, comparing those Tags against the old and assigning the attribute values from the old blocks to the Tags of the new blocks.

[MikeJarosz]

Here's a routine that pretty much does what you describe. We had a project with thousands of room targets already in place when someone decided we had to add one more field for a finish code. This program reads all the targets on a drawing and stores the attributes in memory, then deletes the targets, purges and puts back a new target with the additional field and the original attribute information. This sub is called from a main procedure that loads drawings one at a time from a list, calls the replace routine, saves the file then loops until done.

 
Option Base 1
Sub ReplaceRmTar()
Dim F As Integer
Dim FileName As String
Dim FileList As String
FileList = "w:\a\data\filelist.txt"
F = FreeFile()
Open FileList For Input As #F
Do While Not EOF(F)
	Line Input #F, FileName
	Debug.Print FileName
	ThisDrawing.Application.Documents.Open FileName
	On Error Resume Next 'trap CTB conversion
	ZoomAll
	If ThisDrawing.ReadOnly = False Then
		SetLayer
		ReplaceBlock
		ThisDrawing.Save
	Else
		MsgBox FileName & " is READ ONLY"
		Debug.Print FileName & " is READ ONLY"
	End If
	ThisDrawing.Application.ActiveDocument.Close
Loop
Close FileList
Debug.Print "DONE"
End Sub
'================================================================================================
Sub SetLayer()
'================================================================================================
Dim Layer As AcadLayer
On Error Resume Next
Set Layer = ThisDrawing.Layers("A-NOTE-IDEN")
If Layer Is Nothing Then
	Set Layer = ThisDrawing.Layers.Add("A-NOTE-IDEN")
	Layer.color = acCyan
	Layer.Linetype = "CONTINUOUS"
End If
ThisDrawing.ActiveLayer = Layer
ThisDrawing.ActiveLayer.Freeze = False
End Sub
'================================================================================================
Sub ReplaceBlock()
'================================================================================================
Dim Ipt As Variant
Dim RoomName_1 As String
Dim RoomName_2 As String
Dim RoomNumber As String
Dim Finish As String
Dim Attrib As Variant
Dim Tag As Variant
Dim Angle As Double
Dim RmTar As AcadBlockReference
Dim BlkRef As AcadBlockReference
Const ScX As Double = 1#
Const ScY As Double = 1#
Const ScZ As Double = 1#
Dim Target As String
Target = "w:\a\blocks\room_tag.dwg"
Dim Sset As AcadSelectionSet
Set Sset = ThisDrawing.SelectionSets.Add("RoomTarget")
Dim Codes() As Integer
ReDim Codes(2)
Dim CodeValues() As Variant
ReDim CodeValues(2)
Codes(1) = 0
Codes(2) = 2
CodeValues(1) = "INSERT"
CodeValues(2) = "_TARROOM" 'Block name
Sset.Select acSelectionSetAll, , , Codes, CodeValues
If Sset.Count = 0 Then Exit Sub
For Each RmTar In Sset
	Ipt = RmTar.InsertionPoint
	Ipt(2) = 0#
	Angle = RmTar.Rotation
	RoomName_1 = ""
	RoomName_2 = ""
	RoomNumber = ""
	Finish = "P000"
	
	For Each Attrib In RmTar.GetAttributes
	With Attrib
		Select Case .TagString
		Case "RMNAM1"
			RoomName_1 = Trim(.TextString)
		Case "RMNAM2"
			RoomName_2 = Trim(.TextString)
		Case "RMNUM"
			RoomNumber = Trim(.TextString)
		End Select
	End With
	Next Attrib
	
	If RoomName_1 = "" Then RoomName = "----"
	If RoomNumber = "" Then RoomNumber = "--"
	RmTar.Delete
		
	'insert new block here and set attributes
	Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(Ipt, Target, ScX, ScY, ScZ, Angle)
	For Each Tag In BlkRef.GetAttributes
		Select Case Tag.TagString
		Case "RMNAM1"
			Tag.TextString = RoomName_1
		Case "RMNAM2"
			Tag.TextString = RoomName_2
		Case "RMNUM"
			Tag.TextString = RoomNumber
		Case "FINISH"
			Tag.TextString = Finish
		End Select
	Next Tag
	BlkRef.Update
Next RmTar
ThisDrawing.PurgeAll
ThisDrawing.PurgeAll
ThisDrawing.SelectionSets("RoomTarget").Delete
End Sub