Nano Hash - криптовалюты, майнинг, программирование

Открытие файла dwg ACAD в открытом приложении ACAD с помощью vba

У меня есть файл excel с номерами деталей, указанными в столбце. При запуске код разбивает первый введенный номер детали. В первой половине код находит подпапку, содержащую номера деталей этой категории, а во второй половине — фактическое имя файла. Пример 01T-1001-01. 01T — это имя подпапки, а 1001-01 — имя файла, оно разбивается на -. Однако иногда описания детали добавляются в скобках, например 1001-01 (Chuck). Вот для чего нужна дикая карта.

Предполагается, что код сначала проверяет, открыт ли AutoCAD, если да, то откройте dwg в ​​открытом приложении AutoCAD, если нет, то откройте новое приложение.

Проблема в том, что он откроет один чертеж (первый в списке), но выдаст ошибку «Ошибка времени выполнения« 438 »: объект не поддерживает это свойство или метод». список

ОБНОВЛЕННЫЙ код ниже:

Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object
Sub Open_Dwg()

Dim Wildcard As String
Dim path As String
Dim target As String
Dim SplitString() As String
Dim i As Integer
Dim a As Integer

i = 1

If ACAD Is Nothing Then
    Set ACAD = CreateObject("AutoCad.Application")

    If ACAD Is Nothing Then
        MsgBox "Could not start AutoCAD.", vbCritical
        Exit Sub
    End If
    Else
        Set ACAD = GetObject(, "AutoCAD.Application")
End If

Set ACADApp = ACAD
ACADApp.Visible = True

Do Until Cells(i, 1).Value = ""
ACADPath = ""
Wildcard = ""
OpenString = ""

path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
target = Cells(i, 1).Value 'Get Targeted Cell Value
target = UCase(target) 'All Letters to Upper Case
SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
path = path & "\" & SplitString(0) & "\" 'Build Complete Path

OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard

If Dir(OpenString) <> "" Then
        ACADPath = OpenString
        OpenFile (ACADPath)
    Else
            If Wildcard <> "" Then 'If Not Then Use Wildcard
                ACADPath = path & Wildcard
                OpenFile (ACADPath)
            Else
                MsgBox ("File " & target & " Not Found")
            End If
    End If
i = i + 1
Loop
End Sub

Function OpenFile(ByVal ACADPath As String) As String
    Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)
End Function
excel vba autocad
26.06.2017

  • Разве команда открытия в Автокаде не такая? Application.Documents.Open sFilename 26.06.2017
  • ИДК, позвольте мне попробовать .... Нет 26.06.2017

Ответы:


1

Вот базовая оболочка того, что я использую в нашем производственном приложении:

Sub Open_Dwg()
   On Error Resume Next

   Dim ACADApp As AcadApplication
   Dim a As Object

   Set a = GetObject(, "AutoCAD.Application")

   If a Is Nothing Then
      Set a = CreateObject("AutoCAD.Application")

      If a Is Nothing Then
         MsgBox "AutoCAD must be running before performing this action.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = a
   ACADApp.Visible = True
   Set ACADApp.ActiveDocument = ACADApp.Documents.Open("<your filename>")
End Sub

Обратите внимание на модификацию вызова GetObject и способ открытия документа.

ИЗМЕНИТЬ:

Используя приведенный выше код в качестве отправной точки и применив его к коду OP, вы получите следующее:

Option Explicit

Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object

Sub Open_Dwg()
   Dim Wildcard As String
   Dim OpenString As String
   Dim path As String
   Dim target As String
   Dim SplitString() As String
   Dim i As Integer
   Dim a As Integer

   'get or create an instance of autocad
   On Error Resume Next
   Set ACAD = Nothing
   Set ACAD = GetObject(, "AutoCAD.Application")

   If ACAD Is Nothing Then
      Set ACAD = CreateObject("AutoCad.Application")

      If ACAD Is Nothing Then
         MsgBox "Could not start AutoCAD.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = ACAD
   ACADApp.Visible = True
   On Error GoTo 0

   'process files
   i = 1

   Do Until Cells(i, 1).Value = ""
      path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
      target = UCase(Cells(i, 1).Value) 'Get Targeted Cell Value
      SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
      path = path & "\" & SplitString(0) & "\" 'Build Complete Path
      OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
      Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard

      If Dir(OpenString) <> "" Then
         OpenFile OpenString
      Else
         If Wildcard <> "" Then 'If Not Then Use Wildcard
            OpenFile path & Wildcard
         Else
            MsgBox ("File " & target & " Not Found")
         End If
      End If

      i = i + 1
   Loop
