四季因你而在 发表于 2014-10-19 12:30:28

编译错误，求高手支招！代码已附，看正文

本帖最后由 四季因你而在 于 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






四季因你而在 发表于 2014-10-23 00:23:32

沙发自己坐！大神们来帮帮忙！

ZZXXQQ 发表于 2014-10-23 06:54:30

发错地方了，这是LISP板块。

四季因你而在 发表于 2014-10-23 09:09:41

ZZXXQQ 发表于 2014-10-23 06:54 static/image/common/back.gif
发错地方了，这是LISP板块。

版主，应该在哪个板块发？

zzyong00 发表于 2014-10-23 11:18:41

你这代码应该是没问题的，
DRAWGCD不是系统命令，但这不会引起那个问题
你的错误不应该在这个sub里

四季因你而在 发表于 2014-10-25 12:19:23

zzyong00 发表于 2014-10-23 11:18 static/image/common/back.gif
你这代码应该是没问题的，
DRAWGCD不是系统命令，但这不会引起那个问题
你的错误不应该在这个sub里

大神帮分析一下具体原因可否？
页: [1]
查看完整版本: 编译错误，求高手支招！代码已附，看正文