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