Автор: Dmitry Rudenko

Небольшой скрипт на VBA, который устанавливает для всех отрезков в чертеже координаты начала и конца Z=0

Z0-all.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "Небольшой скрипт на VBA, который устанавливает для всех отрезков в чертеже координаты начала и конца Z=0"
 
Dim myObj
Dim ppt0, ppt1, pt0(2), pt1(2)
 
Dim i
for i=0 to ms.count - 1
	set myObj = ms.Item(i)
	if (myObj.ObjectName = "AcDbLine") then
		ppt0 = ut.CreateSafeArrayFromVector(myObj.StartPoint)
		ppt1 = ut.CreateSafeArrayFromVector(myObj.EndPoint)
 
		pt0(0) = ppt0(0)
		pt0(1) = ppt0(1)
		pt0(2) = 0
		pt1(0) = ppt1(0)
		pt1(1) = ppt1(1)
		pt1(2) = 0
 
		myObj.StartPoint = pt0
		myObj.EndPoint = pt1
	end if
next
ut.Prompt "Готово, проверяй!"

Небольшой скрипт на VBA, который устанавливает для выделенных отрезков в чертеже координаты начала и конца Z=0

Z0-selected.vbs

Dim ms
Set ms = ThisDrawing.ModelSpace
Dim ut
Set ut = ThisDrawing.Utility
 
ut.Prompt "Небольшой скрипт на VBA, который устанавливает для выделенных отрезков в чертеже координаты начала и конца Z=0"
 
Dim myObj
Dim ppt0, ppt1, pt0(2), pt1(2)
 
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)
 
		pt0(0) = ppt0(0)
		pt0(1) = ppt0(1)
		pt0(2) = 0
		pt1(0) = ppt1(0)
		pt1(1) = ppt1(1)
		pt1(2) = 0
 
		myObj.StartPoint = pt0
		myObj.EndPoint = pt1
	end if
next
ut.Prompt "Готово, проверяй!"
sSet.Clear