cadvba请教 [复制链接]

想编写一个vba 使当前的图层、线宽、线性、颜色为对象图层、线宽、线性、颜色



Sub MatchProperties()
    Dim sourceObj As AcadObject
    Dim destObj As AcadObject
    Dim basePnt As Variant
    Dim sourceType As String
    Dim ObjSelected As Integer
    
    ObjSelected = 1
    
    On Error Resume Next
    
Retry:
    ThisDrawing.Utility.GetEntity sourceObj, basePnt, "选择源对象："
    
    If Err <> 0 Then
        Err.Clear
        GoTo Retry
    End If
         ThisDrawing.ActiveLayer = sourceObj.Layer
    
End Sub

运行没有改变当前图层，大家看看有什么问题？谢谢！