Первые шаги в мир программирования под nanoCAD

[Lion2032]

VBA надо мной издевается...)))

 

Чего теперь не хватает?

 

А толщину вот так устанавливать:

layer0.LineWeight = 0 ?

Edited November 6, 2014 by Lion2032

[Lion007]

layer0.lineweight = 0

[Lion2032]

Почему в этой строке VBA выдает ошибку 91?

Set layer0 = ThisDrawing.layer.Item("0")

[Lion007]

если честно - фиг его знает. я-то игрался на VBS, а не на VBA - у меня работало и так и эдак.

можно попробовать ThisDrawing.Layers("0")

а может быть - почему-то (из-за подпрограммы?) не видно ThisDrawing... тут надо отладчиком смотреть!

[Lion2032]

если честно - фиг его знает. я-то игрался на VBS, а не на VBA - у меня работало и так и эдак.

можно попробовать ThisDrawing.Layers("0")

а может быть - почему-то (из-за подпрограммы?) не видно ThisDrawing... тут надо отладчиком смотреть!

 

Спасибо. Но ThisDrawing.Layers("0") тоже не работает.

Пошел знакомиться с отладчиком.

[swell{d}]

А какие замечания Вы хотите услышать? Код либо работает, либо нет.

По поводу слоёв - можете сделать массив объектов типа AcadLayer, настроить каждый элемент массива и просто переключаться между ними

[Lion2032]

А какие замечания Вы хотите услышать? Код либо работает, либо нет.

По поводу слоёв - можете сделать массив объектов типа AcadLayer, настроить каждый элемент массива и просто переключаться между ними

 

А можно такое сделать через публичные переменные?

 

Насчет кода:

Код установки нулевого слоя в качестве текущего не работает, ни в составе подпрограммы, ни в составе основного блока. (см.LAYER_0)

[swell{d}]

Можно.

Чего вам сдался этот 0 ? Слой 0 нужен в первую очередь для работы с внешними ссылками, как мне кажется.

Создайте слой _ЕОМ_0 и работайте в нём

[Lion2032]

Мне он не сдался, но тут есть два варианта: переделывать корпоративный стандарт или "Создать слой _ЕОМ_0 и работать в нём"

Первый вариант, как мне сдается, менее геморроидален.

[swell{d}]

Попробуйте

Set layer0 = ThisDrawing.layers.Item(0)

или

Set layer0 = ThisDrawing.layers.Item(1)

Скорее даже второй вариант.

[Lion2032]

Попробуйте

Set layer0 = ThisDrawing.layers.Item(0)

или

Set layer0 = ThisDrawing.layers.Item(1)

Скорее даже второй вариант.

 

Пробовал уже: http://forum.nanocad...indpost&p=28459

Без ковычек и единица тоже не работает

 

Хорошо, вернемся к теме позже.

Спасибо, что уделили время.

Edited November 7, 2014 by Lion2032

[Lion007]

такс. недобрые люди все-таки вынудили меня поставить мс-офис для экспериментов

соответственно, игрался я на office-2007, из MS Access

что показало вскрытие : доступ к таблице слоев (да и к любой другой) можно осуществлять двумя способами - либо по имени (если в качестве индекса выступает строка), либо по номеру (если число). числовые индексы начинаются с 1, ну и до count

работает и так и эдак.

еще один момент : по не вполне понятной причине инспектор после смены текущего слоя не перерисовывается. то есть все выставилось, но этого сходу не видно. помогает дубовый способ - переключиться из наны и обратно. можно это проделать программно :

	' hide\show ncad to update property inspector
app.Visible = False
app.Visible = True

 

ну и работающий (у меня) примерчик на тему того, чего желалось

Option Compare Database

Public app As nanoCAD.Application
Public ThisDrawing As nanoCAD.Document

Sub StartNano()
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True
Set ThisDrawing = app.ActiveDocument
End Sub

Function getLayerByName(name As String) As AcadLayer
Dim LayersTable As AcadLayers
Dim layer As AcadLayer
Dim i As Integer
Set LayersTable = ThisDrawing.Layers
For i = 1 To LayersTable.Count
	If LayersTable(i).name = name Then
	    Set layer = LayersTable(i)
		i = LayersTable.Count
	End If
