Обрамление проёмов (VBA)

Автор: Dmitry Rudenko

Актуально для желающих разобраться с основами написания скриптов на VBA.

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

proem.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
Dim layer
Set layer = ThisDrawing.Layers.Add("КЖ_арматура плит")
 
Dim oLine
Dim oDim
 
Dim point, point_sa
Dim xx
Dim yy
 
point = ut.GetPoint("0,0,0", "Укажите точку 1")
point_sa = ut.CreateSafeArrayFromVector(point)
 
xx = int(point_sa(0))
yy = int(point_sa(1))
 
Dim point2, point_sa2
Dim xx2
Dim yy2
 
point2 = ut.GetPoint("0,0,0", "Укажите точку 2")
point_sa2 = ut.CreateSafeArrayFromVector(point2)
 
xx2 = int(point_sa2(0))
yy2 = int(point_sa2(1))
 
dim a
a = abs(xx2-xx)
dim b
b = abs(yy2-yy)
dim scale
scale = 100
dim anker 
anker = 500
 
if xx>xx2 then
 xx=xx2
end if
 
if yy>yy2 then
 yy=yy2
end if 
 
line (-scale),(-anker),(-scale),(b+anker)
line (-scale-100),(-anker),(-scale-100),(b+anker)
 
line (a+scale),(-anker),(a+scale),(b+anker)
line (a+scale+100),(-anker),(a+scale+100),(b+anker)
 
line (-anker),(-scale),(a+anker),(-scale)
line (-anker),(-scale-100),(a+anker),(-scale-100)
 
line (-anker),(b+scale),(a+anker),(b+scale)
line (-anker),(b+scale+100),(a+anker),(b+scale+100)
 
Sub Line(x1,y1,x2,y2)
 Set oLine = ms.AddLine(CStr(int(xx+x1))+","+CStr(int(yy+y1))+","+CStr(0), CStr(int(xx+x2))+","+CStr(int(yy+y2))+","+CStr(0))
 oLine.Layer = "КЖ_арматура плит"
End Sub