社区 › VB › Acad 2007文件更新？

Biscuits 发表于 2007-4-2 11:11:07

Acad 2007文件更新？

以下例程查找所有模型视图，去掉它们的名称，并根据属性重命名它们。该例程是在使用Acad 2002时创建的，效果很好
[代码0；现在我们有了Acad2007，它在分配“后爆炸”；视图1“；留下此错误消息
Error-Block without PG: DWGATTRIBUTES
使用ACAD2007，I#039；我已经在ACAD2002中使用的图纸上进行了测试。问题是我们必须更新到2007年。有人能确定我们需要做什么来纠正这个问题吗？本人&#039；我被难住了
谢谢

Bryco 发表于 2007-4-2 23:21:15

饼干炸弹的功能不是&#039；t包括在内
我重写了代码，向您展示select case的用法，因为它毁了我的啤酒
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
      End Select
            
      point1 = elemBl.InsertionPoint
      point2(0) = elemBl.XScaleFactor * X + point1(0)
      point2(1) = elemBl.YScaleFactor * Y + point1(1)
      iIndex = 1 ' = nGetAttributes(elemBl) 'Get attribute TagString = PG
      If Err.Number0 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.Number0 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

Biscuits 发表于 2007-4-5 14:24:17

谢谢Bryco
有趣的修改。但仍在爆炸。

Bryco 发表于 2007-4-5 16:05:47

包括功能

Biscuits 发表于 2007-4-9 12:01:25

Bryco…
I&#039；我很困惑。你能把你认为应该写的完整代码贴出来吗。本人&#039；我在这方面毫无进展
谢谢

Biscuits 发表于 2007-4-9 14:19:42

我认为Bryco是在要求你发布缺失的功能。他的句子有点不完整，所以你永远不会真正知道。快速看一眼，我并没有看到对externaol函数的任何调用是您的代码，，，，但不管怎样。如果没有，那么您可能已经中断了所有已检查的错误，而不是承担未处理的错误。

Bryco 发表于 2007-4-9 16:44:31

Doh
我以为我在原来的帖子中包含了这个
这些天似乎每天都是星期一
Function nGetAttributes(element)
Dim ArrayAttributes As Variant
Dim I As Integer

ArrayAttributes = element.GetAttributes
nGetAttributes = 0
For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
    If (ArrayAttributes(I).TagString = "PG" Or ArrayAttributes(I).TagString = "PG1" Or ArrayAttributes(I).TagString = "2" Or ArrayAttributes(I).TagString = "PAGE_NO.") Then
      nGetAttributes = ArrayAttributes(I).TextString
      Exit Function
    End If
Next
End Function

Biscuits 发表于 2007-4-10 01:27:31

饼干你可能需要发布一个dwg，因为我不&#039；我不知道你在这些ATT中有什么，你的代码不#039；我的acad2006崩溃了，尽管mspace黯淡，因为AcadModelSpace对2007年的前景并不乐观Function nGetAttributes(element) As Integer
    Dim ArrayAttributes As Variant
    Dim I As Integer, Num
   
    ArrayAttributes = element.GetAttributes
    For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
      Select Case ArrayAttributes(I).TagString
            Case "PG", "PG1", "2", "PAGE_NO."
                Num = ArrayAttributes(I).TextString
                If IsNumeric(Num) Then
                  nGetAttributes = Int(Num)
                End If
                Exit Function
       End Select
   
    Next
End Function

Biscuits 发表于 2007-4-10 15:11:32

这是一个已经建立了4个视图的典型图纸

Bryco 发表于 2007-4-10 15:16:08

以防万一……这是现在的常规

' Author: Wellington Gomes - Darby Anderson
Option Explicit
Sub CreateRunAutoNamedView()
    ThisDrawing.SendCommand ("(defun C:RunAutoNamedView () (setvar ""filedia"" 0) (command ""_VBARUN"" ""CreateNamedViews"") (setvar ""filedia"" 1) )" & vbCr)
End Sub
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
      End Select
            
      point1 = elemBl.InsertionPoint
      point2(0) = elemBl.XScaleFactor * X + point1(0)
      point2(1) = elemBl.YScaleFactor * Y + point1(1)
      iIndex = 1 ' = nGetAttributes(elemBl) 'Get attribute TagString = PG
      If Err.Number0 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.Number0 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
Function nGetAttributes(element) As Integer
    Dim ArrayAttributes As Variant
    Dim I As Integer, Num
   
    ArrayAttributes = element.GetAttributes
    For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
      Select Case ArrayAttributes(I).TagString
            Case "PG", "PG1", "2", "PAGE_NO."
                Num = ArrayAttributes(I).TextString
                If IsNumeric(Num) Then
                  nGetAttributes = Int(Num)
                End If
                Exit Function
       End Select
   
    Next
End Function

查看完整版本: Acad 2007文件更新？