Первые шаги: Автоматизация работы в nanoCAD с помощью Visual Basic for Applications (Excel)

dows · October 1, 2014

Интересная статья Дмитрия Руденко, активного посетителя нашего форума: http://habrahabr.ru/post/238867/

Будет очень полезна для начинающих, желающих автоматизировать свою работу по созданию чертежей.

смотрите-читайте другие советы Дмитрия Руденко на нашем форуме тут: http://forum.nanocad.ru/index.php?showforum=143

Александр_ · October 30, 2014

Здравствуйте. Собирал информацию по крупинкам по всему интернету. Очень не хватает конкретных примеров. Оставлю здесь свой труд, дабы помочь начинающим.

Для начала так. Научат подключится к nanoCad из Excel. Так проще отсеивать ошибки в коде, смотрим возможные функции, методы и т.д.

Так же устанавливаем "Средства разработки (SDK)" (при установке nanoCad). После установки будет доступно "C:\Program Files\Nanosoft\nanoCAD 5.1\SDK\docs\" . Мне помог файл "NCadSDK.chm". Если зарегистрироватся в клубе разработчиков, можно взять обновленные файлы справки. Хотя примеров там почти нету (ни в клубе разработчиков ни в файлах справок старых и обновленных), может плохо искал.

Есть на русском языке хелп для Autocad. Некоторые функции AutoCad и nanoCad либо одинаковы, либо похоже называються. Поэтому ресурс по ссылке выше мне помог даже больше чем файлы справок SDK от nanoCad.

Если с VBA плохо дело, обязательно прочтите про "синтаксис vba".

Ну и наконец, самое главное. Пример.

Данный пример перебирает открытые документы, в каждом документе меняет шриф (на GOST type A), ширину шрифта (на 1), наклон шрифта (на 5 градусов) для всех текстовых стилей документа, и меняет толщину (вес) всех обектов документа (линии, дуги, полилинии, в общем все что имеет толщину 0,25 на толщину 0,50).

Option Explicit 'что бы не напутать с переменными
'Дальше все чтобы работать из excell
Sub NANO()
Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True

Dim ThisDrawing As nanoCAD.Document
'необходим хотя бы один открытый документ, иначе текущего документа нет, следовательно ошибка будет
Set ThisDrawing = app.ActiveDocument

Dim ms As AcadModelSpace
Set ms = ThisDrawing.ModelSpace

Dim ut As nanoCAD.Utility
Set ut = ThisDrawing.Utility

Dim server As McCOM2.IServer
Set server = CreateObject("McCOM2.Server")

Dim spdsobjects As McCOM2.ObjectsCollection
Set spdsobjects = server.Query()
'--------------------------------------------------------
' ниже основной код
'новые переменные
Dim str As String
Dim str2 As String
Dim i As Integer, ii As Integer, iii As Integer
'для себя, выводим в командную строку количество открытых документов и дописываем системное время
ThisDrawing.Utility.Prompt "Документов для обработки " & app.Documents.Count & ". Старт - " & Time()
'Далее цикл перечисляет открытые документы
For i = 1 To app.Documents.Count
str2 = app.Documents.Item(i).Name
'показать весь четеж
app.ZoomAll
' переключение на документ
app.Documents.Item(i).Activate
Set ThisDrawing = app.ActiveDocument
'очистка документа от неиспользуемых слоев, типов линий и т.д.
ThisDrawing.PurgeAll
		'в чертеже перечисляем текстовые стили
		For ii = 0 To ThisDrawing.TextStyles.Count - 1
		'устанавливает новые значения текстового стиля
		ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(ii)
		ThisDrawing.ActiveTextStyle.SetFont "GOST type A", False, False, 0, 0
		ThisDrawing.ActiveTextStyle.ObliqueAngle = 1.74532925199433E-02 * 5  'в радианах
		ThisDrawing.ActiveTextStyle.Width = 1
		Next ii
'перебираем все объекты, если толщина 0,25 меняем на 0,50
For iii = 0 To ThisDrawing.ModelSpace.Count - 1
If ThisDrawing.ModelSpace.Item(iii).Lineweight = acLnWt025 Then ThisDrawing.ModelSpace.Item(iii).Lineweight = acLnWt050
Next iii
'очистка документа от неиспользуемых слоев, типов линий и т.д. (контрольно, у меня почемуто с первого раза не всегда очищает)
ThisDrawing.PurgeAll
'перерисовка чертежа
ThisDrawing.Regen acAllViewports
'сохраняем изменения
ThisDrawing.Save
Next i
'по завершению, для себя, выведем оповещение и текущее системное время
ThisDrawing.Utility.Prompt "Завершено - " & Time()
End Sub

