1

(6 ответов, оставленных в VBA)

Решение представлено здесь
https://www.caduser.ru/forum/topic43895.html

Автору низкий поклон, долго искал. Как подключить regExp здесь
VBA Excel. Регулярные выражения (объекты, свойства, методы)

Как Вам такое извращение?

Function ParseDxfPoint(DxfPoint)

    Dim Pt(2) As Double
    Dim Gap1, Gap2
    Gap1 = InStr(2, DxfPoint, " ", vbTextCompare)
    Pt(0) = Mid(DxfPoint, 2, Gap1 - 1)
    Gap2 = InStr(Gap1 + 1, DxfPoint, " ", vbTextCompare)
    Pt(1) = Mid(DxfPoint, Gap1 + 1, Gap2 - (Gap1 + 1))
    Pt(2) = Mid(DxfPoint, Gap2 + 1, Len(DxfPoint) - (Gap2 + 1))
    ParseDxfPoint = Pt
    
End Function

'SomeCallMeDave
'http://www.vbdesign.net/expresso/showthread.php?postid=83887#post83887
'Changed pAcadObj As AcadObject to pAcadObj As Object to access imagedef as well
'Modified by Jeff Mishler, March 2006, to get the Block table object, not Block_Record table object
Public Function vbAssoc2(pAcadObj, pDXFCode As Integer) As Variant

Dim VLisp As Object
Dim VLispFunc As Object
Dim varRetVal As Variant

Dim obj1 As Object
Dim obj2 As Object

Dim strHnd As String
Dim strVer As String

Dim lngCount As Long
Dim i As Long
Dim J As Long

On Error GoTo vbAssocError
    
If Left(ThisDrawing.Application.Version, 2) = "16" Then
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
Else
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
End If

Set VLispFunc = VLisp.ActiveDocument.Functions


strHnd = pAcadObj.Handle

If TypeOf pAcadObj Is AcadBlock Then
    strHnd = Hex(1 + Val("&H" & strHnd))
End If


Set obj1 = VLispFunc.Item("read").Funcall("pDXF")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, pDXFCode)
Set obj1 = VLispFunc.Item("read").Funcall("pHandle")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, strHnd)
Set obj1 = VLispFunc.Item("read").Funcall("(vl-princ-to-string (cdr (assoc pDXF (entget (handent pHandle)))))")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)

vbAssoc2 = varRetVal

'clean up the newly created LISP symbols
Set obj1 = VLispFunc.Item("read").Funcall("(setq pDXF nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)
Set obj1 = VLispFunc.Item("read").Funcall("(setq pHandle nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)

'release the objects or Autocad gets squirrely (no offense RR)
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing

Exit Function

Добрый день, уважаемые коллеги. Аналогичная тема уже рассматривалась.
http://forum.dwg.ru/showthread.php?t=66011
Подскажите есть ли способ получать точки привязки и назначать точки привязки
размеров. Кроме солянки, ранее предложенной в голову ничего не приходит.

Sub selectRotatedDimension()
Dim returnObj As AcadEntity
Dim temp, startPnt, endPnt, varCancel As Variant
Dim control As Boolean
On Error GoTo Error_Control
control = False
'Программа выполняется до тех пор, пока не выбран нужный примитив или не нажата клавиша ESC
Do Until control = True
    ThisDrawing.Utility.GetEntity returnObj, startPnt, vbCrLf & "Command: Выберите объект типа AcDbRotatedDimension:"
    If returnObj.ObjectName = "AcDbRotatedDimension" Then
        'В командную строку передается LISP-выражение, возвращающее первую точку в WCS (код DXF - 13)
        ThisDrawing.SendCommand ("(cdr (assoc 13 (entget (handent " & """" & returnObj.Handle & """" & "))))" & vbCr)
        temp = Mid(CStr(ThisDrawing.GetVariable("lastprompt")), 2, Len(CStr(ThisDrawing.GetVariable("lastprompt"))) - 2)
        'В переменную startPnt записывается массив с координатами первой точки
        startPnt = Split(temp, " ", , vbTextCompare)
        If IsArray(startPnt) Then
            MsgBox "Первая точка: " & startPnt(0) & ";" & startPnt(1) & ";" & startPnt(2)
        End If
        'В командную строку передается LISP-выражение, возвращающее вторую точку в WCS (код DXF - 14)
        ThisDrawing.SendCommand ("(cdr (assoc 14 (entget (handent " & """" & returnObj.Handle & """" & "))))" & vbCr)
        temp = Mid(CStr(ThisDrawing.GetVariable("lastprompt")), 2, Len(CStr(ThisDrawing.GetVariable("lastprompt"))) - 2)
        'В переменную endPnt записывается массив с координатами второй точки
        endPnt = Split(temp, " ", , vbTextCompare)
        If IsArray(endPnt) Then
            MsgBox "Вторая точка: " & endPnt(0) & ";" & endPnt(1) & ";" & endPnt(2)
        End If
        control = True
    Else
        MsgBox "Выбранный объект не является объектом типа AcDbRotatedDimension."
    End If
