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