Edited November 1, 2014 by Александр_

swell{d} · October 31, 2014

Dim server As McCOM2.IServer

Set server = CreateObject("McCOM2.Server")

Dim spdsobjects As McCOM2.ObjectsCollection

Set spdsobjects = server.Query()

Это подключение к спдс. Можно не делать, если функционал спдс не задействован

Lion2032 · November 5, 2014

Добрый день.

Хочу повторить проект: http://forum.nanocad...t=0

С примитивами чуток разобрался,

Вопрос: как сделать генерацию блока из Экселя в Нанокад?

(Соответственно, как задать точку привязки блока)

В развитие темы: можно ли генерировать группы? (Командная строка: ГРУППИРОВАТЬ (GROUP, GROUPCMD))

Edited November 5, 2014 by Lion2032

Doctor_Che · February 27, 2015

Здравствуйте.

Пытаюсь выполнить скрипт от Александр_ - полная тишина.

Запускаю через Сервис-Скрипт-Visual Basic Script

Что делаю не так?

PS Когда запускаю скрипт

Dim str
str = "Hello, world!"
MsgBox str

Всё отлично выполняется.

Александр_ · February 27, 2015

Здравствуйте. Скрипт я писал в редакторе vba excel (без особых изменений работал и из редактора солида). При этом должны быть открыты чертежи в нанокаде.

Попробуйте вывести в сообщение количество открытых документов, что бы проверить, есть ли связь с нанокадом.

Option Explicit 
Sub Main()         
Dim app As nanoCAD.Application         
Set app = GetObject("", "nanoCAD.Application")
MsgBox app.Documents.Count
End Sub

Если связь есть, обратите внимание на то, что шрифты поменяются, а вот толщина линий поменяется с 0,25 на 0,50. То есть, если толщина линии будет 0 или 0,1 или любое другое число отличное от 0,25, никаких изменений с толщиной линии не будет. Код отвечающий за изменение толщины линий:

If ThisDrawing.ModelSpace.Item(iii).Lineweight = acLnWt025 Then ThisDrawing.ModelSpace.Item(iii).Lineweight = acLnWt050

Lion2032 · July 8, 2015

Добрый день.

Требуется помощь.

из текстбокса нужно извлечь дробное число (16,8) а с помощью Val извлекается целое (16).

MySheet.Cells(32, 3).Value = Val(UserForm1.TextBox1.Text)
MySheet.Cells(33, 3).Value = Val(UserForm1.TextBox2.Text)
MySheet.Cells(115, 3).Value = Val(UserForm1.TextBox3.Text)

Как нужно изменить строку, что бы извлечь число с точностью до второго знака?

P.S. Нужно ли в данном случае делать проверку на разделитель?

Edited July 8, 2015 by Lion2032

Lion2032 · September 21, 2015

Как добавить штриховку в блок?

val100 · April 6, 2017

На компе (OS Win7x64) установлен NanoCAD Механика 6.1 х64

Делаю вызов из MS Excel 2010 (х64)

+ в дереве проекта VBA создаю новый модуль

+ подключаю следующие библиотеки (Tools - References…):

nanoCAD x64 Type Library (NCAuto.dll)

MechaniCS COM 2.0 type library (McCOM2.dll)

OdaX 3.08 (x64) Type Library (OdaX_csd.dll)

Текст скрипта

Option Explicit

Public app As nanoCAD.Application

Public ThisDrawing As nanoCAD.Document

Sub my_drawing()

Set app = GetObject("", "nanoCAD.Application")

app.Visible = True

Set ThisDrawing = app.ActiveDocument

End Sub

Пытаюсь запустить этот скрипт подключения к NanoCAD Механика 6.1 х64

имею ошибку

Activex component can't create object 429

на строке

Set app = GetObject("", "nanoCAD.Application")

Вопрос В чем здесь может быть проблема?

если на Win7x32 этот же пример работает без проблем.

Edited April 6, 2017 by val100

Ivanco · April 6, 2017

На компе (OS Win7x64) установлен NanoCAD Механика 6.1 х64

