Перейти к содержанию

"выдавить" отрезки в солид


Рекомендуемые сообщения

добрый день

 

подскажите, есть несколько отрезков, допустим, в горизонтальной плоскости (z=0)

я хочу, задав определённую "высоту", получить солиды (фигуры), нормальные к горизонтальной плоскости, т.е. по сути - "выдавить" их

 

как я вижу решение этой задачи:

скрипт, который запрашивает высоту будущих солидов, затем берёт координаты выделенных отрезков и на их основе рисует новые солиды, а сами отрезки - удаляет

 

это реально? кто-нибудь (ну понятно кто - Lion007) поможет? =)

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

А в чем проблема-то? Берем метод AddSolid - и вперед :)

Public Function AddSolid(ByVal Point1 As Variant, ByVal Point2 As Variant, ByVal point3 As Variant, ByVal Point4 As Variant) As AcadSolid

Ссылка на комментарий
Поделиться на другие сайты

эм. проблема вытащить координаты существующих отрезков (выделенных) ^_^

 

пока всё, что у меня получилось, это

Dim faceObj
Set faceObj = ThisDrawing.ModelSpace.AddSolid(CStr(0)+","+CStr(0)+","+CStr(0),CStr(10)+","+CStr(0)+","+CStr(0),CStr(0)+","+CStr(0)+","+CStr(10),CStr(10)+","+CStr(0)+","+CStr(10))

=)

Ссылка на комментарий
Поделиться на другие сайты

беда-беда, огорчение...

 

Dim sset, line
Dim i, cnt, pt0, pt1

set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count
'ThisDrawing.Utility.Prompt cnt

for i=0 to cnt-1
 set line = sSet.Item(i)
 if (line.ObjectName = "AcDbLine") then
pt0 = ThisDrawing.Utility.CreateSafeArrayFromVector(line.StartPoint)
pt1 = ThisDrawing.Utility.CreateSafeArrayFromVector(line.EndPoint)
ThisDrawing.Utility.Prompt CStr(i) + " : " + CStr(pt0(0)) + " " + CStr(pt0(1)) + " " + CStr(pt0(2))
 end if
next
sSet.Clear

Изменено пользователем Lion007
Ссылка на комментарий
Поделиться на другие сайты

ну не издевайтесь =) я же не издеваюсь над тем, как Вы проектируете жб конструкции =)

 

спасибо большое! дальше разберусь

Ссылка на комментарий
Поделиться на другие сайты

Мой быдло-кодик =)

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
Dim sSet, line
Dim i, cnt, ppt0, ppt1, pt0(2), pt1(2), pt2(2), pt3(2)
Dim solid
Dim height
set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count
height = ut.GetInteger("Введите высоту стен: ")
for i=0 to cnt-1
 set line = sSet.Item(i)
 if (line.ObjectName = "AcDbLine") then
 ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
 ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)

 pt0(0) = ppt0(0)
 pt0(1) = ppt0(1)
 pt0(2) = ppt0(2)
 pt1(0) = ppt1(0)
 pt1(1) = ppt1(1)
 pt1(2) = ppt1(2)
 pt2(0) = ppt0(0)
 pt2(1) = ppt0(1)
 pt2(2) = ppt0(2) + height
 pt3(0) = ppt1(0)
 pt3(1) = ppt1(1)
 pt3(2) = ppt1(2) + height

 set solid = ms.AddSolid(pt0,pt1,pt2,pt3)
 end if
 line.delete
next
ut.Prompt "Готово, проверяй!"
sSet.Clear

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

Небольшой скрипт, который устанавливает для всех отрезков в чертеже координаты начала и конца Z=0

 

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
Dim line
Dim i, ppt0, ppt1, pt0(2), pt1(2)
for i=0 to ms.count - 1
set line = ms.Item(i)
if (line.ObjectName = "AcDbLine") then
 ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
 ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)
 pt0(0) = ppt0(0)
 pt0(1) = ppt0(1)
 pt0(2) = 0
 pt1(0) = ppt1(0)
 pt1(1) = ppt1(1)
 pt1(2) = 0
 line.StartPoint = pt0
 line.EndPoint = pt1

 ut.Prompt CStr(i)
 end if
next
ut.Prompt "Готово, проверяй!"

Ссылка на комментарий
Поделиться на другие сайты

Небольшой скрипт, который считает сумму длин всех выделенных отрезков, полилиний и дуг:


Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility

ut.Prompt "Небольшой скрипт на VBA, который считает сумму длин всех выделенных отрезков, полилиний и дуг"

Dim sSet, line, summ, check1, check2, check3, check4
Dim i, cnt, ppt0, ppt1
summ = 0
check1 = 0
check2 = 0
check3 = 0
check4 = 0

set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count

for i=0 to cnt-1
set line = sSet.Item(i)
if (line.ObjectName = "AcDbLine") then
ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)

if ppt0(2) <> ppt1(2) then
check1 = 1
end if 

ut.Prompt "Отрезок #" + CStr(i+1) + ": " + CStr(int(line.length)) 
summ = summ + line.length
check2 = check2 + 1
end if
if (line.ObjectName = "AcDbPolyline") then
ut.Prompt "Полилиния #" + CStr(i+1) + ": " + CStr(int(line.length)) 
summ = summ + line.length
check3 = check3 + 1
end if
if (line.ObjectName = "AcDbArc") then
ut.Prompt "Дуга #" + CStr(i+1) + ": " + CStr(int(line.ArcLength)) 
summ = summ + line.ArcLength
check4 = check4 + 1
end if
next

if check2 > 0 then 
ut.Prompt "Всего обнаружено отрезков: " + CStr(check2)
end if
if check3 > 0 then
ut.Prompt "Всего обнаружено полилиний: " + CStr(check3) + ".  Внимание! Полилинии не проверяются на горизонтальность"
end if
if check4 > 0 then 
ut.Prompt "Всего обнаружено дуг: " + CStr(check4) + ".  Внимание! Дуги не проверяются на горизонтальность"
end if

ut.Prompt "Сумма длин всех отрезков, полилиний и дуг: " + CStr(int(summ)) + " ед. чертежа."

if check2 + check3 + check4 <> cnt then
ut.Prompt "Внимание! В набор вошли не только отрезки, полилинии и дуги"
end if

if check1 = 1 then
ut.Prompt "Внимание! В набор вошли не плоские отрезки"
end if

sSet.Clear

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

Небольшой скрипт, который округляет координаты всех отрезков и 3dface с заданной точностью

 


Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility

ut.Prompt "Небольшой скрипт на VBA, который округляет координаты всех отрезков и 3dface с заданной точностью"

Dim myObj
Dim i, m
Dim ppt0, ppt1, pt0(2), pt1(2)
Dim ppt3d, pt3d(11), pt3da

Dim scale 
scale = ut.GetInteger("Введите точность округления: ")

for i=0 to ms.count-1
set myObj = ms.Item(i)
if (myObj.ObjectName = "AcDbLine") then
ppt0 = ut.CreateSafeArrayFromVector(myObj.StartPoint)
       ppt1 = ut.CreateSafeArrayFromVector(myObj.EndPoint)

for m = 0 to 2 
if int(ppt0(m)/scale) = int(ppt0(m)/scale+0.5) then 
pt0(m) = int(ppt0(m)/scale) * scale
else 
pt0(m) = int(ppt0(m)/scale+0.5) * scale
end if
if int(ppt1(m)/scale) = int(ppt1(m)/scale+0.5) then 
pt1(m) = int(ppt1(m)/scale) * scale
else 
pt1(m) = int(ppt1(m)/scale+0.5) * scale
end if
next

myObj.StartPoint = pt0
myObj.EndPoint = pt1
end if
if (myObj.ObjectName = "AcDbFace") then
ppt3d = ut.CreateSafeArrayFromVector(myObj.Coordinates)
for m = 0 to 11 
if int(ppt3d(m)/scale) = int(ppt3d(m)/scale+0.5) then 
pt3d(m) = int(ppt3d(m)/scale) * scale
else 
pt3d(m) = int(ppt3d(m)/scale+0.5) * scale
end if
next
ut.CreateTypedArray pt3da, 5, pt3d(0), pt3d(1), pt3d(2), pt3d(3), pt3d(4), pt3d(5), pt3d(6), pt3d(7), pt3d(8), pt3d(9), pt3d(10), pt3d(11) 
myObj.Coordinates = pt3da
end if
next
ut.Prompt "Готово, проверяй!"

 

П.С. Меня уже не остановить =)

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

Как работать с полилиниями?