Next i
End Function

Sub LAYER_0()
Dim layer0 As AcadLayer
Set layer0 = ThisDrawing.Layers("0") 'getLayerByName("0")
layer0.Color = 7
layer0.LineWeight = 0
ThisDrawing.ActiveLayer = layer0
' hide\show ncad to update property inspector
app.Visible = False
app.Visible = True
End Sub

Sub main()
Call StartNano
Call LAYER_0
End Sub

 

как проверялось : в пустом файле насоздавал слоев, раскрасил в разные цвета, выставил всякие толщины (в том числе и слой 0), выставил текущий слой абы какой... ну и потом запустил сию программку.

в результате - текущий слой получаем 0, у него черно-белый цвет и толщина 0.

 

зы : вообще, задача (имхо) довольно странная была поставлена - например я не понял, зачем КАЖДЫЙ раз менять параметры слоя... ну да ладно, это уже другая история - не буду гадать, что именно требовалось.

Edited November 7, 2014 by Lion007

[swell{d}]

Lion007, спасибо за потраченное время! =)

[Lion2032]

Ур-р-ра!!!

Зар-р-работало!!!

Низкий поклон вам, уважаемый Lion007.

 

P.S. Для чего каждый раз "сбрасывать" параметры слоя. Согласно нашему корпоративному стандарту слой "0" - технический, в нем никто не рисует и не пишет.

Слой "0" предназначен для внешних ссылок и другой информации из смежных разделов. Но люди приходящие к нам в организацию, иногда рисуют не "в слоях", а "в цветах"

Т.е. они меняют цвет текущий линии, а не слой. Так вот это такая своеобразная "напоминалка" людям, что они рисуют не в том слое. Немного сумбурно, но пока ничего лучше не придумано, что бы автоматизировать данный процесс.

[Lion2032]

Следующий вопрос:

 

Задача нарисовать примитивы и создать из них блок.

 

Пример:

Sub InsertingABlock()
   ' Определим блок
   Dim blockObj As AcadBlock
   Dim insertionPnt(0 To 2) As Double
   insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
   Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
   ' Добавим в блок окружность
   Dim circleObj As AcadCircle
   Dim center(0 To 2) As Double
   Dim radius As Double
   center(0) = 0: center(1) = 0: center(2) = 0: radius = 1
   Set circleObj = blockObj.AddCircle(center, radius)
   ' Вставим блок
   Dim blockRefObj As AcadBlockReference
   insertionPnt(0) = 2: insertionPnt(1) = 2: insertionPnt(2) = 0
   Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
		   (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
   ZoomExtents
   MsgBox "Окружность стала блоком " & blockRefObj.ObjectName
End Sub

 

Только вместо окружности должна быть подпрограмма (или несколько) рисования примитивов.

Как должна выглядеть команда, например, для данной процедуры:

 

'Подпрограмма-функция построения отрезка.

'Функция получает в качестве параметров координаты X и Y начала и конца отрезка и строит его

 

Sub MY_LINE(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
   Dim pt1(2) As Double, pt2(2) As Double
   pt1(0) = x1 'Х первой точки отрезка
   pt1(1) = y1 'У первой точки отрезка
   pt2(0) = x2 'Х второй точки отрезка
   pt2(1) = y2 'У второй точки отрезка
   Dim obj As AcadLine
   Set obj = ThisDrawing.ModelSpace.AddLine(pt1, pt2) 'построение отрезка из первой точки во вторую
End Sub

 

В контексте данного построения программы:

 

'Задание диагональных точек прямоугольника:
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
x1 = insert_point(0) 'координата по Х левой грани
x2 = x1 + r_width 'координата по Х правой грани
y1 = insert_point(1) 'координата по У нижней грани
y2 = y1 + r_height 'координата по У верхней грани
'Построение прямоугольника, состоящего из четырех отрезков:
'Ниже должен быть код рисования блока
MY_LINE x1, y1, x2, y1 'построение нижней грани с помощью подпрограммы MY_LINE
MY_LINE x2, y1, x2, y2 'построение правой грани с помощью подпрограммы MY_LINE
MY_LINE x2, y2, x1, y2 'построение верхней грани с помощью подпрограммы MY_LINE
MY_LINE x1, y2, x1, y1 'построение нижней грани с помощью подпрограммы MY_LINE

Edited November 10, 2014 by Lion2032

[swell{d}]

Я в соседней теме дал кусок кода

[Lion2032]

Я в соседней теме дал кусок кода

 

Спасибо, что откликнулись.

http://forum.nanocad.ru/index.php?showtopic=6322&view=findpost&p=28516

[Lion2032]

Разобрался я с блоками в первом приближении...)))

 