Loop
GoTo Exit_Here
Error_Control:
Select Case Err.Number
    Case -2147352567
        varCancel = ThisDrawing.GetVariable("LASTPROMPT")
        If InStr(1, varCancel, "*Cancel*") <> 0 Then
            ThisDrawing.Utility.Prompt "Выполнение программы прервано."
            Err.Clear
            Resume Exit_Here
        Else
            Err.Clear
            Resume
        End If
    Case -2145320928
        Err.Clear
        Resume Exit_Here
    Case Else
        MsgBox Err.Description & " " & Err.Number
        Err.Clear
        Resume Exit_Here
End Select
Exit_Here:
Set returnObj = Nothing
Set temp = Nothing
Set startPnt = Nothing
Set endPnt = Nothing
Set varCancel = Nothing
End Sub

Спасибо!

6

(1 ответов, оставленных в VBA)

К сожалению никак. При помощи VBA не получится

Спасибо Александр. Мои извинения за невнимательность. Не обратил внимания, что коэффициент нулевой.

Добрый день, Александр!
Встречалась ли Вам такая проблема с утилитой, при выборе
элементов (допустим отрезок) все значения нулевые, и как с этим бороться?

9

(6 ответов, оставленных в VBA)

Не претендую на оригинальность, но раз других идей нет то..

Public Function StrReplaceFormat(str As String)
  Dim strArr  As Variant
  Dim strArrW  As Variant
  Dim str_itog As String
  Dim stfindOk As String
  Dim strfindWOk As String
  Dim strfind
  Dim strfindW
  str_itog = ""
  If InStr(str, "{") > 0 And InStrRev(str, "}") > 0 Then
      str = Replace(str, "{", "")
      str = Replace(str, "}", "")
      str = Replace(str, "\P", "")
      strArr = Split(str, ";")
      stfindOk = ""
       For Each strfind In strArr
        If InStr(strfind, "\C") = 0 _
          And InStr(strfind, "\T") = 0 _
          And InStr(strfind, "\f") = 0 _
          And InStr(strfind, "\F") = 0 Then
          stfindOk = strfind
          If InStr(stfindOk, "\W") > 0 Then
             strArrW = Split(stfindOk, " ")
             strfindWOk = ""
            For Each strfindW In strArrW
               If InStr(strfindW, "\W") = 0 Then
                 strfindWOk = strfindWOk + " " + strfindW
               End If
            Next strfindW
             stfindOk = strfindWOk
          End If
         str_itog = str_itog + " " + stfindOk
        End If
       Next strfind
   Else
    str_itog = str
  End If
       StrReplaceFormatColor = str_itog
End Function

10

(6 ответов, оставленных в VBA)

Коллеги - неужели больше никаких идей!

Верно ..Так и сделал. Поэтому неверное решение в коментарии убрал, чтобы не вводить в заблуждение(пример был неудачным). Ещё раз спасибо, гениально и просто.

Благодарю.. Гениально и просто. Что касается остальных примитивов .В первые решение этой проблемы предложил Тони Танзилло. Вы были автором перевода этой статьи http://adn-cis.org/poluchenie-spiska-vi … bloke.html. К сожалению я не силён в C# и переложить код на VBA у меня не получилось.

Если автор нашёл ответ на этот вопрос - прошу опубликовать решение. Очень много потратил время, но не нашёл ответ на эту задачу.

