Решение представлено здесь
https://www.caduser.ru/forum/topic43895.html
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Настройки поиска (Страница 1 из 3)
Форумы CADUser → Сообщения от VasiliyChe
Сообщений найдено с 1 по 25 из 56
1 3 октября 2018г. 08:41:37
Re: Текст без символов форматирования (6 ответов, оставленных в VBA)
2 3 октября 2018г. 08:40:02
Re: VBA. Удаления форматирования текста (6 ответов, оставленных в Готовые программы)
Автору низкий поклон, долго искал. Как подключить regExp здесь
VBA Excel. Регулярные выражения (объекты, свойства, методы)
3 26 марта 2018г. 20:14:01
Re: Как получить доступ к точкам привязки размеров, средствами VBA (AcadDimRotated) (1 ответов, оставленных в VBA)
Как Вам такое извращение?
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
4 26 марта 2018г. 17:22:14
Тема: Как получить доступ к точкам привязки размеров, средствами VBA (AcadDimRotated) (1 ответов, оставленных в VBA)
Добрый день, уважаемые коллеги. Аналогичная тема уже рассматривалась.
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
5 26 марта 2018г. 17:15:08
Re: Как определить на каком именно листе вставлен блок (2 ответов, оставленных в VBA)
Спасибо!
6 26 марта 2018г. 17:13:31
Re: как добавить аннотативность тексту на VBA (1 ответов, оставленных в VBA)
К сожалению никак. При помощи VBA не получится
7 19 октября 2017г. 08:53:02
Re: ObjectARX. GeomProps - площадь, длина, объем выбранных примитивов (526 ответов, оставленных в Готовые программы)
Спасибо Александр. Мои извинения за невнимательность. Не обратил внимания, что коэффициент нулевой.
8 18 октября 2017г. 13:46:26
Re: ObjectARX. GeomProps - площадь, длина, объем выбранных примитивов (526 ответов, оставленных в Готовые программы)
Добрый день, Александр!
Встречалась ли Вам такая проблема с утилитой, при выборе
элементов (допустим отрезок) все значения нулевые, и как с этим бороться?
9 13 сентября 2016г. 14:09:26
Re: Текст без символов форматирования (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 13 сентября 2016г. 10:41:39
Re: Текст без символов форматирования (6 ответов, оставленных в VBA)
Коллеги - неужели больше никаких идей!
11 2 сентября 2016г. 11:19:45
Re: Как отличить видимые и невидимые примитивы в динамическом блоке (5 ответов, оставленных в VBA)
Верно ..Так и сделал. Поэтому неверное решение в коментарии убрал, чтобы не вводить в заблуждение(пример был неудачным). Ещё раз спасибо, гениально и просто.
12 2 сентября 2016г. 10:23:33
Re: Как отличить видимые и невидимые примитивы в динамическом блоке (5 ответов, оставленных в VBA)
Благодарю.. Гениально и просто. Что касается остальных примитивов .В первые решение этой проблемы предложил Тони Танзилло. Вы были автором перевода этой статьи http://adn-cis.org/poluchenie-spiska-vi … bloke.html. К сожалению я не силён в C# и переложить код на VBA у меня не получилось.
13 1 сентября 2016г. 10:06:59
Re: Как отличить видимые и невидимые примитивы в динамическом блоке (5 ответов, оставленных в VBA)
Если автор нашёл ответ на этот вопрос - прошу опубликовать решение. Очень много потратил время, но не нашёл ответ на эту задачу.
14 29 августа 2016г. 20:43:32
Re: Текст без символов форматирования (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 29 августа 2016г. 17:52:28
Тема: Текст без символов форматирования (6 ответов, оставленных в VBA)
Добрый вечер уважаемые коллеги, как получить текст из ячейки таблицы без символов форматирования?
Метод objEnt.GetText(n, c) возвращает значение {\C4;Свайное основание}, как получить только текстовое значение строки?
16 10 августа 2016г. 17:14:00
Тема: Как определить на каком именно листе вставлен блок (2 ответов, оставленных в VBA)
Добрый день коллеги.. Прочитал много статей, на основе них написал функцию. Определяет блоки с заданным именем в файле чертежа и определяет по 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 20 марта 2016г. 18:59:28
Re: Доступ к чертежу без его открытия (4 ответов, оставленных в VBA)
Добрый вечер, моя благодарность и поклон.
18 18 марта 2016г. 08:51:05
Re: DisplayPlotPreview выдаёт ошибку Method 'Application' of object "IAcadPlot' failed (1 ответов, оставленных в 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 17 марта 2016г. 21:25:19
Тема: Доступ к чертежу без его открытия (4 ответов, оставленных в VBA)
Здравствуйте уважаемые коллеги. Как программно можно открывать базу данных чертежа без визуального открытия файла - для пакетной обработки, чтобы не заставлять пользователя смотреть, как перед его глазами открывается/модифицируется и сохраняется чертёж?
20 3 июня 2015г. 08:20:09
Re: Привидение к одному масштабу (6 ответов, оставленных в AutoCAD)
День добрый! Проблема так и не была решена, на данный момент я привожу к одному масштабу при помощи блока. Если применительно к Вашему примеру, то все ЛЭПки вставляются в блок, а далее изменяется масштаб по оси Y в свойствах блока с 1-цы на 0.2.
21 11 октября 2011г. 13:11:24
Re: Как из точки построить отрезки к вершинам полилинии ? (3 ответов, оставленных в LISP)
Функция составлена из элементов кода форума
(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)) ) )
22 24 марта 2011г. 13:09:41
Re: Как скрыть построения lisp функции с глаз пользователя (4 ответов, оставленных в .NET)
Большое спасибо за помощь!
23 24 марта 2011г. 11:56:28
Re: Как скрыть построения lisp функции с глаз пользователя (4 ответов, оставленных в .NET)
Именно мне надо скрыть построения. Основная функция написана на 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 для меня малознаком.
24 24 марта 2011г. 09:28:18
Тема: Как скрыть построения lisp функции с глаз пользователя (4 ответов, оставленных в .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
25 19 февраля 2011г. 11:14:50
Тема: Ошибка Automation. Элемента AcRxClassName нет в системном реестре (1 ответов, оставленных в LISP)
В качестве примера привожу кусок своего кода :
(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 нет в системном реестре
Подскажите пожалуйста, как выйти из этой ситуации.
Сообщений найдено с 1 по 25 из 56
Форумы CADUser → Сообщения от VasiliyChe
Форум работает на PunBB, при поддержке Informer Technologies, Inc