nanoCADx64.Application попробуйте. с какой то версии GUID стали разные у x32 и x64. ну кстати еще может быть проблема , если несколько нанокадов на машине установлено.фиг знает тогда что будет запускаться.

MechaniCS COM 2.0 type library (McCOM2.dll) - а это чего такое? где указано что это нужно?

Edited April 6, 2017 by Ivanco

val100 · April 6, 2017

Ivanco

Спасибо за ответ!

Но что делать пока не ясно.

MechaniCS COM 2.0 type library (McCOM2.dll) - а это чего такое? где указано что это нужно?

см..3 пост этой темы

в общем в данном примере не обязательно

Edited April 6, 2017 by val100

doctorraz · April 6, 2017

Ivanco

Спасибо за ответ!

Но что делать пока не ясно.

MechaniCS COM 2.0 type library (McCOM2.dll) - а это чего такое? где указано что это нужно?

см..3 пост этой темы

в общем в данном примере не обязательно

пробуй так

Set app = GetObject(, "nanoCAD.Application")

doctorraz · April 6, 2017

и еще, попробуй позднее связывание

Public app As Object

что бы хотя бы подключиться к нане.

в референсах нану можно не подключать.

val100 · April 7, 2017

doctorraz

Спасибо! Это тоже не помогает.

По прежнему валится с ошибкой

Activex component can't create object 429

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

если действительно GUID стали разные у x32 и x64 и требуется править записи реестра ...

Ivanco · April 7, 2017

Set app = GetObject("", "nanoCADx64.Application")

так тоже не работает?

val100 · April 7, 2017

nanoCADx64.Application

Вообще-то мысль отличная!

Но почему-то снова идет эта же ошибка.

Теперь хоть уже есть над чем подумать.

http://forum.nanocad.ru/index.php?showtopic=7304

COM. Разведены GUID-ы 32- и 64-битных версий. Последняя установленная версия регистрируется, как nanoCAD.Application. Для параллельного использования 32- и 64-битных версий добавлены имена nanoCADx32.Application и nanoCADx64.Application.

Ivanco · April 7, 2017

var ncApp;
try
{
 ncApp = GetObject("", "nanoCADx64.Application");
 WScript.Echo("Доступ к текущей сессии nanoCAD получен");
}
catch (ex)
{
 try
 {
WScript.Echo("nanoCAD не запущен или невозможно получить к нему доступ. Попытка создания новой сессии...");
ncApp = new ActiveXObject("nanoCADx64.Application");
WScript.Echo("Создана новая сессия nanoCAD");
 }
 catch (ex)
 {
WScript.Echo("невозможно получить доступ к nanoCAD");
WScript.Quit();
 }
}

у меня на 64 битной Windows 10 код выше нормально работает с nanoCAD PLUS 8.1

еще можно попробовать перерегистрировать COM модель nanoCAD-а, с командной строки Windows: ncad.exe /register.

C:\Program Files\Nanosoft\nanoCAD x64 Plus 8.0>ncad.exe /register - то ПО в котором запускается скрипт.Делать лучше с правами администратора.

Edited April 7, 2017 by Ivanco

YanKo · July 26, 2017

Добрый день!

Пытаюсь повторить отрисовку полилиний из эксель как в myengineeringworld.net/2013/04/draw-polyline-in-autocad-using-excel-vba.html

Но не получается, пишет что не найдет проект или библиотека

Подключен nanoCAD x64 Type Library

Sub ghh()
'Draws a polyline in AutoCAD using X and Y coordinates from sheet Coordinates.

'By Christos Samaras
'http://www.myengineeringworld.net

'In order to use the macro you must enable the AutoCAD library from VBA editor:
'Go to Tools -> References -> Autocad xxxx Type Library, where xxxx depends
'on your AutoCAD version (i.e. 2010, 2011, 2012, etc.) you have installed to your PC.

'Declaring the necessary variables.
Dim acadApp As nanoCAD.Application
Dim acadDoc As nanoCAD.Document
Dim LastRow As Long
Dim acadPol As AcDbPolyline
Dim dblCoordinates() As Double
Dim i As Long
Dim j As Long
Dim k As Long

Лист1.Activate


'Find the last row.
With Лист1
	LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Check if there are at least two points.
If LastRow < 3 Then
	MsgBox "There not enough points to draw the polyline!", vbCritical, "Points Error"
	Exit Sub
End If

'Check if AutoCAD is open.
On Error Resume Next
Set acadApp = GetObject("", "nanoCAD.Application") 'подключаемся к nanoCAD
On Error GoTo 0

