daydayup 发表于 2004-10-10 16:42:00

请问如何获得图形中特定点信息??




如上的地形等高线图中,红线表示一截面.请问怎么自动获得截面与等高线交点的数据(如坐标等).请问能够自动生成该截面的剖面图吗?


我是个初学者,请各位大侠多多指教.给点思路

雪山飞狐_lzh 发表于 2004-10-10 21:45:00

你的等高线是什么，下面是我以前写的Spline等高线的剖面测试 Sub t9()
On Error GoTo ErrHandle
Dim ss As AcadSelectionSet
Dim ssLine As AcadSelectionSet
Dim ft(0) As Integer, fd(0)
Dim p1(2) As Double, p2(2) As Double
Dim pPnts()
Dim pLine As AcadLine, dot
Dim i, j
Dim pInsertPnt
Dim pInsertPnts()
Dim pNum As Integer
Dim pnt(2) As DoubleDim pStart, PEnd
Dim pCount As Integer
Dim pDistances() As Double
Set ss = ThisDrawing.SelectionSets.Add("*TlsTest*")
ft(0) = 0: fd(0) = "Spline"
ss.Select acSelectionSetAll, , , ft, fd
ReDim pPnts(ss.Count - 1)
For i = 0 To ss.Count - 1
pPnts(i) = ss(i).ControlPoints
p1(2) = pPnts(i)(2)
ss(i).Move p1, p2
Next i
Set ssLine = ThisDrawing.SelectionSets.Add("*TlsTestLine*")
ft(0) = 0: fd(0) = "Line"ssLine.Select acSelectionSetAll, , , ft, fd
For Each pLine In ssLine
pNum = 0
For i = 0 To ss.Count - 1
pInsertPnt = pLine.IntersectWith(ss(i), acExtendNone)
n = (UBound(pInsertPnt) + 1) / 3
For j = 0 To n - 1
pnt(0) = pInsertPnt(j * 3)
pnt(1) = pInsertPnt(j * 3 + 1)
pnt(2) = pPnts(i)(2)
ReDim Preserve pInsertPnts(pNum)
pInsertPnts(pNum) = pnt
pNum = pNum + 1
Next j
Next ipStart = pLine.StartPoint
PEnd = pLine.EndPoint
pCount = UBound(pInsertPnts)If Abs(Tan(pLine.Angle)) < 1 Then pNum = 0 Else pNum = 1ReDim pDistances(pCount) As Double
For i = 0 To pCount
pDistances(i) = Abs(pInsertPnts(i)(pNum) - pStart(pNum))
Next i
SortPoint pDistances, pInsertPnts, pCount
Dim pDPnts() As Double
pNum = UBound(pInsertPnts) * 3 + 2
ReDim pDPnts(pNum) As Double
For i = 0 To UBound(pInsertPnts)
pDPnts(i * 3) = pInsertPnts(i)(0)
pDPnts(i * 3 + 1) = pInsertPnts(i)(1)
pDPnts(i * 3 + 2) = pInsertPnts(i)(2)
Next i
ThisDrawing.ModelSpace.Add3DPoly(pDPnts).Rotate3D pLine.StartPoint, pLine.EndPoint, Atn(1) * 2
Next pLine
ErrHandle:
For i = 0 To ss.Count - 1
p1(2) = pPnts(i)(2)
ss(i).Move p2, p1
Next i
ThisDrawing.SelectionSets("*TlsTest*").Delete
ThisDrawing.SelectionSets("*TlsTestLine*").Delete
End Sub
Private Sub SortPoint(ByRef Values As Variant, ByRef Points As Variant, ByVal Count As Integer)
'按值将点数组排序
Dim pTemp As Double, pnt As VariantFor i = Count To 1 Step -1For j = 0 To i - 1If Values(j) > Values(j + 1) Then
pTemp = Values(j + 1)
Values(j + 1) = Values(j)
Values(j) = pTemp
pnt = Points(j + 1)
Points(j + 1) = Points(j)
Points(j) = pnt
End IfNext jNext iEnd Sub

daydayup 发表于 2004-10-11 11:31:00

谢谢斑竹的帮助！！我是个初学者，看这个程序有点困难。斑竹同志能不能再给小弟讲解一下


我的等高线是Spline吧

雪山飞狐_lzh 发表于 2004-10-11 17:52:00

<FONT face=宋体 size=2>先将曲线Move到Z＝0，与直线求交点，再还原曲线</FONT>

daydayup 发表于 2004-10-12 08:42:00

谢谢斑竹热心答疑啦!

daydayup 发表于 2004-10-13 09:15:00

再次麻烦版主了

版主同志好！！我实在是刚开始接触vba，有好多函数、方法都不懂。请问有什么书对这些有个详细的介绍呢？？我现在在看MJTD推出的AutoCAD VBA 虽然收获不少，但还是有好多东西不会啊！我该怎么学习VBA呢？？


我上面的图的等高线是扫描后矢量化的，我现在就连在平面上多条曲线和指定直线求交点都还不会，麻烦版主及各位前辈教教我！！

雪山飞狐_lzh 发表于 2004-10-13 19:40:00

先看看这



<A href="http://www.vba.cn/object/acad2004/" target="_blank" ></A>       




http://www.vba.cn/object/acad2004/

daydayup 发表于 2004-10-13 22:53:00

太谢谢版主了

daydayup 发表于 2004-10-27 12:16:00

又来麻烦版主同志了

本帖最后由 作者 于 2004-10-27 23:06:41 编辑 <br /><br /> 小弟我把版主给我参考的剖面测试代码改了改，想在一个新的图形窗口画出所得的剖面。可是我创建了新的窗口后原来代码中的



ErrHandle:<BR>For i = 0 To ss.Count - 1<BR>p1(2) = pPnts(i)(2)<BR>ss(i).Move p2, p1<BR>Next i<BR>ThisDrawing.SelectionSets("*TlsTest*").Delete<BR>ThisDrawing.SelectionSets("*TlsTestLine*").Delete


就出现了错误（对象变量和with块变量未设置）。是不是因为新的窗口没有定义 i 和选择集，要切换到原来的图形窗口。请问我该怎么做呢？


再问一句，创建所得的剖面有什么好的是现代码吗？


剖面是以相邻两点的XOY投影距离为横坐标，高程差为纵坐标。我觉得我实现的好麻烦啊，头都晕了
页: [1]
查看完整版本: 请问如何获得图形中特定点信息??