Нумерация в правом верхнем углу

Автор: Dmitry Rudenko

Скрипт автоматически проставляет нумерацию "страниц" в правом верхнем углу листа

Тестировалось на:

• nanoCAD СПДС 4.0 сборка 512
• nanoCAD СПДС 4.0 сборка 665

Необходимые условия для работы скрипта:

1. Готовые рамки - скачать по ссылке

numerator.vbs

on error resume next
Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "Нумерация в правом верхнем углу"
 
Dim myObj
Dim ppt0, pt0
 
Dim list(999), Xpos(999), Ypos(999) '999 листов должно хватить, ятд
 
Dim i, m
m = 0
 
dim first
first = ut.getinteger("Введите номер первого листа")
first = first - 1
 
'прогоняем все объекты модели. если среди них есть блоки с определёнными названиями, сохраняем номер и точку вставки 
for i=0 to ms.count-1
	set myObj = ms.Item(i)
	if (myObj.ObjectName = "AcDbBlockReference") then
		if (myobj.name = "КЖ-А1" OR myobj.name = "КЖ-А2" OR myobj.name = "КЖ-А3" OR myobj.name = "КЖ-А4") then
			m = m+1 'счётчик листов
			nabor myobj, i 'сохраняем координаты рамок и номер элемента в списке 
		end if
	end if
next
 
Xsort 'запускаем функцию сортировки листов по положению в модели (слева направо)
Ysort 'сортируем листы по Y
 
'нумеруем листы 
for i=1 to m
	set myObj = ms.Item(list(i))
	CreateLayout myobj
next 
 
ut.Prompt "Готово, проверяй!"
 
' ===== КОНЕЦ. Дальше функции =====
 
'сохраняем координаты рамок и номер элемента в списке выбора
Function nabor(myobj, i)
	pt0 = myobj.InsertionPoint
	ppt0 = ut.CreateSafeArrayFromVector(pt0)
	list(m)=i
	Xpos(m)=int(ppt0(0))
	Ypos(m)=int(ppt0(1)/1000)*1000
End Function 
 
'сортируем листы по X
Function Xsort()
	on error resume next
	ut.Prompt "Сортировка по горизонтали"
	Dim a, b
	for a=1 to m-1 
		for b=1 to m-1
			if Xpos(b)>Xpos(b+1) then
				temp = Xpos(b)
				Xpos(b) = Xpos(b+1)
				Xpos(b+1) = temp
 
				temp = list(b)
				list(b) = list(b+1)
				list(b+1) = temp
 
				temp = Ypos(b)
				Ypos(b) = Ypos(b+1)
				Ypos(b+1) = temp
			end if
		next
	next	
End Function 
 
'сортируем листы по Y
Function Ysort()
	on error resume next
	ut.Prompt "Сортировка по вертикали"
	Dim a, b
	for a=1 to m-1 
		for b=1 to m-1
			if Ypos(b)<Ypos(b+1) then
				temp = Xpos(b)
				Xpos(b) = Xpos(b+1)
				Xpos(b+1) = temp
 
				temp = list(b)
				list(b) = list(b+1)
				list(b+1) = temp
 
				temp = Ypos(b)
				Ypos(b) = Ypos(b+1)
				Ypos(b+1) = temp
			end if
		next
	next	
End Function 
 
'нумеруем листы 
Function CreateLayout(myobj) 
	dim att
	att = myobj.GetAttributes()
 
	if att(0).TagString = "num" then 
		att(0).TextString = first + i 
	else
		att(1).TextString = first + i
	end if
End Function