老大，为什么我以下的代码会提示”未找到主键"?

h_lon · 发表于 2003-12-19 12:50:00

为什么我以下的代码会提示”未找到主键"?也没有创建新层
环境：ACAD2004
Sub aaa()

Dim a As AcadText
Dim p As Variant

p = ThisDrawing.Utility.GetPoint(, "pack a point")
Set a = ThisDrawing.ModelSpace.AddText("新年好", p, 1)
a.Layer = CreateLayer("123")
ThisDrawing.Regen acActiveViewport

End Sub
Public Function CreateLayer(ssLayerName As String) As AcadLayer
Set CreateLayer = ThisDrawing.Layers(ssLayerName)
If Err Then
      Err.Clear
      Set CreateLayer = ThisDrawing.Layers.Add(ssLayerName)
End If
End Function

efan2000 · 发表于 2003-12-19 13:33:00

没有添加错误转向语句，怎么能够处理错误。

copy


Public Function CreateLayer(ssLayerName As String) As AcadLayer
    [color=#DC143C]on error resume next[/color]
    Set CreateLayer = ThisDrawing.Layers(ssLayerName)
    If Err Then
        Err.Clear
        Set CreateLayer = ThisDrawing.Layers.Add(ssLayerName)
    End If
End Function

h_lon · 发表于 2003-12-20 09:24:00

我重写了更改图层的函数,问题得以解决!
Sub aaa()

Dim a As AcadText
Dim p As Variant

p = ThisDrawing.Utility.GetPoint(, "pack a point")
Set a = ThisDrawing.ModelSpace.AddText("新年好", p, 1)
a.Layer = CreateLayer("456").Name
ThisDrawing.Regen acActiveViewport

End Sub
Public Function CreateLayer(ssLayerName As String) As AcadLayer

Dim i As Integer
For i = 0 To ThisDrawing.Layers.Count - 1
      If ThisDrawing.Layers.Item(i).Name = ssLayerName Then
         CreateLayer = ThisDrawing.Layers(ssLayerName)
         Exit For
      Else
         Set CreateLayer = ThisDrawing.Layers.Add(ssLayerName)
         Exit For
      End If
      Next i
End Function