由于工作的需要，试着写了一段在等高线上剖断面的程序，觉得很好玩，程序这个东西，只要你能想到的功能，基本上都可以实现，也满足了偷懒的愿望。 当然等高线地线图要求是三维的，就是说线的Z高程与所标的高程要一样。然后画一条线表示断面位置，运行程序，先后选择这条线和等高线，在指定位置生成断面。其要点是要把等高线的高程改到与断面线的高程一致，求出交点坐，再改回原来的高程。只要求出交点坐标，其它的不就好说了吗！欢迎大家探讨。
2楼
在哪里啊
……
回复
3楼
楼主在什么地方啊:( ,怎么找不到呀
回复
4楼
CAD求交点坐标程序
编辑 | 删除 | 权限设置 | 更多▼ 设置置顶
推荐日志
转到私密记事本
飞天舞 发表于2009年11月14日 15:44 阅读(39) 评论(2)
分类： 电脑技术 权限: 公开
Dim SS As AcadSelectionSet '声明选择集变量
Dim Ft(0) As Integer, Fd(0) As Variant '声明选择集过滤器数组变量
Dim P() As Double '声明一个双精度型动态数组,用于保存所有交点坐标
Dim V As Variant '声明一个变体型变量,用于提取两直线的交点
Dim I As Long, J As Long '循环变量
Dim S As String '一个字符串,用于消息框
On Error Resume Next
Set SS = ThisDrawing.SelectionSets.Add("SS") '新建选择集
Ft(0) = 0 '定义过滤器,组码为0,检查对象类型
Fd(0) = "line" '对象类型为直线
SS.Select acSelectionSetAll, , , Ft, Fd '选择所有直线
If SS.Count >= 2 Then '检查被加入选择集的直线数量,只有数量大于或等于2时才能检查交点
For I = 0 To SS.Count - 2 '用嵌套循环方式检查某条直线与其它所有直线的交点
For J = I + 1 To SS.Count - 1
V = SS.Item(I).IntersectWith(SS.Item(J), acExtendNone) '获得交点,用两条直线均不延伸的模式
If UBound(V) = 2 Then '检查是否有交点
If UBound(P, 2) < 0 Then '重定义数组
ReDim P(2, 0)
Else
ReDim Preserve P(2, UBound(P, 2) + 1)
End If
P(0, UBound(P, 2)) = V(0) '把交点坐标存入动态数组
P(1, UBound(P, 2)) = V(1)
P(2, UBound(P, 2)) = V(2)
End If
Next
Next
If UBound(P, 2) < 0 Then
MsgBox "没有交点", vbOKOnly, "AutoCAD"
Else
S = "共有 " & UBound(P, 2) + 1 & " 个交点"
For I = 0 To UBound(P, 2)
S = S & vbCrLf & P(0, I) & "," & P(1, I) & "," & P(2, I)
Next
MsgBox S, vbOKOnly, "AutoCAD"
End If
Else
MsgBox "直线少于两条", vbOKOnly, "AutoCAD"
End If
SS.Delete '删除用过的选择集
End Sub
回复
5楼
怎样加载？
回复
6楼
CAD菜单——工具——宏——输入宏名，点新建，代码复制到里面就行了，然后运行！
回复
7楼
回复
