Good day! I had such a problem.
The problem is this:
1. extract data from Excel and Used in the form of VB ( MSFlexGrid)- no problem
2.change the data in the form of VB ( MSFlexGrid)-no problem
3.open acad file. select from the drawings (determine what kind ) and the desired text data to change it from MSFlexGrid
4.Print this drawing adn save
problem with items 3,4. How to link a cell and text.
Public Sub Command2_Click()
Dim objAcad As Object
Dim docAcad As Object
Set objAcad = CreateObject("AutoCad.Application")
Set objAcad = GetObject(, "AutoCad.Application")
Set docAcad = objAcad.Documents.Open(App.Path & "\1.dwg")
objAcad.Visible = True
Call MoveTextObjects
End Sub
Public Sub MoveTextObjects()
Dim Point1(0 To 2) As Double
Dim Point2(0 To 2) As Double
Dim varPnt As Variant
Dim objMSFlexGrid As Object
Dim objSelectionSet As AcadSelectionSet
Dim ValueCell As String
Dim varValueTxtStr As Variant
Dim i, Y, iRow, iCol As Integer
Dim textObj As AcadEntity
Dim ZValue As Double
On Error Resume Next
Application.ActiveDocument.ModelSpace.SelectionSets("TempSSet").Delete
On Error Resume Next
Set objSelectionSet = Application.ActiveDocument.ModelSpace.SelectionSets.Add("TempSSet")
If Err Then
Err.Clear
End If
On Error GoTo Err_Control
objSelectionSet.SelectOnScreen
For Each textObj In objSelectionSet
If TypeOf textObj Is AcadText Then
If IsNumeric(textObj.TextString) Then
varValueTxtStr = textObj.TextString
i = CInt(varValueTxtStr)
Select Case i
Case 1 To 7
iCol = 2
iRow = i + 1
Case 8 To 14
iCol = 3
iRow = i - 7 + 1
Case 15 To 21
iCol = 4
iRow = i - 14 + 1
Case 22 To 28
iCol = 5
iRow = i - 21 + 1
End Select
ValueCell = MSFlexGrid1.Cells(iRow, iCol)
textObj.TextString = ValueCell
End If
ZValue = CDbl(textObj.TextString)
varPnt = textObj.InsertionPoint
varPnt(2) = ZValue
textObj.InsertionPoint = varPnt
textObj.Update
End If
End If
Next
objSelectionSet.Delete
Exit_Here:
Exit Sub
Err_Control:
Debug.Print Err.Description & vbCr & Err.Number
Resume Exit_Here
End Sub
Private Sub Form_Unload(Cancel As Integer)
docAcad.Close (True)
objAcad.Quit
Set docAcad = Nothing
Set objAcad = Nothing
Unload Me
Set obj = Nothing
Call Descargar
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command5_Click()
Dim plotFileName As String
If ThisDrawing.ActiveSpace = acPaperSpace Then
ThisDrawing.MSpace = True
ThisDrawing.ActiveSpace = acModelSpace
End If
ThisDrawing.ModelSpace.Layout.PlotType = acExtents
ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
ThisDrawing.Plot.NumberOfCopies = 1
' plotFileName =
'
'ThisDrawing.Plot.PlotToFile (plotFileName)
' ThisDrawing.Plot.PlotToDevice
End Sub