Сумма длин отрезков, полилиний и дуг

Автор: Dmitry Rudenko

Небольшой скрипт на VBA, который считает сумму длин всех выделенных отрезков, полилиний и дуг

summ.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "Небольшой скрипт на VBA, который считает сумму длин всех выделенных отрезков, полилиний и дуг"
 
Dim myObj
Dim summ
summ = 0
 
Dim check1, check2, check3, check4
check1 = 0
check2 = 0
check3 = 0
check4 = 0
 
Dim ppt0, ppt1
 
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 = "AcDbLine") then
		ppt0 = ut.CreateSafeArrayFromVector(myObj.StartPoint)
		ppt1 = ut.CreateSafeArrayFromVector(myObj.EndPoint)
		if ppt0(2) <> ppt1(2) then
			check1 = 1
		end if 
		ut.Prompt "Отрезок #" + CStr(i+1) + ": " + CStr(int(myObj.length)) 
		summ = summ + myObj.length
		check2 = check2 + 1
	end if
	if (myObj.ObjectName = "AcDbPolyline") then
		ut.Prompt "Полилиния #" + CStr(i+1) + ": " + CStr(int(myObj.length)) 
		summ = summ + myObj.length
		check3 = check3 + 1
	end if
	if (myObj.ObjectName = "AcDbArc") then
		ut.Prompt "Дуга #" + CStr(i+1) + ": " + CStr(int(myObj.ArcLength)) 
		summ = summ + myObj.ArcLength
		check4 = check4 + 1
	end if
next
 
if check2 > 0 then 
	ut.Prompt "Всего обнаружено отрезков: " + CStr(check2)
end if
if check3 > 0 then
	ut.Prompt "Всего обнаружено полилиний: " + CStr(check3) + ".  Внимание! Полилинии не проверяются на горизонтальность"
end if
if check4 > 0 then 
	ut.Prompt "Всего обнаружено дуг: " + CStr(check4) + ".  Внимание! Дуги не проверяются на горизонтальность"
end if
ut.Prompt "Сумма длин всех отрезков, полилиний и дуг: " + CStr(int(summ)) + " ед. чертежа."
if check2 + check3 + check4 <> cnt then
	ut.Prompt "Внимание! В набор вошли не только отрезки, полилинии и дуги"
end if
if check1 = 1 then
	ut.Prompt "Внимание! В набор вошли не плоские отрезки"
end if
sSet.Clear