Acad 2007文件更新？

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

以下例程查找所有模型视图，去掉它们的名称，并根据属性重命名它们。该例程是在使用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的用法，因为它毁了我的啤酒

copy

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.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

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
我以为我在原来的帖子中包含了这个
这些天似乎每天都是星期一

copy


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年的前景并不乐观

copy

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

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

copy


' 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.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
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文件更新？

发表回复

精选推荐