2006年和2008年,lisp什么都不做,但代码运行良好
摆脱口齿不清或者告诉我哪里出错了
- Sub CreateNamedViews()
- Dim mspace As AcadModelSpace
- Dim mviews As AcadViews
- Dim elem As Variant
- Dim elemBl As Variant
- Dim Incview As AcadView
- Dim iIndex As Integer
- Dim sName As String
- Const XValue1 = 15.5 ' associated constant to XScale
- Const YValue1 = 9.8125 ' associated constant to YScale
- Const XValue2 = 11 ' associated constant to XScale
- Const YValue2 = 8.5 ' associated constant to YScale
- Const XValue3 = 8.5 ' associated constant to XScale
- Const YValue3 = 11 ' associated constant to YScale
- Dim X As Double, Y As Double
- Dim point1 As Variant
- Dim point2(0 To 1) As Double
- 'On Error Resume Next
-
- Set mspace = ThisDrawing.ModelSpace
- Set mviews = ThisDrawing.Views
- For Each elem In mviews
- elem.Delete
- Next
- iIndex = 0
-
- For Each elemBl In mspace
- If Not elemBl.EntityName = "AcDbBlockReference" Then GoTo Skip
- Select Case elemBl.Name
- Case "DWGATTRIBUTES", "dwgattributes", "DWGATTRIBUTES2"
- X = XValue1: Y = YValue1
- Case "IITITLEHA"
- X = XValue2: Y = YValue2
- Case "IITITLEVA"
- X = XValue3: Y = YValue3
- Case Else
- GoTo Skip
- End Select
-
- point1 = elemBl.InsertionPoint
- point2(0) = elemBl.XScaleFactor * X + point1(0)
- point2(1) = elemBl.YScaleFactor * Y + point1(1)
- iIndex = nGetAttributes(elemBl) 'Get attribute TagString = PG
- If Err.Number 0 Then
- MsgBox "Error - Block without PG: " & elemBl.Name
- Exit Sub
- End If
-
- If iIndex = 0 Then
- MsgBox "Error - Block without PG: " & elemBl.Name
- Exit Sub
- End If
- Set Incview = ThisDrawing.Views.Add(iIndex)
- If Err.Number 0 Then
- MsgBox "Error - Block already exists: " & iIndex
- Exit For
- End If
- Incview.Width = elemBl.XScaleFactor * X
- Incview.Height = elemBl.YScaleFactor * Y
- point2(0) = Incview.Width / 2 + point1(0)
- point2(1) = Incview.Height / 2 + point1(1)
- Incview.Center = point2
- Skip:
- Next elemBl
- End Sub
|