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

[dows 545]

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

 

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

 

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

[Александр_ 4]

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

Для начала так. Научат подключится к 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

Изменено 1 ноября, 2014 пользователем Александр_

[swell{d} 228]

Dim server As McCOM2.IServer

Set server = CreateObject("McCOM2.Server")

 

Dim spdsobjects As McCOM2.ObjectsCollection

Set spdsobjects = server.Query()

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

[Lion2032 1 013]

Добрый день.

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

 

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

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

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

 

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

Изменено 5 ноября, 2014 пользователем Lion2032

[Doctor_Che 32]

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

 

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

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

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

 

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

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

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

[Александр_ 4]

Здравствуйте. Скрипт я писал в редакторе 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 1 013]

Добрый день.

 

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

из текстбокса нужно извлечь дробное число (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. Нужно ли в данном случае делать проверку на разделитель?

Изменено 8 июля, 2015 пользователем Lion2032

[Lion2032 1 013]

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

[val100 7]

На компе (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 этот же пример работает без проблем.

Изменено 6 апреля, 2017 пользователем val100

[Ivanco 140]

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

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

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

Изменено 6 апреля, 2017 пользователем Ivanco

[val100 7]

Ivanco

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

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

 

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

 

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

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

Изменено 6 апреля, 2017 пользователем val100

[doctorraz 931]

Ivanco

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

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

 

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

 

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

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

пробуй так

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

[doctorraz 931]

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

Public app As Object

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

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

[val100 7]

doctorraz

 

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

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

Activex component can't create object 429

 

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

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

[Ivanco 140]

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

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

[val100 7]

nanoCADx64.Application

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

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

 

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

 

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

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

[Ivanco 140]

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 - то ПО в котором запускается скрипт.Делать лучше с правами администратора.

Изменено 7 апреля, 2017 пользователем Ivanco

[YanKo 0]

Добрый день!

Пытаюсь повторить отрисовку полилиний из эксель как в 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 44]

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

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

вместо

Dim acadApp As nanoCAD.Application

Dim acadDoc As nanoCAD.Document

попробуйте

Dim acadApp As Object

Dim acadDoc

 

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

[YanKo 0]

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

Использование связи через СОМ без подключенной библиотеки 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 44]

Const acModelSpace = 1

Const acPaperSpace = 0

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

 

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

[YanKo 0]

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

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

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

Изменено 26 июля, 2017 пользователем YanKo

[doctorraz 931]

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

[maratovich 44]

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

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

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

[doctorraz 931]

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

имеем нано 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, независимо от версий