Автор: Dmitry Rudenko

При корректировке контуров 3dface часто случается, что узлы разлетаются и не лежат в одной плоскости. Скрипт задаёт всем узлам выделенных 3dface координату по Z, указанную пользователем.

3dface-Z.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "Скрипт задаёт всем узлам выделенных 3dface координату по Z, указанную пользователем"
 
Dim myObj
Dim ppt3d, pt3d(11), pt3ds
 
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 = "AcDbFace") then
		ppt3d = ut.CreateSafeArrayFromVector(myObj.Coordinates)
		pt3d(0) = ppt3d(0)
		pt3d(1) = ppt3d(1)
		pt3d(2) = height
		pt3d(3) = ppt3d(3)
		pt3d(4) = ppt3d(4)
		pt3d(5) = height
		pt3d(6) = ppt3d(6)
		pt3d(7) = ppt3d(7)
		pt3d(8) = height
		pt3d(9) = ppt3d(9)
		pt3d(10) = ppt3d(10)
		pt3d(11) = height
		ut.CreateTypedArray pt3ds, 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 = pt3ds
	end if
next
ut.Prompt "Готово, проверяй!"
sSet.Clear