14

(6 ответов, оставленных в VBA)

Как быть с такой строкой {\fTimes New Roman|b0|i0|c204|p18;\C7;тест}. Split по разделителю ";" лишнего нарежет.?Как идея Right при поиске inStrRev..Но тоже есть шанс отрезать лишнего - залезть в нужный текст к примеру {\fTimes New Roman|b0|i0|c204|p18;\C7;-тест; тест 2}... {\fTimes New Roman|b0|i0|c204|p18;\C7;тест\fTimes New Roman|b0|i0|c0|p18;; \fTimes New Roman|b0|i0|c204|p18;тест 2\fTimes New Roman|b0|i0|c0|p18;; \fTimes New Roman|b0|i0|c204|p18;тест 3}

15

(6 ответов, оставленных в VBA)

Добрый вечер уважаемые коллеги, как получить текст из ячейки таблицы без символов форматирования?
Метод objEnt.GetText(n, c) возвращает значение  {\C4;Свайное основание}, как получить только текстовое значение строки?

Добрый день коллеги.. Прочитал много статей, на основе них написал функцию. Определяет блоки с заданным именем в файле чертежа и определяет по ID к какому layoty или на каком они вставлены.Далее определяет габарит.
Сама функция

 
Public Function BlockFrameFound(minExt As Variant, maxExt As Variant, blkname As String) As Boolean

    Dim blocks() As AcadBlockReference
    Dim blkref As AcadBlockReference
    Dim objSpace As AcadBlock
    Dim blkColl As New Collection
    Dim i
    Dim extObjs() As AcadEntity
    Dim fType(0 To 2) As Integer
    Dim fData(0 To 2) As Variant
    Dim dxfCode, dxfValue
        fType(0) = 0: fData(0) = "INSERT"
        fType(1) = 2: fData(1) = "`*U*," & blkname
        fType(2) = 100: fData(2) = "{ACAD_XDICTIONARY"
        dxfCode = fType: dxfValue = fData
    Dim oSset As AcadSelectionSet
    Dim ExtSset As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim oBlkRef As AcadBlockReference
    Dim oBlock As AcadBlock
    Dim oLayout As AcadLayout
    Dim bName As String
    Dim obj As AcadBlock
    Dim item As AcadEntity
    Dim Namelayot As String
        BlockFrameFound = False
        With ThisDrawing.SelectionSets
               While .Count > 0
                    .item(0).Delete
               Wend
          Set oSset = .Add("$BlockSset$")
          Set ExtSset = .Add("$BlockSsetExtracted$")
        End With
        
        oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
        
        If oSset.Count = 0 Then
             BlockFrameFound = False
            Exit Function
           Else
        End If
   
        For Each oEnt In oSset
            Set oBlkRef = oEnt
            Set obj = ThisDrawing.ObjectIdToObject(oEnt.OwnerID)
            If Not obj Is Nothing And obj.IsLayout Then
                Set oLayout = obj.layout
            End If
         If oBlkRef.EffectiveName = blkname Then
            ReDim Preserve extObjs(i) As AcadEntity
            Set extObjs(i) = oBlkRef
            i = i + 1
         End If
        Next oEnt

        If Not IsNull(extObjs) Then
           ExtSset.AddItems (extObjs)
        End If

        If ExtSset.Count = 0 Then
            BlockFrameFound = False
            Exit Function
        End If
        Set objSpace = GetSpase
        If objSpace Is ThisDrawing.ModelSpace Then
          Namelayot = "Model"
            Else
          Namelayot = ThisDrawing.ActiveLayout.Name
        End If

    minExt = Empty
    maxExt = Empty
    For Each item In ExtSset
        Set obj = ThisDrawing.ObjectIdToObject(item.OwnerID)
        Set oLayout = obj.layout
        If oLayout.Name = Namelayot Then
             item.GetBoundingBox minExt, maxExt
               BlockFrameFound = True
              Exit For
        Else
          BlockFrameFound = False
          minExt = Empty
          maxExt = Empty
       End If
    Next item

Err_Control:
    If Err.Number <> 0 Then
    MsgBox Err.Description
    End If

End Function