Вот что получилось:
' Определим блок
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insert_point, "Line")
' Добавим в блок линию
Dim LineObj As AcadLine
Dim pt8(2) As Double, pt9(2) As Double
   pt8(0) = 0
   pt8(1) = 0
   pt8(2) = 0
   pt9(0) = 3000
   pt9(1) = 4000
   pt9(2) = 0
Set LineObj = blockObj.AddLine(pt8, pt9)

' Нарисуем блок
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = (x1 + x2) / 2: insertionPnt(1) = (y1 + y2) / 2: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insert_point, "Line", 1#, 1#, 1#, 0)
Call ZoomExtents

 

 

НО! Остается вопрос: как добавить в блок процедуру (или несколько) например таких:

 

Рисуем четырехугольник

MY_LINE x1, y1, x2, y1 'построение нижней грани с помощью подпрограммы MY_LINE
MY_LINE x2, y1, x2, y2 'построение правой грани с помощью подпрограммы MY_LINE
MY_LINE x2, y2, x1, y2 'построение верхней грани с помощью подпрограммы MY_LINE
MY_LINE x1, y2, x1, y1 'построение нижней грани с помощью подпрограммы MY_LINE

 

Код самой процедуры приведен выше.

Edited November 10, 2014 by Lion2032

[swell{d}]

Так не получится, т.к. функции строят линии в моделспейс. Можно переделать, передавать объект в функцию..

[Lion2032]

Так не получится, т.к. функции строят линии в моделспейс. Можно переделать, передавать объект в функцию..

 

А можно примерчик?

[swell{d}]

Так, сейчас код для построения линии у меня такой:

 

Sub ms_Line(x1 As Double, y1 As Double, x2 As Double, y2 As Double, Optional line_weight As Double = -1, Optional line_type As String = "ByLayer")
On Error Resume Next
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = x1
pt1(1) = y1

pt2(0) = x2
pt2(1) = y2

Dim obj As AcadLine
Set obj = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
If line_weight <> -1 Then
	obj.LineWeight = line_weight
End If
If line_type <> "ByLayer" Then
	obj.LineType = line_type
End If
End Sub

В этой функции строим линию в моделспейс.

 

Я бы сделал ещё одну функцию для блоков:

Sub b_Line(block As IAcadBlock, x1 As Double, y1 As Double, x2 As Double, y2 As Double, Optional line_weight As Double = -2, Optional line_type As String = "ByLayer")
On Error Resume Next
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = x1
pt1(1) = y1

pt2(0) = x2
pt2(1) = y2

Dim obj As AcadLine
Set obj = block.AddLine(pt1, pt2)
If line_weight <> -2 Then
	obj.LineWeight = line_weight
End If
If line_type <> "ByLayer" Then
	obj.LineType = line_type
End If
End Sub

 

Тогда построения для блока будут выглядеть как-то так:

 

Dim pt1(2) As Double
Dim block As IAcadBlock
Set block = ThisDrawing.blocks.Add(pt1, "name_of_block")
b_Line block, 0, 0, 10, 10

 

Код не тестировал, но теоретически - как-то так.

Edited November 9, 2014 by swell{d}

[Lion2032]

Код не тестировал, но теоретически - как-то так.

 

Я протестировал: всё работает...

 

Непонятно, только что означает: On Error Resume Next

 

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

 

