请教:如何在插入点自动打断,并使插入块与所插入直线方向一致

Roster

我想在直线上插入一个块,要求能自动打断该直线,并调整块的方向,使之与该直线方向一致,不知如何实现(VBA),请高手指点.先谢谢啦!

雪山飞狐_lzh

Sub ttt45() Dim obj As AcadLine, pnt
Dim objTemp As AcadLine
Dim minpnt, maxpnt, cenpnt(2) As Double
Dim objBlock As AcadBlockReference
Dim height As Double
Dim pnts(3)
ThisDrawing.Utility.GetEntity obj, pnt

temp = ThisDrawing.Utility.PolarPoint(pnt, obj.Angle + Atn(1) * 2, 10)
Set objTemp = ThisDrawing.ModelSpace.AddLine(pnt, temp)
pnt = obj.IntersectWith(objTemp, acExtendBoth)
objTemp.Delete

Set objBlock = ThisDrawing.ModelSpace.InsertBlock(pnt, "1", 1, 1, 1, 0)
objBlock.GetBoundingBox minpnt, maxpnt
cenpnt(0) = (minpnt(0) + maxpnt(0)) / 2
cenpnt(1) = (minpnt(1) + maxpnt(1)) / 2
height = maxpnt(1) - minpnt(1)

objBlock.Move cenpnt, pnt
objBlock.Rotate pnt, obj.Angle + Atn(1) * 2

pnts(0) = obj.StartPoint
pnts(1) = ThisDrawing.Utility.PolarPoint(pnt, obj.Angle, -height / 2)
pnts(2) = ThisDrawing.Utility.PolarPoint(pnt, obj.Angle, height / 2)
pnts(3) = obj.EndPoint
obj.Delete
ThisDrawing.ModelSpace.AddLine pnts(0), pnts(1)
ThisDrawing.ModelSpace.AddLine pnts(2), pnts(3) End Sub

Roster

成功了!非常感谢!

Roster

请问飞狐版主：如果把这里的直线改为多线该怎么实现呢，也就是说，怎么获得多线上某点所在线段（好象ACAD中多线不是由线段构成的）的座标。


先谢谢啦！

efan2000

判断点在多段线上的最近点，然后再判断最近点在哪个线段里，这要用VLAX才能求得最近点。

jason_mtc

学习了。