[libredwg] Sample VB code for generating XML output for testsuite.

[Guruprasad Rane]

Hi All

Here is a small piece of code in VB to generate an XML output from a 
drawing file in autocad. Presently it supports only Line, Ray, 
Construction Line & polyline.

The XML schema needs to be discussed and finalized. Someone with in 
depth knowledge of DWG file format need to help out.

Sub GenerateXML()

   Dim tempObj As AcadEntity

   Dim tempXML As String

   Set fs = CreateObject("Scripting.FileSystemObject")

   Set XMLFile = fs.CreateTextFile("c:\test.xml", True)

   XMLFile.WriteLine ("<?xml version='1.0' encoding='UTF-8' ?><dwgdata>")

   For Each tempObj In ThisDrawing.ModelSpace

       Select Case tempObj.ObjectName

           Case "AcDbLine"

               Dim StartPoint As Variant

               Dim EndPoint As Variant

               StartPoint = tempObj.StartPoint

               EndPoint = tempObj.EndPoint

               tempXML = "<" & tempObj.ObjectName & " id='" & tempObj.ObjectID & "' color='" & tempObj.color & "' layer='" & tempObj.Layer & "' linetype='" & tempObj.Linetype & "' linetypescale='" & tempObj.LinetypeScale 
& "' lineweight='" & tempObj.Lineweight & "' startX='" & StartPoint(0) & "' startY='" & StartPoint(1) & "' startZ='" & StartPoint(2) & "' endX='" & EndPoint(0) & "' endY='" & EndPoint(1) & "' endZ='" & 
EndPoint(2) & "' />"

               XMLFile.WriteLine (tempXML)

           Case "AcDbRay", "AcDbXline"

               Dim NewBasePoint As Variant

               Dim NewSecondPoint As Variant

               NewBasePoint = tempObj.BasePoint

               NewSecondPoint = tempObj.SecondPoint

               tempXML = "<" & tempObj.ObjectName & " id='" & tempObj.ObjectID & "' color='" & tempObj.color & "' layer='" & tempObj.Layer & "' linetype='" & tempObj.Linetype & "' linetypescale='" & tempObj.LinetypeScale 
& "' lineweight='" & tempObj.Lineweight & "' basepointX='" & NewBasePoint(0) & "' basepointY='" & NewBasePoint(1) & "' basepointZ='" & NewBasePoint(2) & "' secondpointX='" & NewSecondPoint(0) & "' secondpointY='" & 
NewSecondPoint(1) & "' secondpointZ='" & NewSecondPoint(2) & "' />"

               XMLFile.WriteLine (tempXML)

           Case "AcDbPolyline"

               Dim NewNormal As Variant

               Dim NewCoordinates As Variant

               Dim StartWidth As Double

               Dim EndWidth As Double

               Dim NoOfSegments As Integer

               NewCoordinates = tempObj.Coordinates

               NoOfSegments = ((UBound(NewCoordinates) - LBound(NewCoordinates) 
+ 1) / 2) - 1

               NewNormal = tempObj.Normal

               tempXML = "<" & tempObj.ObjectName & " id='" & tempObj.ObjectID & "' color='" & tempObj.color & "' layer='" & tempObj.Layer & "' linetype='" & tempObj.Linetype & "' linetypescale='" & tempObj.LinetypeScale 
& "' lineweight='" & tempObj.Lineweight & "' closed='" & tempObj.Lineweight & "' elevation='" & tempObj.Elevation & "' normalX='" & NewNormal(0) & "' normalY='" & NewNormal(1) & "' normalZ='" & NewNormal(2) & "' 
segments='" & NoOfSegments & "'>"

               XMLFile.WriteLine (tempXML)

               For point = 0 To NoOfSegments Step 1

                   StartPoint = tempObj.Coordinate(point)

                   tempObj.GetWidth point, StartWidth, EndWidth

                   tempXML = "<PolyLinePoint id='" & point + 1 & "' x='" & StartPoint(0) & "' y='" & StartPoint(1) & "' 
StartWidth='" & StartWidth & "' EndWidth='" & EndWidth & "' />"

               XMLFile.WriteLine (tempXML)

               Next point

               XMLFile.WriteLine ("</" & tempObj.ObjectName & ">")

       End Select

   Next

   XMLFile.WriteLine ("</dwgdata>")

   XMLFile.Close

End Sub




Here is the XML output

<?xml version='1.0' encoding='UTF-8' ?>

<dwgdata>

        <AcDbLine id='2130326536' color='1' layer='test layer' linetype='ByLayer' 
linetypescale='1' lineweight='-1' startX='29' startY='36.5' startZ='0' endX='43' 
endY='46.5' endZ='0' />

        <AcDbPolyline id='2130326576' color='256' layer='0' linetype='ByLayer' 
linetypescale='1' lineweight='-1' closed='-1' elevation='10' normalX='0' normalY='0' 
normalZ='1' segments='7'>

                <PolyLinePoint id='1' x='29' y='13' StartWidth='1' EndWidth='6' 
/>

                <PolyLinePoint id='2' x='49' y='24' StartWidth='0' EndWidth='0' 
/>

                <PolyLinePoint id='3' x='58.5' y='14.5' StartWidth='0' 
EndWidth='0' />

                <PolyLinePoint id='4' x='68' y='21.5' StartWidth='0' EndWidth='0' 
/>

                <PolyLinePoint id='5' x='80.5' y='17.5' StartWidth='0' 
EndWidth='0' />

                <PolyLinePoint id='6' x='78.1371552975327' y='10.1161103047896' 
StartWidth='0' EndWidth='0' />

                <PolyLinePoint id='7' x='60.5' y='1' StartWidth='0' EndWidth='0' 
/>

                <PolyLinePoint id='8' x='49' y='9.5' StartWidth='0' EndWidth='0' 
/>

        </AcDbPolyline>

        <AcDbRay id='2130326672' color='2' layer='0' linetype='ByLayer' 
linetypescale='1' lineweight='-1' basepointX='25' basepointY='46.5' basepointZ='0' 
secondpointX='24.5630960372631' secondpointY='45.600491841424' secondpointZ='0' />

        <AcDbLine id='2130326680' color='256' layer='0' linetype='ByLayer' 
linetypescale='1' lineweight='-1' startX='45.5' startY='36' startZ='0' endX='66' 
endY='42' endZ='0' />

        <AcDbXline id='2130326688' color='256' layer='test layer' 
linetype='ByLayer' linetypescale='1' lineweight='-1' basepointX='57.5' 
basepointY='50' basepointZ='0' secondpointX='58.3831157194574' 
secondpointY='49.5308447740383' secondpointZ='0' />

</dwgdata>


Please comment

Regards

Guruprasad