[VBA程序]：图形安全操作，保持图元不被拷贝走

lhx2000

想实现以下的功能，主要是对知道句柄的实体进行操作，使那些实体在COPY,MOVE等操作中被过滤掉不被操作。目前在BeginCommand命令中控制的不好，使用.PickfirstSelectionSet.Count将把所有的选择物体进行过滤掉了，在命令发出之后进行操作就无法控制了，请各位大侠给指点一下。*-*4

雪山飞狐(lzh)

Sub tt()
    Dim obj As AcadEntity, pnt
    Dim xt(1) As Integer, xd(1)
   
    ThisDrawing.Utility.GetEntity obj, pnt
    xt(0) = 1001: xd(0) = "Tls_NoCopy"
    xt(1) = 1000: xd(1) = obj.Handle
    obj.SetXData xt, xd
End Sub


Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
On Error Resume Next
    If CommandName = "COPY" Then
        Dim ss As AcadSelectionSet
        Dim ft(0) As Integer, fd(0)
        Dim xt, xd, i

        ThisDrawing.SelectionSets("Tls_NoCopy").Delete
        Set ss = ThisDrawing.SelectionSets.Add("Tls_NoCopy")
        ft(0) = 1001: fd(0) = "Tls_NoCopy"
        ss.Select acSelectionSetAll, , , ft, fd

        For Each i In ss
            i.GetXData "Tls_NoCopy", xt, xd
            If i.Handle <> xd(1) Then
                i.Delete
            End If
        Next i

        ss.Delete
    End If
End Sub

lhx2000

谢谢斑主，调试完成后我将最终成果发上来

jsycybh

确实有很多高手