Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
extract autocad attributes to access
- Thread starter kdoran
- Start date
- Thread starter
- #4
mhaff,
What I would like to do is take the the title block and a few other blocks (not sure on the terms) or attributes and import them into an access database which could be through excel or a text file or other. I would like to be able to do more than one at a time. Any ideas
Thanks,
Kelly
What I would like to do is take the the title block and a few other blocks (not sure on the terms) or attributes and import them into an access database which could be through excel or a text file or other. I would like to be able to do more than one at a time. Any ideas
Thanks,
Kelly
Kelly,
Here is a sample of what I use to import all text from autocad to access directly. You can change the paameters to look for attribute block with specific titles. I call this function thru a loop to import over 1000 drawings.
Function Transfer_ACText_To_Access(sDwg As String, sLoc As String, Min As Integer, Max As Integer)
Dim value As Object
Dim rst As New Recordset
'Dim insertionPoint(0 To 2) As Variable
Dim currInsertionPoint As Variant
rst.Open "tblData", CurrentProject.Connection, adOpenStatic, adLockOptimistic
Set AC = Nothing
On Error Resume Next
Set AC = GetObject(, "AutoCAD.Application"
If Err <> 0 Then
Set AC = CreateObject("AutoCAD.Application"
MsgBox "You have to open a dwg. file in AutoCad " & _
"first and let the commandline stay empty"
Exit Function
End If
AC.Visible = False
Set doc = AC.ActiveDocument
Set mspace = doc.ModelSpace
For Each value In mspace
With value
If StrComp(.EntityName, "AcDbMText", 1) = 0 Or StrComp(.EntityName, "AcDbText", 1) = 0 Then
'Selection.TypeText Text:=.TextString This is for word
'Selection.TypeParagraph
If Len(.TextString) >= Min And Len(.TextString) <= Max Then
currInsertionPoint = .insertionPoint
rst.AddNew
rst.Fields("Data" = .TextString
rst.Fields("Layer" = .Layer
rst.Fields("Color" = .Color
rst.Update
rst.MoveNext
End If
End If
End With
Next value
rst.Close
value = Nothing
Set AC = Nothing
'MsgBox "Finished"
End Function
Praxden
Here is a sample of what I use to import all text from autocad to access directly. You can change the paameters to look for attribute block with specific titles. I call this function thru a loop to import over 1000 drawings.
Function Transfer_ACText_To_Access(sDwg As String, sLoc As String, Min As Integer, Max As Integer)
Dim value As Object
Dim rst As New Recordset
'Dim insertionPoint(0 To 2) As Variable
Dim currInsertionPoint As Variant
rst.Open "tblData", CurrentProject.Connection, adOpenStatic, adLockOptimistic
Set AC = Nothing
On Error Resume Next
Set AC = GetObject(, "AutoCAD.Application"
If Err <> 0 Then
Set AC = CreateObject("AutoCAD.Application"
MsgBox "You have to open a dwg. file in AutoCad " & _
"first and let the commandline stay empty"
Exit Function
End If
AC.Visible = False
Set doc = AC.ActiveDocument
Set mspace = doc.ModelSpace
For Each value In mspace
With value
If StrComp(.EntityName, "AcDbMText", 1) = 0 Or StrComp(.EntityName, "AcDbText", 1) = 0 Then
'Selection.TypeText Text:=.TextString This is for word
'Selection.TypeParagraph
If Len(.TextString) >= Min And Len(.TextString) <= Max Then
currInsertionPoint = .insertionPoint
rst.AddNew
rst.Fields("Data"
= .TextStringrst.Fields("Layer"
= .Layerrst.Fields("Color"
= .Colorrst.Update
rst.MoveNext
End If
End If
End With
Next value
rst.Close
value = Nothing
Set AC = Nothing
'MsgBox "Finished"
End Function
Praxden
- Thread starter
- #6
- Status