Проблема  заключается в том что , при переносе на язык VB метод "ObjectIdToObject(item.OwnerID)" не поддерживается. Знаю что VB сам по себе устарел , но задача поставлена обратится к Акаду конкретно из VB (основная часть работающего приложения написана на нём).
Код под VB аналогичен. Кто нибудь сталкивался с такой проблемой? Есть ли какое нибудь ещё решение чтобы определить на каком именно листе вставлен блок с заданным именем?

17

(4 ответов, оставленных в VBA)

Добрый вечер, моя благодарность и поклон.

Добрый день, проблема в том что Вы устанавливаете конфигурацию печати только для модели, а печатаете все листы подряд поэтому ошибка и вылетает. Необходимо для каждого листа установить параметры печати- перебрать циклом все листы с установкой для каждого листа своих параметров. Если будет полезно мои коды печати:

Private Sub CB_PlotPreview_Click()
'On Error Resume Next
Dim StrPlotName As String
Dim frmName As String
Dim Plot_ConfigPlot As Variant
Plot_ConfigPlot = Change_plot(CB_FiltrPrinterName.Text, Cb_FormatFrame.Text)
'Plot_ConfigPlot(0)-каноническое имя
'Plot_ConfigPlot(0)-имя принтера *.pc3
 SetConfigPloter Plot_ConfigPlot(0), Plot_ConfigPlot(1)
  Me.Hide
  ThisDrawing.Plot.DisplayPlotPreview acPartialPreview
  Me.show
'On Error GoTo 0
End Sub

Private Sub SetConfigPloter(StrPlotName, n_f)
    
    Dim ObjLayout As AcadLayout
    Dim Formats As Variant
    Set ObjLayout = ThisDrawing.ActiveLayout
    Set layout = ThisDrawing.ModelSpace.layout
    Dim objSpace As AcadBlock
    Set objSpace = GetSpase
    Dim lcnt As Long
    Dim x As Integer
    Dim point1(0 To 1) As Double
    Dim point2(0 To 1) As Double
    Dim newValue(0 To 1) As Double
    Dim PaperWidth As Double
    Dim PaperHeight As Double
    
    point1(0) = Val(Count_XY1.List(0, 0))
    point1(1) = Val(Count_XY1.List(1, 0))
    point2(0) = Val(Count_XY2.List(0, 0))
    point2(1) = Val(Count_XY2.List(1, 0))
    
    newValue(0) = Val(Plot_U.TB_ORIGINX.Text)
    newValue(1) = Val(Plot_U.TB_ORIGINY.Text)
       
  If objSpace Is ThisDrawing.ModelSpace Then
    With layout
      .RefreshPlotDeviceInfo
      .ConfigName = StrPlotName
      .RefreshPlotDeviceInfo
      .CanonicalMediaName = n_f
      .PlotOrigin = newValue
      .PaperUnits = acMillimeters
      .SetWindowToPlot point1, point2
      .PlotType = acWindow
      .GetPaperSize PaperWidth, PaperHeight
      If Pl_Albom.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac90degrees
         Else
        .PlotRotation = ac0degrees
        End If
      End If
      If PL_Portret.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac0degrees
         Else
        .PlotRotation = ac90degrees
        End If
      End If
      .SetCustomScale TB_NUMERATOR.Text, TB_DENOMINATOR.Text
      .StyleSheet = CB_PRINTSTYLE.Text
      .PlotWithPlotStyles = True
      .PlotWithLineweights = True
    End With
   Else
     With ObjLayout
      .RefreshPlotDeviceInfo
      'MsgBox StrPlotName
      .ConfigName = StrPlotName
     ' MsgBox n_f
      .RefreshPlotDeviceInfo
      .CanonicalMediaName = n_f
      .PlotOrigin = newValue
      .PaperUnits = acMillimeters
      .SetWindowToPlot point1, point2
      .PlotType = acWindow
      .GetPaperSize PaperWidth, PaperHeight
      If Pl_Albom.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac90degrees
         Else
        .PlotRotation = ac0degrees
        End If
      End If
      If PL_Portret.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac0degrees
         Else
        .PlotRotation = ac90degrees
        End If
      End If
      .SetCustomScale TB_NUMERATOR.Text, TB_DENOMINATOR.Text
      .StyleSheet = CB_PRINTSTYLE.Text
      .PlotWithPlotStyles = True
      .PlotWithLineweights = True
    End With
   End If

