- 积分
- 1451
- 明经币
- 个
- 注册时间
- 2014-6-20
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 四季因你而在 于 2014-10-19 12:32 编辑
我用快捷命令运行,以前能用,最近不懂怎么了,运行就提示"编译错误---不支持的对象库功能"
新手发帖,求大神支招。
Public Sub DGX_GC()
Dim DGX_1 As AcadLWPolyline
Dim DGX_2 As AcadPolyline
Dim Point1 As Variant
Dim Point2 As Variant
ThisDrawing.SetVariable "osmode", 0
ThisDrawing.SetVariable "osmode", 512
Point1 = ThisDrawing.Utility.GetPoint(, "请选择第一条等高线:")
Dim SET1 As AcadSelectionSet
Dim SET2 As AcadSelectionSet
Dim S1 As String
Dim S2 As String
S1 = "DGX1": S2 = "DGX2"
On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item(S1)) Then
Set SET1 = ThisDrawing.SelectionSets(S1)
SET1.Delete
End If
If Not IsNull(ThisDrawing.SelectionSets.Item(S2)) Then
Set SET2 = ThisDrawing.SelectionSets(S2)
SET2.Delete
End If
Set SET1 = ThisDrawing.SelectionSets.Add(S1)
Set SET2 = ThisDrawing.SelectionSets.Add(S2)
Dim F_type(4) As Integer
Dim F_data(4) As Variant
F_type(0) = -4: F_data(0) = "<or"
F_type(1) = 0: F_data(1) = "LWPOLYLINE"
F_type(2) = 0: F_data(2) = "POLYLINE"
F_type(3) = -4: F_data(3) = "or>"
F_type(4) = 8: F_data(4) = "DGX"
SET1.SelectAtPoint Point1, F_type, F_data
Dim GC1 As Double
Dim GC2 As Double
If SET1.Item(0).ObjectName = "AcDbPolyline" Then
Set DGX_1 = SET1.Item(0)
DGX_1.Highlight True
GC1 = DGX_1.Elevation
ElseIf SET1.Item(0).ObjectName = "AcDb2dPolyline" Then
Set DGX_2 = SET1.Item(0)
DGX_2.Highlight True
GC1 = DGX_2.Elevation
End If
Point2 = ThisDrawing.Utility.GetPoint(, "请选择第二条等高线:")
SET2.SelectAtPoint Point2, F_type, F_data
If SET2.Item(0).ObjectName = "AcDbPolyline" Then
Set DGX_1 = SET2.Item(0)
DGX_1.Highlight True
GC2 = DGX_1.Elevation
ElseIf SET1.Item(0).ObjectName = "AcDb2dPolyline" Then
Set DGX_2 = SET2.Item(0)
DGX_2.Highlight True
GC2 = DGX_2.Elevation
End If
ThisDrawing.SetVariable "osmode", 0
Dim Point3 As Variant
Point3 = ThisDrawing.Utility.GetPoint(, "请点击选择高程生成位置:")
Dim C1 As Double
Dim C2 As Double
C1 = ((Point1(0) - Point3(0)) ^ 2 + (Point1(1) - Point3(1)) ^ 2) ^ 0.5
C2 = ((Point2(0) - Point1(0)) ^ 2 + (Point2(1) - Point1(1)) ^ 2) ^ 0.5
Dim GCC As Double '高程差
GCC = (GC1 - GC2) * (C1 / C2)
Dim GCZ As Double
GCZ = GC1 - GCC
ThisDrawing.SendCommand "DRAWGCD" & Space(1) & 1 & Space(1) & Point3(0) & "," & Point3(1) & Space(1) & GCZ & vbCrLf
DGX_1.Highlight False
DGX_2.Highlight False
SET1.Delete
SET2.Delete
End Sub
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|