Question : AUTOCAD Bill of Materails Generation

Hi friends,

I am woking in a manufacutring company. What can I do to transfer BOM list created in Autocad to my sql server database. Please help me. how can I retrieve data from autocad drawing?

Answer : AUTOCAD Bill of Materails Generation

Attached is full code to capture the text on the table layout that is in the drawing that was posted.  It is in acad VBA. You will need to itterate through the array and get the information.

If you need more help let us know.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:

Option Explicit
Public iDs() As Long
Function GetTextForDB()
    Dim groupCode As Variant, dataCode As Variant
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    Dim msetA As AcadSelectionSet
    Dim mIi As Long
    Set msetA = Aset("TEXTFILE")
    gpCode(0) = 0
    dataValue(0) = "MTEXT,TEXT"
    'gpCode(1) = 0
    'dataValue(1) = "TEXT"
    groupCode = gpCode
    dataCode = dataValue
    AcadApplication.Visible = acTrue
    ThisDrawing.Regen acActiveViewport
    msetA.SelectOnScreen groupCode, dataCode
    SortSSets msetA, 7
    'Here is where you need to do the checking for what ever you are looking for
    'then do the database stuff insert/update....
End Function
Public Sub SortSSets(Aset As AcadSelectionSet, iNCols As Long)
    Dim mI As Long, mN As Long, Pta() As Double, Ptb() As Double, Swp As Long, Ptc() As Double
    Dim mK As Long
    ReDim iDs(0 To Aset.Count - 1)
    For mI = 0 To Aset.Count - 1
        iDs(mI) = mI
    Next
    For mI = 0 To Aset.Count - 2
        For mN = mI + 1 To Aset.Count - 1
            Pta = Aset(iDs(mI)).InsertionPoint
            Ptb = Aset(iDs(mN)).InsertionPoint
            If Pta(1) < Ptb(1) Then
                Swp = iDs(mI)
                iDs(mI) = iDs(mN)
                iDs(mN) = Swp
            End If
        Next
    Next
    For mK = 0 To Aset.Count Step iNCols
        For mI = mK To (mK + iNCols - 2)
            For mN = mI + 1 To (mK + iNCols - 1)
                If mN < Aset.Count Then
                    Pta = Aset(iDs(mI)).InsertionPoint
                    Ptb = Aset(iDs(mN)).InsertionPoint
                    If Pta(0) > Ptb(0) Then
                        Swp = iDs(mI)
                        iDs(mI) = iDs(mN)
                        iDs(mN) = Swp
                    End If
                End If
            Next
        Next
    Next
End Sub

Private Function Aset(iSSetName As String) As AcadSelectionSet
    Dim msetA As AcadSelectionSet
    On Error Resume Next
    Set msetA = ThisDrawing.SelectionSets.Add(iSSetName)
    If Err.Number <> 0 Then
        Set msetA = ThisDrawing.SelectionSets(iSSetName)
        msetA.Delete
        Set msetA = ThisDrawing.SelectionSets.Add(iSSetName)
        Err.Clear
    End If
    On Error GoTo 0
    Set Aset = msetA
End Function
Random Solutions  
 
programming4us programming4us