Dim ms Set ms = ThisDrawing.ModelSpace Dim ut Set ut = ThisDrawing.Utility ut.Prompt "Небольшой скрипт на VBA, который преобразует выбранные прямоугольники в 3dface" Dim myObj, solid dim pt0(2), pt1(2), pt2(2), pt3(2) dim pptpl Dim sSet, cnt set sSet = ThisDrawing.ActiveSelectionSet sSet.SelectOnScreen cnt = sSet.Count Dim i for i=0 to cnt-1 set myObj = sSet.Item(i) if (myObj.ObjectName = "AcDbPolyline") then pptpl = ut.CreateSafeArrayFromVector(myObj.Coordinates) pt0(0) = pptpl(0) pt0(1) = pptpl(1) pt0(2) = myObj.Elevation pt1(0) = pptpl(2) pt1(1) = pptpl(3) pt1(2) = myObj.Elevation pt2(0) = pptpl(4) pt2(1) = pptpl(5) pt2(2) = myObj.Elevation pt3(0) = pptpl(6) pt3(1) = pptpl(7) pt3(2) = myObj.Elevation set solid = ms.Add3dFace(pt0,pt1,pt2,pt3) solid.layer = myObj.layer myObj.delete end if next ut.Prompt "Готово, проверяй!" sSet.Clear