Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21883

Hello, please help. VB6 & Acad

$
0
0
The challenge is to create the example program in VB. Merge AutoCad, Excel. We need to open AutoCAD software, file, identify the drawing, text boxes, and change them to a table in VB6 is ehsel.V Ole table as in Excel. The problem of how to connect with AutoCAD. If VBA is running at a certain open Excel. I do not want to open AutoCAD. Here is the code that works in VBA .. The sheet drawing yet to be determined. same table several sheets, each sheet is responsible for the drawing.
Private 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("D:\Мои документы\Nina\Шаблоны муфт\Ш1.dwg") 'файл который надо открыть
objAcad.Visible = True
End Sub

Public Sub MoveTextObjects()
Dim Point1(0 To 2) As Double
Dim Point2(0 To 2) As Double
Dim varPnt As Variant
Dim objOLE1 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
ThisDrawing.SelectionSets("TempSSet").Delete
Set objExcel = GetObject(, "Excel.Application")
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("1")
Worksheets("1").Activate
On Error Resume Next
Set objSelectionSet = ThisDrawing.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 + 2
Case 8 To 14
iCol = 3
iRow = i - 7 + 2
Case 15 To 21
iCol = 4
iRow = i - 14 + 2
Case 22 To 28
iCol = 5
iRow = i - 21 + 2
End Select
ValueCell = objExcelSheet.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
End Sub

Help,please.

Viewing all articles
Browse latest Browse all 21883

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>