'Подпрограмма-функция построения вертикального размера.
'Функция получает в качестве параметров координаты X и Y начала и конца вертикального размера и строит его
Sub MY_DIMENSION_V(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
Dim pt1(2) As Double, pt2(2) As Double, pt3(2) As Double
   pt1(0) = x1 'Х первой точки вертикального размера.
   pt1(1) = y1 'У первой точки вертикального размера.
   pt2(0) = x2 'Х второй точки вертикального размера.
   pt2(1) = y2 'У второй точки вертикального размера.
   pt3(0) = x2 + 500 'Х текста вертикального размера
   pt3(1) = (y1 + y2) / 2  'У текста вертикального размера
   Dim dimrot As AcadDimRotated 'переменная типа "повернутый размер"
Set dimrot = ThisDrawing.ModelSpace.AddDimRotated(pt1, pt2, pt3, 3.1416 / 2) 'строим вертикального размер
'последний параметр в скобках определяет угол поворота размера в радианах
End Sub

 

Хотя может сразу задавать размерный стиль?

 

Еще вопрос: блок генерируется с определенным именем, нужно что бы блок генерировался по типу "блок, вар1", "блок, вар.2"

 

Моя концепция правильная, в данном случае?:

1. Проверяем, есть блок в данном чертеже

2. Если есть, проверяем номер варианта блок

3. Присваиваем блоку, следующий вариант или (если блока нет), вар.1

Edited November 10, 2014 by Lion2032

[Lion007]

P.S. Для чего каждый раз "сбрасывать" параметры слоя. Согласно нашему корпоративному стандарту слой "0" - технический, в нем никто не рисует и не пишет.

Слой "0" предназначен для внешних ссылок и другой информации из смежных разделов. Но люди приходящие к нам в организацию, иногда рисуют не "в слоях", а "в цветах"

Т.е. они меняют цвет текущий линии, а не слой. Так вот это такая своеобразная "напоминалка" людям, что они рисуют не в том слое. Немного сумбурно, но пока ничего лучше не придумано, что бы автоматизировать данный процесс.

Тут вот какая штука... С разблюдовкой по слоям и раздолбайством пользователей - все понятно. но есть одно такое себе но...

любой объект обладает рядом стандартных свойств - слой, цвет, тип линии, толщина линии... что характерно - слой - сам по себе - тоже обладает и цветом, и типом линий, и их толщиной. и вот тут начинается совершеннейший хэлл.

в идеале - т.е. когда разработана внятная система стандартов и пользователи (ай, молодцы!) ее придерживаются - все хорошо. т.е. все параметры объект тянет из слоя (ну, или из блока - это в зависимости от организации чертежа, хотя блок, в свою очередь, в идеале все тоже тянет из слоя). при этом все параметры у самого объекта получаются выставлены в "by layer". ура - меняем параметры слоя - и вслед за ним все объекты дружно превращаются в тыкву. но это все в идеале.

а в реале - мы имеем слудующее :

все подряд нарисовано на одном слое (99%, что на слое "0"), при этом у каждого объекта явно выставлен и цвет, и тип линии и прочее. после этого мы можем менять параметры этого несчастного слоя 0 до посинения - всем объектам на это будет начхать - у них есть все свое собственное. это раз.

ну и два - почему я говорю, что менять параметры каждый раз не надо... а это вытекает их пункта первого - параметры самого слоя достаточно изменить единожды. и после этого они такими и останутся, до тех пор, пока кто-то не изменит параметры этого слоя вновь. но именно слоя, а не объектов на нем!

сами же объекты в реальности чихать хотели на изменения параметров слоя - они от этого не меняются. вне зависимости от того, что там написано - "красный", "штрих-пунктир", "2 мм" или "по слою" - НЕ МЕНЯЮТСЯ.

[Lion2032]

Согласен.

А по сути, если что-то нарисовано в "0", это или ошибка, или "технический вариант".

 

Тем более, что корпоративный стандарт содержит пункт: сделать все по слою (в т.ч. и содержание блоков).

Вот тогда и выясняется, кто в чем чертил.

 

Тем более, что в "0" сбрасывается, только в конце программы.

 

А, что Вы думаете, по данному пункту: http://forum.nanocad...indpost&p=28529 ?

Edited November 9, 2014 by Lion2032

[Lion007]

а что я тут могу думать?

On error resume next - это один из стандартных обработчиков исключительных ситуаций в бэйсике. по смыслу - "если случилась какая хрень, то наплевать и попытаться работать дальше"

еще - фрагменты кода - стоит выделять тэгом "код" ( на тулбаре)

а если про блоки - то идея имеет право быть. ну и, естественно, при таком подходе те блоки которые ужы были созданы - они не поменяются никак.