set AcadApp = getAutoCadApplication(true)
if not AcadApp is Nothing then
On error resume next
err.Clear
AcadApp.Documents.Open(PathFile) ' PathFile - Путь к файлу
if err.Number = 0 Then
set ActiveDoc = AcadApp.ActiveDocument
DCount = 0
' Проверяем листы:
for each item in ActiveDoc.Layouts
If not item.ModelType Then
for each block in item.Block
if block.EntityName = "AcDbRotatedDimension" then DCount = DCount + 1
' Поиск остальных размеров ...
next
End If
next
else
msg = msg + "Не удалось открыть чертеж: " & PathFile & vbCrLf
end if
end if
' После работы необходимо за собой убрать:
if not AcadApp is Nothing then
if (AcadApp.Documents.Count = 0) then
AcadApp.Quit()
end if
end if
' Получение экземпляра AutoCAD
Public Function getAutoCadApplication(bOpen) '* as AutoCad.Application
set getAutoCadApplication = Nothing
On error resume next
err.Clear
Set Acad = GetObject(,"AutoCAD.Application")
If err.Number <> 0 Then
err.Clear
if bOpen then
Set Acad = CreateObject("AutoCAD.Application")
If Err.Number <> 0 Then
MsgBox "Не удалось запустить AutoCad!", vbCritical
Exit Function
End If
end if
End If
set getAutoCadApplication = Acad
End Function