End Sub

Function OpenFile(ByVal ACADPath As String) As String
    ACADApp.Documents.Open ACADPath
End Function
26.06.2017
  • не нравится Set ACAD = GetObject(, "ACAD.Application") Я получаю сообщение об ошибке Компонент ActiveX не может создать объект 27.06.2017
  • Если я перемещу Set ACAD = GetObject(, "ACAD.Application") в оператор If после else, я получу неверное имя файла. Я использую путь к файлу плюс имя файла &.dwq в Set ACADApp.ActiveDocument = ACADApp.Documents.Open("<your filename>") 27.06.2017
  • Ваш ProgID в ACAD.Application неверен. Это должен быть AutoCAD.Application. 27.06.2017
  • Хорошо, у меня был лишний \ в пути. Работает! 27.06.2017
  • Таким образом, он работает и открывает чертеж, однако выдает ошибку, когда объект не поддерживает это свойство или метод. Но он открывает файл. Он не позволяет другим чертежам открываться в цикле. 27.06.2017
  • Эта строка кода должна работать нормально. Возможно, вы могли бы добавить в свой исходный пост обновленный код, чтобы мы могли продолжить расследование? 27.06.2017
  • Измените Set ACADApp.ActiveDocument = ACADApp.Documents.Open(‹ваше имя файла›) на ACADApp.Documents.Open ‹ваше имя файла›. Другими словами, не устанавливайте ActiveDocument. 28.06.2017
  • Теперь это работает. У меня было Set ACADApp.Document = ACADApp.Documents.Open(ACADPath), и я изменил его на ACADApp.Documents.Open ACADPath. Я не видел, чтобы вы избавились от Set. Спасибо. 28.06.2017
    • Новые материалы
    Кластеризация: более глубокий взгляд
    Кластеризация — это метод обучения без учителя, в котором мы пытаемся найти группы в наборе данных на основе некоторых известных или неизвестных свойств, которые могут существовать. Независимо от..
    Как написать эффективное резюме
    Предложения по дизайну и макету, чтобы представить себя профессионально Вам не позвонили на собеседование после того, как вы несколько раз подали заявку на работу своей мечты? У вас может..
    Частный метод Python: улучшение инкапсуляции и безопасности
    Введение Python — универсальный и мощный язык программирования, известный своей простотой и удобством использования. Одной из ключевых особенностей, отличающих Python от других языков, является..
    Как я автоматизирую тестирование с помощью Jest
    Шутка для победы, когда дело касается автоматизации тестирования Одной очень важной частью разработки программного обеспечения является автоматизация тестирования, поскольку она создает..
    Работа с векторными символическими архитектурами, часть 4 (искусственный интеллект)
    Hyperseed: неконтролируемое обучение с векторными символическими архитектурами (arXiv) Автор: Евгений Осипов , Сачин Кахавала , Диланта Хапутантри , Тимал Кемпития , Дасвин Де Сильва ,..
    Понимание расстояния Вассерштейна: мощная метрика в машинном обучении
    В обширной области машинного обучения часто возникает необходимость сравнивать и измерять различия между распределениями вероятностей. Традиционные метрики расстояния, такие как евклидово..
    Обеспечение масштабируемости LLM: облачный анализ с помощью AWS Fargate и Copilot
    В динамичной области искусственного интеллекта все большее распространение получают модели больших языков (LLM). Они жизненно важны для различных приложений, таких как интеллектуальные..