0 Replies Latest reply on Mar 7, 2012 3:21 PM by Tom Cote

    Creating an XML file from a BOM on a SW drawing

    Tom Cote

      Hi all,  I'm trying to create an XML file from a BOM on a drawing.  But there is a little catch to it.  The drawing may have several BOM in it and none have the correct columns for what I need.  So I've been piecing together code, some from the SW website, some from other resources on the web and some I wrote.  in the code that I have I insert the correct BOM and then "search" the tree for the last BOM.  From there it does create the XML file with everything configured correctly except that it is grabbing all the BOM's not just the one which I have the name of.  Any help to narrow this down would be greatly appreciated.

       

      PS I have no problem to put the actual macro up here if it helps.

       

      Thanks,

       

       

      '-------------------------------------------------------------

       

      Option Explicit

       

       

      Public Enum swTableSplitDirection_e

          swTableSplit_None = 0

          swTableSplit_Horizontal = 1

          swTableSplit_Vertical = 2

      End Enum

       

       

      Sub ProcessTableAnn _

      ( _

          swApp As SldWorks.SldWorks, _

          swModel As SldWorks.ModelDoc2, _

          swTableAnn As SldWorks.TableAnnotation, _

          XMLfile As Scripting.TextStream _

      )

       

          Dim nNumRow                 As Long

          Dim nNumCol                 As Long

          Dim nNumHeader              As Long

          Dim sHeaderText()           As String

          Dim i                       As Long

          Dim j                       As Long

          Dim k                       As Long  

          Dim nIndex                  As Long

          Dim nCount                  As Long

          Dim nStart                  As Long

          Dim nEnd                    As Long

          Dim nSplitDir               As Long

       

          nNumHeader = swTableAnn.GetHeaderCount: Debug.Assert nNumHeader >= 1

       

          nSplitDir = swTableAnn.GetSplitInformation(nIndex, nCount, nStart, nEnd)

       

          If swTableSplit_None = nSplitDir Then

       

              Debug.Assert 0 = nIndex

              Debug.Assert 0 = nCount

              Debug.Assert 0 = nStart

              Debug.Assert 0 = nEnd

       

              nNumRow = swTableAnn.RowCount

              nNumCol = swTableAnn.ColumnCount

              nStart = nNumHeader

              nEnd = nNumRow - 1

       

          Else

       

              Debug.Assert swTableSplit_Horizontal = nSplitDir

              Debug.Assert nIndex >= 0

              Debug.Assert nCount >= 0

              Debug.Assert nStart >= 0

              Debug.Assert nEnd >= nStart

       

              nNumCol = swTableAnn.ColumnCount

       

              If 1 = nIndex Then

                  ' Add header offset for first portion of table

                  nStart = nStart + nNumHeader

              End If

          End If

         

         

          If swTableAnn.TitleVisible Then

              XMLfile.WriteLine "                <TITLE>" & swTableAnn.Title & "</TITLE>"

          End If

         

          ReDim sHeaderText(nNumCol - 1)

       

          For j = 0 To nNumCol - 1

       

              sHeaderText(j) = swTableAnn.GetColumnTitle(j)

             ' Replace invalid characters for XML tags

       

              sHeaderText(j) = Replace(sHeaderText(j), ".", "")

              sHeaderText(j) = Replace(sHeaderText(j), " ", "_")

       

          Next 

       

          For j = nStart To nEnd

       

              XMLfile.WriteLine "                <material>"

       

              For k = 0 To nNumCol - 1

       

                  XMLfile.WriteLine "                    " + _

                      "<" + sHeaderText(k) + ">" + _

                          swTableAnn.Text(j, k) + _

                      "</" + sHeaderText(k) + ">"

              Next k

       

              XMLfile.WriteLine "                </material>"

       

          Next j

      End Sub

       

       

      Sub ProcessBomFeature _

      ( _

          swApp As SldWorks.SldWorks, _

          swModel As SldWorks.ModelDoc2, _

          swBomFeat As SldWorks.BomFeature, _

          XMLfile As Scripting.TextStream _

      )

          Dim swFeat                  As SldWorks.Feature

          Dim vTableArr               As Variant

          Dim vTable                  As Variant

          Dim swTable                 As SldWorks.TableAnnotation

       

      Set swFeat = swBomFeat.GetFeature

         

          XMLfile.WriteLine "        <materials>"

       

          vTableArr = swBomFeat.GetTableAnnotations

       

          For Each vTable In vTableArr

       

              Set swTable = vTable

              ProcessTableAnn swApp, swModel, swTable, XMLfile

       

          Next vTable

       

          XMLfile.WriteLine "        </materials>"

       

      End Sub

       

       

      Sub main()

       

          Dim swApp                   As SldWorks.SldWorks

          Dim swModel                 As SldWorks.ModelDoc2

          Dim swDraw                  As SldWorks.DrawingDoc

          Dim swSheet                 As SldWorks.Sheet

          Dim swFeat                  As SldWorks.Feature

          Dim swBomFeat               As SldWorks.BomFeature

          Dim sPathName               As String

          Dim nNumSheet               As Long

          Dim nRetval                 As Long

          Dim i                       As Long

          Dim bIsFirstSheet           As Boolean

          Dim bRet                    As Boolean

          Dim fso                     As Scripting.FileSystemObject

          Dim XMLfile                 As Scripting.TextStream

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          Set swDraw = swModel

       

          bIsFirstSheet = True

         

      '-----------------------------------------------------

      ' This section adds the BOM to the Drawing

      '

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

       

      Set swApp = Application.SldWorks

       

      Set Part = swApp.ActiveDoc

      boolstatus = Part.ActivateView("Drawing View1")

      boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.03907265301171, 0.269313374338, 0, False, 0, Nothing, 0)

      boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.07054146514819, 0.2598727306971, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      Dim swActiveView As Object

      Set swActiveView = Part.ActiveDrawingView

      Dim swBOMTable As Object

      Set swBOMTable = swActiveView.InsertBomTable2(False, 0.03515977505523, 0.3102228301154, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft, swBomType_e.swBomType_PartsOnly, "XA67607Q (dia 1.75)(bul 05)", "C:\Documents and Settings\Tom\My Documents\Dropbox\ACS\RHF\VMTEMP\XML to VM-BOM.sldbomtbt")

      '

      ' Done adding the BOM

      '------------------------------------------------------

      '

      ' This is getting the feature name, extracting BOM

      '

          Dim BomName As String

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          Set swDraw = swModel

          Set swFeat = swModel.FirstFeature

       

          Do While Not swFeat Is Nothing

              If "BomFeat" = swFeat.GetTypeName Then

                  Debug.Print "******************************"

                  Debug.Print "Feature Name : " & swFeat.Name

       

                  Set swBomFeat = swFeat.GetSpecificFeature2

                  BomName = swFeat.Name

                 

              End If

              Set swFeat = swFeat.GetNextFeature

             

              If swFeat Is Nothing Then

                  GoTo Line2000

              End If

             

          Loop

         

      Line2000:

       

      MsgBox BomName 'verify that I have the correct BOM

      '

      ' Done getting the BOM name

      '

      '-----------------------------------------------------

       

          ' Strip off SolidWorks file extension (sldxxx)

          ' and add XML extension (xml)

       

          sPathName = swModel.GetPathName

          sPathName = Left(sPathName, Len(sPathName) - 6)

          sPathName = sPathName + "xml"

       

          Set fso = CreateObject("Scripting.FileSystemObject")

          Set XMLfile = fso.CreateTextFile(sPathName, True)

      '

      '-----------------------------------------------------

      '   Visual Manufacturing Header Text

       

          XMLfile.WriteLine "LSAXML"

          XMLfile.WriteBlankLines (1)

          XMLfile.WriteLine "<cad>"

       

          Set swFeat = swModel.FirstFeature

       

          Do While Not swFeat Is Nothing

       

              If "BomFeat" = swFeat.GetTypeName Then

                  Set swBomFeat = swFeat.GetSpecificFeature2

                  ProcessBomFeature swApp, swModel, swBomFeat, XMLfile

              End If

       

              Set swFeat = swFeat.GetNextFeature

      '

          Loop

      '

          XMLfile.WriteLine "</cad>"

       

          XMLfile.Close

       

      End Sub