'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
	Set acadApp = New nanoCAD.Application
	acadApp.Visible = True
End If

'Check if there is an active drawing.
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0

'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
	Set acadDoc = acadApp.Documents.Add
	acadApp.Visible = True
End If

'Get the array size.
ReDim dblCoordinates(2 * (LastRow - 1) - 1)

'Pass the coordinates to array.
k = 0
For i = 2 To LastRow
	For j = 1 To 2
		dblCoordinates(k) = Лист1.Cells(i, j)
		k = k + 1
	Next j
Next i

'Draw the polyline either at model space or at paper space.
If acadDoc.ActiveSpace = acModelSpace Then
	Set acadPol = acadDoc.ModelSpace.AddLightWeightPolyline(dblCoordinates)
Else
	Set acadPol = acadDoc.PaperSpace.AddLightWeightPolyline(dblCoordinates)
End If

'Leave the polyline open (the last point is not connected with the first point.
'Set the next line to true if you need to connect the last point with the first one.
acadPol.Closed = False
acadPol.Update

'Zooming in to the drawing area.
acadApp.ZoomExtents



'Inform the user that the polyline was created.
MsgBox "The polyline was successfully created!", vbInformation, "Finished"
End Sub

maratovich · July 26, 2017

Теоретически....

Использование связи через СОМ без подключенной библиотеки CAD не допускает использование "as" в таком виде.

вместо

Dim acadApp As nanoCAD.Application

Dim acadDoc As nanoCAD.Document

попробуйте

Dim acadApp As Object

Dim acadDoc

И вообще, запускайте через F8, ищите строку с ошибкой.

YanKo · July 26, 2017

Теоретически....

Использование связи через СОМ без подключенной библиотеки CAD не допускает использование "as" в таком виде.

вместо

Dim acadApp As nanoCAD.Application

Dim acadDoc As nanoCAD.Document

попробуйте

Dim acadApp As Object

Dim acadDoc

И вообще, запускайте через F8, ищите строку с ошибкой.

После этого ругается на строчку Dim acadPol As AcDbPolyline

Если сделать Dim acadPol , то ругается на If acadDoc.ActiveSpace = acModelSpace Then

и т.д.

Какую еще CAD библиотеку можно включить кроме nanoCAD x64 Type Library

maratovich · July 26, 2017

Const acModelSpace = 1

Const acPaperSpace = 0

acModelSpace заменить на 1

и вообще, какая версия нанокад ? приложите файл эксель.

YanKo · July 26, 2017

Все заработало))

Правда вместо нанокада открывает в Геонике (у меня стоит нанокад 8+ и геоника на нанокаде).

По координатам nanocad.zip

Edited July 26, 2017 by YanKo

doctorraz · July 26, 2017

YanKo, тебе maratovich верно подсказал, одно из двух или разбирайся с референсами либо используй позднее связывание

maratovich · July 26, 2017

Правда вместо нанокада открывает в Геонике (у меня стоит нанокад 8+ и геоника на нанокаде).

Не совсем понял.

У вас не в той версии открывается ? В какой нужно ?

doctorraz · November 28, 2018

так и не удалось мне победить позднее связывание в нанокад

имеем нано 8,5 и 10,1

при запущенном 8,5 могу к нему подключиться по

Set getApp = GetObject("", "nanoCAD.Application")
Set creatApp = CreateObject("nanoCAD.Application")

при запущенном 10,1

позднее связывание не работает, код просто запускает нано 8,5

если

Set getApp = GetObject(, "nanoCAD.Application")

естественно ошибка 429(((

----------------

прописываю в референсах c:\Program Files\Nanosoft\nanoCAD x64 Plus 10.1\bin\ncauto.dll

код ниже работает... подключаюсь к 10,1 или запускаю его...

Set newApp = New nanoCAD.Application

возможно перерегистрация библиотеки c:\Program Files\Nanosoft\nanoCAD x64 Plus 10.1\bin\ncauto.dll

изменит ситуацию в обратную сторону...

У кого нить есть мысли, как победить?

-------------

ЗЫ АК хоть десять версий установлено... запускаем любую

и по

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

цепляемая к АК без проблем..

аналогично все красиво с McCOM, независимо от версий

Первые шаги: Автоматизация работы в nanoCAD с помощью Visual Basic for Applications (Excel)

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Tell a friend