Скрипт для "выдавливания" 3dFace из отрезков

Автор: Dmitry Rudenko

C помощью этого скрипта (VBA) можно подготовить в nanoCAD план стен для последующего импорта в препроцессоры расчётных программ. Скрипт преобразует отрезки в 3dFace, которые воспринимаются препроцессорами, как оболочки.

Исходные объекты (отрезки):

Объекты после использования скрипта (3dFace):

Модель после импорта dxf в программе Форум:

3dFace-frm-line.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "C помощью этого скрипта (VBA) можно подготовить в nanoCAD план стен для последующего импорта программой Форум. Скрипт преобразует отрезки в 3dFace, которые воспринимаются программой Форум, как оболочки."
 
Dim myObj 
Dim solid
Dim ppt0, ppt1, pt0(2), pt1(2), pt2(2), pt3(2) 
 
Dim check2
check2 = 0
 
Dim sSet, cnt
set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count
 
Dim height
height = ut.GetInteger("Введите высоту стен: ")
 
Dim i
for i=0 to cnt-1
	set myObj = sSet.Item(i)
	if (myObj.ObjectName = "AcDbLine") then
		ppt0 = ut.CreateSafeArrayFromVector(myObj.StartPoint)
        ppt1 = ut.CreateSafeArrayFromVector(myObj.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.Add3dFace(pt0,pt1,pt3,pt2)
		solid.layer = myObj.layer
		myObj.delete
	else 
		check2 = 1 
	end if
next
ut.Prompt "Готово, проверяй!"
if check2 = 1 then
	ut.Prompt " "
	ut.Prompt "Внимание! В набор вошли не только отрезки"
end if
sSet.Clear

• Решения для AutoCAD