I have created a small macro to generate DXF files based on data transferred from Excel. However, I encountered an issue with the dsApp.NewDocument("standarddin.dwt") function, which behaves inconsistently. Sometimes it works fine, but other times it creates a new drawing, and the events confirm its creation, yet Excel reports an issue. After pressing "Continue," the file gets created again, but DraftSight is unable to properly work with the previously generated file. And any action with that file can crash the draftsight. Here is my code, could you please help with problem I faced?:
Function DrawRectangleWithLinesDs(ByRef dsApp As DraftSight.Application, savePath As String)
Dim ws, ws1 As Worksheet
Dim doc As DraftSight.Document
Dim doc2 As DraftSight.Document
Dim modelSpace As DraftSight.Model
Dim dsSketchMgr As DraftSight.SketchManager
Dim ObjColor As DraftSight.color
Dim objRect As DraftSight.polyline
Dim pts(0 To 9) As Double
Dim textObj As DraftSight.SimpleNote
Dim insertPoint(0 To 2) As Double
' avoid nested commands
dsApp.AbortRunningCommand
'Set up events
Set dsAppEvents = New Class1
Set dsDocEvents = New Class2
Set dsAppEvents.app = dsApp
Set doc = dsApp.GetActiveDocument()
FileNewNotify = False
Set ws = ThisWorkbook.Sheets("PART LIST")
Set ws1 = ThisWorkbook.Sheets("PART LIST OUT")
Dim j As Integer
For j = 11 To ws.Cells(ws.Rows.count, 2).End(xlUp).Row
' Get Data
Dim TrBreath As Double, TrHeight As Double, TrLength As Double, TrRadius As Double
Dim TrMaterial As String, TrSection As String, TrYardNumber As String
Dim TrThickness As Double, TrNumber As String, TrQuantity As String, TrRevision As String
If InStr(1, ws.Cells(j, 6).Value, "BENT PLATE", vbTextCompare) > 0 And ws.Cells(j, 2).Value <> ws.Cells(j - 1, 2).Value Then
a = Split(ws.Cells(j, 6), " ", -1)
TrRadius = a(4)
a = Split(a(2), "x", -1)
TrBreath = a(0)
TrHeight = a(1)
TrLength = ws.Cells(j, 10).Value
TrThickness = ws.Cells(j, 12).Value
TrMaterial = ws.Cells(j, 7).Value
TrSection = ws.Cells(4, 5).Value
TrYardNumber = ws.Cells(4, 4).Value
TrNumber = ws.Cells(j, 2).Value
TrRevision = ws.Cells(j, 5).Value
For i = 18 To ws1.Cells(ws1.Rows.count, 2).End(xlUp).Row
If ws.Cells(j, 2).Value = ws1.Cells(i, 2).Value Then TrQuantity = ws1.Cells(i, 3).Value
Next i
Application.Wait Now + TimeValue("00:00:02")
Do While FileNewNotify = False
dsApp.AbortRunningCommand
Set doc2 = dsApp.NewDocument("standarddin.dwt")
DoEvents
Loop
FileNewNotify = False
If doc2 Is Nothing Then
MsgBox ("Failed to create a new document in DraftSight.")
Exit Function
End If
Set dsDocEvents.doc = doc2
Set modelSpace = doc2.GetModel()
Set dsSketchMgr = modelSpace.GetSketchManager()
' Points calculation (0,0)
pts(0) = 0
pts(1) = 0
pts(2) = 2 * TrHeight + TrBreath - 4 * TrRadius + pi * (TrRadius + TrThickness / 2)
pts(3) = 0
pts(4) = 2 * TrHeight + TrBreath - 4 * TrRadius + pi * (TrRadius + TrThickness / 2)
pts(5) = TrLength
pts(6) = 0
pts(7) = TrLength
pts(8) = 0
pts(9) = 0
Set objRect = dsSketchMgr.InsertPolyline2D(pts, True)
doc2.Rebuild (dsRebuildType_AllViewports)
Set ObjColor = objRect.color
ObjColor.SetColorByIndex (3)
objRect.color = ObjColor
objRect.Layer = "0"
Dim line1(0 To 3) As Double
Dim line2(0 To 3) As Double
line1(0) = TrHeight - TrRadius + pi * (TrRadius + TrThickness / 2) / 4
line1(1) = 0
line1(2) = TrHeight - TrRadius + pi * (TrRadius + TrThickness / 2) / 4
line1(3) = TrLength
line2(0) = TrHeight + TrBreath - 3 * TrRadius + 3 * pi * (TrRadius + TrThickness / 2) / 4
line2(1) = 0
line2(2) = TrHeight + TrBreath - 3 * TrRadius + 3 * pi * (TrRadius + TrThickness / 2) / 4
line2(3) = TrLength
ObjColor.SetColorByIndex (4)
Set objRect = dsSketchMgr.InsertPolyline2D(line1, False)
objRect.color = ObjColor
objRect.Layer = "0"
insertPoint(0) = TrHeight - TrRadius + pi * (TrRadius + TrThickness / 2) / 4
insertPoint(1) = TrLength / 4
insertPoint(2) = 0
ObjColor.SetColorByIndex (7)
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 10, pi / 2, "TSKN R=" & TrRadius & " DEG=90")
textObj.color = ObjColor
textObj.Layer = "0"
ObjColor.SetColorByIndex (4)
Set objRect = dsSketchMgr.InsertPolyline2D(line2, False)
objRect.color = ObjColor
objRect.Layer = "0"
insertPoint(0) = TrHeight + TrBreath - 3 * TrRadius + 3 * pi * (TrRadius + TrThickness / 2) / 4
insertPoint(1) = TrLength / 4
insertPoint(2) = 0
ObjColor.SetColorByIndex (7)
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 10, pi / 2, "TSKN R=" & TrRadius & " DEG=90")
textObj.color = ObjColor
textObj.Layer = "0"
insertPoint(0) = TrHeight + 50
insertPoint(1) = TrLength - 20
insertPoint(2) = 0
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 10, 0, TrSection)
textObj.color = ObjColor
textObj.Layer = "0"
insertPoint(0) = TrHeight + 50
insertPoint(1) = TrLength - 40
insertPoint(2) = 0
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 10, 0, TrNumber)
textObj.color = ObjColor
textObj.Layer = "0"
insertPoint(0) = 0
insertPoint(1) = 0
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[P]" & TrNumber)
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[T]" & TrThickness)
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[I]" & "Bent Plate")
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[B]" & TrYardNumber)
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[N]" & TrSection)
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[M]" & TrMaterial)
textObj.color = ObjColor
textObj.Layer = "0"
Set textObj = dsSketchMgr.InsertSimpleNote(insertPoint(0), insertPoint(1), insertPoint(2), 5, 0, "[Q]" & TrQuantity)
textObj.color = ObjColor
textObj.Layer = "0"
Dim dsTextStyleManager As DraftSight.TextStyleManager
Set dsTextStyleManager = doc2.GetTextStyleManager()
Dim dsTextStyle As DraftSight.TextStyle
Set dsTextStyle = dsTextStyleManager.GetTextStyle("Standard")
dsTextStyle.Font = "txt.shx"
Set dsTextStyle = Nothing
Set dsTextStyleManager = Nothing
Set textObj = Nothing
Set objRect = Nothing
Set ObjColor = Nothing
Set objRect = Nothing
Set dsSketchMgr = Nothing
Set modelSpace = Nothing
TrMaterial = Trim(Replace(Replace(Replace(TrMaterial, "[M]", "", 1), "Steel", "", 1), "Grade", "", 1))
doc2.SaveAs2 savePath & TrYardNumber & "_" & TrSection & "_" & TrNumber & "_" & TrMaterial & "_" & TrThickness & "_Rev_" & TrRevision & ".dxf", dsDocumentSaveAs_R2000_R2002_ASCII_DXF, True, dsDocumentSave_Succeeded
PathName = doc2.GetPathName
dsApp.CloseDocument PathName, False
Do While docDestroyNotify = False
DoEvents
Loop
docDestroyNotify = False
Set doc2 = Nothing
End If
Next j
End Function