Рисуем термовкладыши

Автор: Dmitry Rudenko

Скрипт для замены выбранных отрезков на замкнутые прямоугольники со штриховкой. Длина прямоугольника равна длине отрезка, ширина - либо задаётся с клавиатуры, либо равна 200 по умолчанию.

termo.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
'создаём слой и настраиваем его
Dim layer
Set layer = ThisDrawing.Layers.Add("КЖ_элементы ПМ перфорация")
layer.color = "140"
layer.lineweight = 15
 
ut.Prompt "Скрипт для замены выбранных отрезков на замкнутые прямоугольники со штриховкой"
 
Dim line, check2
check2 = 0
 
Dim ppt0, ppt1, pt0(11)
pt0(2) = 0
pt0(5) = 0
pt0(8) = 0
pt0(11) = 0
 
Dim solid 
 
Dim pi
pi = 3.14159265359
 
Dim height, height1, height2
'height = ut.GetInteger("Введите высоту стен: ")
'height = 100
height1 = 100 'down
height2 = 100 'up
 
'настройки штриховки
dim hatch
set hatch = ms.AddHatch(1, "ANSI37", True)
hatch.PatternScale = 30
hatch.Layer = "КЖ_элементы ПМ перфорация"
 
Dim sSet, cnt
set sSet = ThisDrawing.ActiveSelectionSet
sSet.SelectOnScreen
cnt = sSet.Count
 
Dim i
for i=0 to cnt-1
	set line = sSet.Item(i)
	'ut.Prompt CStr(line.ObjectName)
	if (line.ObjectName = "AcDbLine") then
		if line.length > 199 then
			ppt0 = ut.CreateSafeArrayFromVector(line.StartPoint)
			ppt1 = ut.CreateSafeArrayFromVector(line.EndPoint)
 
			'проверяем, чтобы не делить на ноль 
			if ppt1(0)-ppt0(0) <> 0 then 
				alfa = atn((ppt1(1)-ppt0(1))/(ppt1(0)-ppt0(0)))
			else 
				alfa = 0.5 * pi
			end if
 
			pt0(0) = ppt0(0)+height1*cos(0.5*pi - alfa)
			pt0(1) = ppt0(1)-height1*cos(alfa)
			pt0(3) = ppt1(0)+height1*cos(0.5*pi - alfa)
			pt0(4) = ppt1(1)-height1*cos(alfa)
			pt0(6) = ppt1(0)-height2*cos(0.5*pi - alfa)
			pt0(7) = ppt1(1)+height2*cos(alfa)
			pt0(9) = ppt0(0)-height2*cos(0.5*pi - alfa)
			pt0(10) = ppt0(1)+height2*cos(alfa)
 
			set solid = ms.AddPolyLine(pt0)
			solid.closed = true
			solid.Layer = "КЖ_элементы ПМ перфорация"
 
			line.delete 'удаляем исходную линию
			hatch.AppendOuterLoop(solid) 'рисуем штриховку
		else
			line.delete
		end if
	else 
		check2 = 1
		'line.delete		
	end if
next
hatch.Evaluate
ut.Prompt "Готово, проверяй!"
if check2 = 1 then
	ut.Prompt " "
	ut.Prompt "Внимание! В набор вошли не только отрезки"
end if
sSet.Clear