基思,
I';对不起,我没有';我不理解你解释的解决方法。我将给出我所做的代码。希望你能修改代码,这让我更好地理解
- Option Explicit
- Dim CurUCS As AcadUCS
- Dim CurLayer As AcadLayer
- Dim UCSs As Object
- Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
- If CommandName = "XREF" Or CommandName = "XATTACH" Then
- Set CurUCS = ThisDrawing.ActiveUCS
- Set CurLayer = ThisDrawing.ActiveLayer
- Call ShowWCS
- ThisDrawing.Layers("0").Freeze = False
- ThisDrawing.Layers("0").LayerOn = True
- ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
- End If
- End Sub
- Sub ShowWCS()
- '
- ' Display WCS
- '
- Dim wcs As Object
- Dim dorigin(0 To 2) As Double
- Dim dxAxisPnt(0 To 2) As Double
- Dim dyAxisPnt(0 To 2) As Double
-
- dorigin(0) = 0#
- dorigin(1) = 0#
- dorigin(2) = 0#
-
- dxAxisPnt(0) = 1#
- dxAxisPnt(1) = 0#
- dxAxisPnt(2) = 0#
-
- dyAxisPnt(0) = 0#
- dyAxisPnt(1) = 1#
- dyAxisPnt(2) = 0#
-
- Set wcs = ThisDrawing.UserCoordinateSystems.Add(dorigin, dxAxisPnt, dyAxisPnt, "WORLD")
- ' Display WCS.
- ThisDrawing.ActiveUCS = wcs
-
- End Sub
- Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
- If CommandName = "XREF" Or CommandName = "XATTACH" Then
- ThisDrawing.ActiveUCS = CurUCS
- ThisDrawing.ActiveLayer = CurLayer
- ThisDrawing.UserCoordinateSystems.Item("World").Delete
- End If
- End Sub
如果我没有错,我知道如果取消外部参照对话框,执行控件永远不会进入EndCommand事件。请帮忙
谢谢 |