End Sub
Public Function GetSpase() As AcadBlock
  Dim objSpace As AcadBlock
  Dim intTILEMODE As Integer
  Dim intCVPORT As Integer
  On Error GoTo Exit_Here
  intTILEMODE = CInt(ThisDrawing.GetVariable("TILEMODE"))
  If intTILEMODE = 1 Then
    Set objSpace = ThisDrawing.ModelSpace
  Else
    intCVPORT = CInt(ThisDrawing.GetVariable("CVPORT"))
    If intCVPORT = 1 Then
      Set objSpace = ThisDrawing.PaperSpace
    Else
      Set objSpace = ThisDrawing.ModelSpace
    End If
  End If
Exit_Here:
  Set GetSpase = objSpace
  Set objSpace = Nothing
End Function

19

(4 ответов, оставленных в VBA)

Здравствуйте уважаемые коллеги. Как программно можно открывать базу данных чертежа без визуального открытия файла - для пакетной обработки, чтобы не заставлять пользователя смотреть, как перед его глазами открывается/модифицируется и сохраняется чертёж?

20

(6 ответов, оставленных в AutoCAD)

День добрый! Проблема так и не была решена, на данный момент я привожу к одному масштабу при помощи блока. Если применительно к Вашему примеру, то все ЛЭПки вставляются в блок, а далее изменяется масштаб по оси Y в свойствах блока с 1-цы на 0.2.

Функция составлена из элементов кода форума

(defun get_vertices (obj / i verts)
  (setq i (vlax-curve-getendparam obj))
  (while (>= i 0)
    (setq verts  (cons (vlax-curve-getpointatparam obj i) verts)
    i  (- i 1)
    )
  )
 verts
) 
;|======================================================================================= 
*    Функция возвращает vla-активное пространство (лист / модель). 
*    Параметры вызова: 
*   Нет 
*    Примеры вызова: 
(_kpblc-get-active-space-obj) 
=======================================================================================|; 
(defun _kpblc-get-active-space-obj () 
   (setq    *kpblc-acad*   (vlax-get-acad-object)
            *kpblc-activedoc* (vla-get-activedocument *kpblc-acad*)    
    ) ;_ end of setq
    (if (and (zerop (vla-get-activespace *kpblc-activedoc*)) 
      (= :vlax-false (vla-get-mspace *kpblc-activedoc*)) 
      ) ;_ end of and 
    (vla-get-paperspace *kpblc-activedoc*) 
    (vla-get-modelspace *kpblc-activedoc*) 
    ) ;_ end of if 
  ) ;_ end of defun

(defun draw-polyline (lst) ; Функция отрисовки полилинии по заданному списку
;;; Преобразовываем полученный список точек в гарантированно ;;; список 3Д-точек и сразу преобразовываем его в одномерный
  (setq lst (apply 'append
                   (mapcar '(lambda (x)
                              (list (car x)
                                    (cadr x)
                                    (cond ((caddr x))
                                          (t 0.)
                                          ) ;_ end of cond
                                    ) ;_ end of list
                              ) ;_ end of lambda
                           lst
                           ) ;_ end of mapcar
                   ) ;_ end of apply
        ) ;_ end of setq
  (vla-addpolyline ; добавляем полилинию
    (_kpblc-get-active-space-obj) 
      (vlax-make-variant ; создаем вариант
      (vlax-safearray-fill ; из заполняемого безопасного массива
        (vlax-make-safearray ; создаем безопасный массив
          vlax-vbdouble ; с элементами типа Double (числа двойной точности)
          (cons 0 (1- (length lst))) ; длиной в полученный lst.
          ) ;_ end of vlax-make-safearray
        lst ; и заполняем данными из списка
        ) ;_ end of vlax-safearray-fill
      ) ;_ end of vlax-make-variant
    ) ;_ end of vla-AddPolyline
  ) ;_ end of defun

