在VBA中新建一个模块(你亦可以在原有模块中加入),复制以下代码进去。
Private View1 As View
Private Camera1 As Camera
Private TransGeom1 As TransientGeometry
Private point1, point2 As Point2d
Private Sub ffu1(ByVal inte1 As Single, ByVal inte2 As Single)
If ThisApplication.Documents.Count = 0 Or ThisApplication.ActiveDocument.DocumentType = 12292 Then
Exit Sub
End If
Set View1 = ThisApplication.ActiveView
Set Camera1 = View1.Camera
Set TransGeom1 = ThisApplication.TransientGeometry
Set point1 = TransGeom1.CreatePoint2d(0, 0)
Set point2 = TransGeom1.CreatePoint2d(inte1, inte2)
Call Camera1.ComputeWithMouseInput(point1, point2, 0, 30209)
End Sub
Sub fu4() '向左转,可设置Ctrl键+小数字键盘4作快捷键
On Error Resume Next
Call ffu1(94.24775, 0)
Camera1.Apply
End Sub
Sub fu6() '向右转,可设置Ctrl键+小数字键盘6作快捷键
On Error Resume Next
Call ffu1(-94.24775, 0)
Camera1.Apply
End Sub
Sub fu8() '向上转,可设置Ctrl键+小数字键盘8作快捷键
On Error Resume Next
Call ffu1(0, 94.24775)
Camera1.Apply
End Sub
Sub fu2() '向下转,可设置Ctrl键+小数字键盘2作快捷键
On Error Resume Next
Call ffu1(0, -94.24775)
Camera1.Apply
End Sub
Sub fu1() '逆时针转,可设置Ctrl键+小数字键盘1作快捷键
On Error Resume Next
Call ffu1(94.24775, 0)
Set point2 = TransGeom1.CreatePoint2d(0, 94.24775)
Call Camera1.ComputeWithMouseInput(point1, point2, 0, 30209)
Set point2 = TransGeom1.CreatePoint2d(-94.24775, 0)
Call Camera1.ComputeWithMouseInput(point1, point2, 0, 30209)
Camera1.Apply
End Sub
Sub fu3() '顺时针转,可设置Ctrl键+小数字键盘3作快捷键
On Error Resume Next
Call ffu1(94.24775, 0)
Set point2 = TransGeom1.CreatePoint2d(0, -94.24775)
Call Camera1.ComputeWithMouseInput(point1, point2, 0, 30209)
Set point2 = TransGeom1.CreatePoint2d(-94.24775, 0)
Call Camera1.ComputeWithMouseInput(point1, point2, 0, 30209)
Camera1.Apply
End Sub
转载于:https://www.cnblogs.com/fuzhan/archive/2009/07/27/1532203.html