Задача состоит в том,чтобы создать программку на VB. Объединить AutoCad,Excel. Надо открыть программно автокад,файл ,распознать чертеж,текстовые поля и изменять их их таблицы в Exel.В VB6 есть Ole таблицы,как и в Excel.Проблема в том,как связать с автокадом. Если VBA то работает при определенном открытом Excel. Хочется не открывать автокад. Вот код,работающий в VBA.я пытаюсь его переделать для VB6.Но пока ничего не работает.На листе еще надо определить чертеж,их несколько.так же в таблице несколько листов,каждый лист отвечает за свой чертеж.
- Код: Выделить всё
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
[Viper] :: Пользуйся тэгом CODE!