(defun c:point-poly ( / )
 (vl-load-com)
 (setq obj_one nil)
   (setq lst_sectPoly nil)
    (setq obj_one (car (entsel "\nУкажите полилинию <Отмена> : ")))
             (if (= obj_one nil) (princ "\nНичего не выбрано..."))
         (setq obj_one (vlax-ename->vla-object obj_one)) 
  (setq vert_poly (get_vertices obj_one))
 (setq pointPly (getpoint "\nУкажите точку <Отмена> : "))
  (foreach item vert_poly 
  (draw-polyline (list item  pointPly))
    )           
 )

Большое спасибо за помощь!

Именно мне надо скрыть построения. Основная функция написана на lispe, поэтому и получается гремучая смесь. Поскольку .net под рукой нет проверить не могу. Если я не прав прошу не винить - только начинаю изучение.

acedUpdateDisplayPause(true) 
   frm3.Show() 
            Application.MainWindow.Visible = False 
            ThisDrawing.SendCommand("(Bottom_reamer) ") 
            Application.MainWindow.Visible = True 
            frm3.Close() 
acedUpdateDisplayPause(false)
acedUpdateDisplay() 

Надо ли давать ссылку на *.dll при работе P/Invoke в проекте?
Не забыл ли я чего перед aced...?
Не произойдёт ли в этом случае, что сначало дисплей потухнет и
включиться, а только потом начнёться исполнение lisp функции (Bottom_reamer)?
Заранее прошу прощенье, если задаю глупый вопрос, VB.net для меня малознаком.

День добрый! Столкнулся с проблемой: как скрыть построения с глаз пользователя. Как решить проблему сообразить не могу.
Примерно понимаю, как это сделать:
В примере описанном ниже у меня 1-ой запускаеться модальная форма,
в которой происходит заполнение исходных данных. Далее по кнопке
ok закрываеться первая форма и всплывает немодальная форма
говорящая, что идёт формирование чертежа. Acad делается невидимым,
функция lispa делает необходимые построения, после чего Acad делается видимым и
немодальное окно закрывается.

У меня получаеться при отработки кода иначе. Всплывает немодальная форма ->
Acad исчезает -> потом появляется-> форма закрываеться и начинает происходить
построение.

Как сделать так чтоб, только после отработки lisp функции Acad появился и
закрылось немодальное окно?

Как притушить текущий чертёж, чтоб не гасить весь Acad?

'Contains the AutoCAD Type Library
Imports Autodesk.AutoCAD.Interop
'Contains the AutoCAD/ObjectDBX Type Library Imports Autodesk.AutoCAD.Interop.Common Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Geometry



Public Class AdskCommands
    Public ReadOnly Property ThisDrawing() As  _
    AcadDocument
        Get
            Return Autodesk.AutoCAD. _
            ApplicationServices.Application. _
            DocumentManager.MdiActiveDocument. _
            AcadDocument
        End Get
    End Property

    <Autodesk.AutoCAD.Runtime.CommandMethod("Bottom")> _
    Public Sub myRoutine()
        Dim frm As Dialog1
        Dim frm3 As Dialog3
        frm = New Dialog1
        frm.ShowDialog()
        frm3 = New Dialog3
        If frm.DialogResult = Windows.Forms.DialogResult.OK Then
            frm3.Show()
            Application.MainWindow.Visible = False
            ThisDrawing.SendCommand("(Bottom_reamer) ")
            Application.MainWindow.Visible = True
            frm3.Close()
        End If
    End Sub
End Class

В качестве примера привожу кусок своего кода :

 (or Gb:AcO (setq Gb:AcO (vlax-get-acad-object)))
 (or Gb:AcD (setq Gb:AcD (vla-get-ActiveDocument Gb:AcO)))
 (setq ExtDic (vla-GetExtensionDictionary (vla-get-ModelSpace Gb:AcD)))
 
(setq SreTbl (vla-AddObject ExtDic "ACAD_SORTENTS" "AcDbSortentsTable"))

Под ХP работает без проблем, а вот под win 7 появляется неприятность такого рода
при обращении к словарю

(setq SreTbl (vla-AddObject ExtDic "ACAD_SORTENTS" "AcDbSortentsTable"))

Ошибка Automation. Элемента AcRxClassName нет в системном реестре

Подскажите пожалуйста, как выйти из этой ситуации.