AcDbPolyLine чего-то не находит в чертеже =(

AcDbPolyline - с маленькой L надо писать

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

Рисуем термовкладыши

 

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility

Dim layer
Set layer = ThisDrawing.Layers.Add("КЖ_элементы ПМ перфорация")
layer.color = "140"
layer.lineweight = 15
ut.Prompt "Скрипт для замены выбранных отрезков на замкнутые прямоугольники со штриховкой"
Dim line, check2
check2 = 0
Dim ppt0, ppt1, pt0(11)
pt0(2) = 0
pt0(5) = 0
pt0(8) = 0
pt0(11) = 0
Dim solid
Dim pi
pi = 3.14159265359
Dim height, height1, height2
'height = ut.GetInteger("Введите высоту стен: ")'
'height = 100'
height1 = 100 'down'
height2 = 100 'up'
'настройки штриховки'
dim hatch
set hatch = ms.AddHatch(1, "ANSI37", True)
hatch.PatternScale = 30
hatch.Layer = "КЖ_элементы ПМ перфорация"
Dim sSet, cnt
set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count
Dim i
for i=0 to cnt-1
set line = sSet.Item(i)

if (line.ObjectName = "AcDbLine") then
 if line.length > 199 then
  ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
  ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)
  'проверяем, чтобы не делить на ноль'
  if ppt1(0)-ppt0(0) <> 0 then
alfa = atn((ppt1(1)-ppt0(1))/(ppt1(0)-ppt0(0)))
  else
alfa = 0.5 * pi
  end if
  pt0(0) = ppt0(0)+height1*cos(0.5*pi - alfa)
  pt0(1) = ppt0(1)-height1*cos(alfa)
  pt0(3) = ppt1(0)+height1*cos(0.5*pi - alfa)
  pt0(4) = ppt1(1)-height1*cos(alfa)
  pt0(6) = ppt1(0)-height2*cos(0.5*pi - alfa)
  pt0(7) = ppt1(1)+height2*cos(alfa)
  pt0(9) = ppt0(0)-height2*cos(0.5*pi - alfa)
  pt0(10) = ppt0(1)+height2*cos(alfa)

  set solid = ms.AddPolyLine(pt0)
  solid.closed = true
  solid.Layer = "КЖ_элементы ПМ перфорация"

  line.delete 'удаляем исходную линию'
  hatch.AppendOuterLoop(solid) 'рисуем штриховку'
 else
  line.delete
 end if
else
 check2 = 1
 'line.delete'
end if
next
hatch.Evaluate
ut.Prompt "Готово, проверяй!"
if check2 = 1 then
ut.Prompt " "
ut.Prompt "Внимание! В набор вошли не только отрезки"
end if
sSet.Clear

 

хреново код подсвечивается =/

Изменено пользователем swell{d}
Ссылка на комментарий
Поделиться на другие сайты

  • 1 месяц спустя...

пример работы с атрибутами блока:

Нумерация в правом верхнем углу

Ссылка на комментарий
Поделиться на другие сайты

  • 4 недели спустя...

Небольшой скрипт, который считает сумму длин всех выделенных отрезков, полилиний и дуг:

 

В голом нанокаде работает? Если да, как запустить?

Ссылка на комментарий
Поделиться на другие сайты

скрипты должны работать везде.

код скопируйте в блокнот и сохраните с расширением vbs.

затем в нано в коммандной строке введите vbs и нажмите энтер. в появившемся окне найдите только что сохранённый файл и запустите.

Ссылка на комментарий
Поделиться на другие сайты

  • 4 года спустя...

Небольшой скрипт, который устанавливает для всех отрезков в чертеже координаты начала и конца Z=0

 

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
Dim line
Dim i, ppt0, ppt1, pt0(2), pt1(2)
for i=0 to ms.count - 1
set line = ms.Item(i)
if (line.ObjectName = "AcDbLine") then
 ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
 ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)
 pt0(0) = ppt0(0)
 pt0(1) = ppt0(1)
 pt0(2) = 0
 pt1(0) = ppt1(0)
 pt1(1) = ppt1(1)
 pt1(2) = 0
 line.StartPoint = pt0
 line.EndPoint = pt1

 ut.Prompt CStr(i)
 end if
next
ut.Prompt "Готово, проверяй!"

Добрый день! Запускал скрипт в nanocad3. Ничего не происходит. В nanocad5 скрипт работает. В чем может быть дело?

Ссылка на комментарий
Поделиться на другие сайты

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить в этой теме...

×   Вставлено с форматированием.   Восстановить форматирование

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

Загрузка...
  • Расскажите друзьям

    Нравится Официальный форум компании Нанософт? Расскажите друзьям!
×
×
  • Создать...