乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 41|回复： 3

Acad 2007 文件更新？

[复制链接]
Biscuits

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-2 11:11:07 | 显示全部楼层 |阅读模式
下面的例程查找所有模型视图，去掉它们的名称，并根据属性重命名它们。该例程是在我们使用Acad 2002时创建的，非常有效
  1. 

  2. ' Author: Wellington Gomes - Darby Anderson

  3. Option Explicit

  4. Sub CreateRunAutoNamedView()

  5.     ThisDrawing.SendCommand ("(defun C:RunAutoNamedView () (setvar ""filedia"" 0) (command ""_VBARUN"" ""CreateNamedViews"") (setvar ""filedia"" 1) )" & vbCr)

  6. End Sub

  7. Sub CreateNamedViews()

  8.  Dim mspace As AcadModelSpace

  9.  Dim mviews As AcadViews

  10.  Dim elem As Variant

  11.  Dim elemBl As Variant

  12.  

  13.  Dim Incview As AcadView

  14.  Dim iIndex As Integer

  15.  Dim sName As String

  16.  Const XValue1 = 15.5     ' associated constant to XScale

  17.  Const YValue1 = 9.8125   ' associated constant to YScale

  18.  Const XValue2 = 11       ' associated constant to XScale

  19.  Const YValue2 = 8.5      ' associated constant to YScale

  20.  Const XValue3 = 8.5      ' associated constant to XScale

  21.  Const YValue3 = 11       ' associated constant to YScale

  22.  Dim point1 As Variant

  23.  Dim point2(0 To 1) As Double

  24.  On Error Resume Next

  25.  

  26.  Set mspace = ThisDrawing.ModelSpace

  27.  Set mviews = ThisDrawing.Views

  28.     For Each elem In mviews

  29.         elem.Delete

  30.     Next

  31.     iIndex = 0

  32.     

  33.     For Each elemBl In mspace

  34.         If elemBl.EntityName = "AcDbBlockReference" Then

  35. '''''''''''''

  36.             If (elemBl.Name = "DWGATTRIBUTES" Or elemBl.Name = "dwgattributes" Or elemBl.Name = "DWGATTRIBUTES2") Then

  37.     

  38.                 point1 = elemBl.InsertionPoint

  39.                 point2(0) = elemBl.XScaleFactor * XValue1 + point1(0)

  40.                 point2(1) = elemBl.YScaleFactor * YValue1 + point1(1)

  41.                 iIndex = nGetAttributes(elemBl) 'Get attribute TagString = PG

  42.                 If Err.Number  0 Then

  43.                     MsgBox "Error - Block without PG: " & elemBl.Name

  44.                     Exit Sub

  45.                 End If

  46.                 

  47.                 If iIndex = 0 Then

  48.                     MsgBox "Error - Block without PG: " & elemBl.Name

  49.                     Exit Sub

  50.                 End If

  51.     

  52.                 Set Incview = ThisDrawing.Views.Add(iIndex)

  53.                 If Err.Number  0 Then

  54.                     MsgBox "Error - Block already exists: " & iIndex

  55.                     Exit For

  56.                 End If

  57.                 Incview.Width = elemBl.XScaleFactor * XValue1

  58.                 Incview.Height = elemBl.YScaleFactor * YValue1

  59.                 point2(0) = Incview.Width / 2 + point1(0)

  60.                 point2(1) = Incview.Height / 2 + point1(1)

  61.                 Incview.Center = point2

  62. '    Incview.Update

  63.             End If

  64. '''''''''''''''''''''''

  65.             If (elemBl.Name = "IITITLEHA") Then

  66.     

  67.                 point1 = elemBl.InsertionPoint

  68.                 point2(0) = elemBl.XScaleFactor * XValue2 + point1(0)

  69.                 point2(1) = elemBl.YScaleFactor * YValue2 + point1(1)

  70.                 iIndex = nGetAttributes(elemBl) 'Get attribute TagString = PG

  71.                 If Err.Number  0 Then

  72.                     MsgBox "Error - Block without PG: " & elemBl.Name

  73.                     Exit Sub

  74.                 End If

  75.                 

  76.                 If iIndex = 0 Then

  77.                     MsgBox "Error - Block without PG: " & elemBl.Name

  78.                     Exit Sub

  79.                 End If

  80.     

  81.                 Set Incview = ThisDrawing.Views.Add(iIndex)

  82.                 If Err.Number  0 Then

  83.                     MsgBox "Error - Block already exists: " & iIndex

  84.                     Exit For

  85.                 End If

  86.                 Incview.Width = elemBl.XScaleFactor * XValue2

  87.                 Incview.Height = elemBl.YScaleFactor * YValue2

  88.                 point2(0) = Incview.Width / 2 + point1(0)

  89.                 point2(1) = Incview.Height / 2 + point1(1)

  90.                 Incview.Center = point2

  91. '    Incview.Update

  92.             End If

  93. '''''''''''''''''''''''

  94.             If (elemBl.Name = "IITITLEVA") Then

  95.     

  96.                 point1 = elemBl.InsertionPoint

  97.                 point2(0) = elemBl.XScaleFactor * XValue3 + point1(0)

  98.                 point2(1) = elemBl.YScaleFactor * YValue3 + point1(1)

  99.                 iIndex = nGetAttributes(elemBl) 'Get attribute TagString = PG

  100.                 If Err.Number  0 Then

  101.                     MsgBox "Error - Block without PG: " & elemBl.Name

  102.                     Exit Sub

  103.                 End If

  104.                 

  105.                 If iIndex = 0 Then

  106.                     MsgBox "Error - Block without PG: " & elemBl.Name

  107.                     Exit Sub

  108.                 End If

  109.     

  110.                 Set Incview = ThisDrawing.Views.Add(iIndex)

  111.                 If Err.Number  0 Then

  112.                     MsgBox "Error - Block already exists: " & iIndex

  113.                     Exit For

  114.                 End If

  115.                 Incview.Width = elemBl.XScaleFactor * XValue3

  116.                 Incview.Height = elemBl.YScaleFactor * YValue3

  117.                 point2(0) = Incview.Width / 2 + point1(0)

  118.                 point2(1) = Incview.Height / 2 + point1(1)

  119.                 Incview.Center = point2

现在我们有了Acad2007，它在分配“视图1”后爆炸，并留下此错误消息
  1. 

  2. Error-Block without PG: DWGATTRIBUTES

使用ACAD2007，我在ACAD2002中使用的图纸上测试了这一点。问题在于我们更新到2007年。
有人能确定我们需要做什么来纠正这一点吗？我被难住了 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[/code]
回复

使用道具 举报

Bryco

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-2 23:21:15 | 显示全部楼层
谢谢布莱科 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
[/code]
回复

使用道具 举报

Biscuits

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-5 14:24:17 | 显示全部楼层
2006 年和 2008 年，lisp 除了代码运行良好之外什么都不做。
摆脱lisp或告诉我哪里出了问题。
  1. Sub CreateNamedViews()

  2.  Dim mspace As AcadModelSpace

  3.  Dim mviews As AcadViews

  4.  Dim elem As Variant

  5.  Dim elemBl As Variant

  6.  Dim Incview As AcadView

  7.  Dim iIndex As Integer

  8.  Dim sName As String

  9.  Const XValue1 = 15.5     ' associated constant to XScale

  10.  Const YValue1 = 9.8125   ' associated constant to YScale

  11.  Const XValue2 = 11       ' associated constant to XScale

  12.  Const YValue2 = 8.5      ' associated constant to YScale

  13.  Const XValue3 = 8.5      ' associated constant to XScale

  14.  Const YValue3 = 11       ' associated constant to YScale

  15.  Dim X As Double, Y As Double

  16.  Dim point1 As Variant

  17.  Dim point2(0 To 1) As Double

  18.  'On Error Resume Next

  19.  

  20.  Set mspace = ThisDrawing.ModelSpace

  21.  Set mviews = ThisDrawing.Views

  22.     For Each elem In mviews

  23.         elem.Delete

  24.     Next

  25.     iIndex = 0

  26.     

  27.     For Each elemBl In mspace

  28.         If Not elemBl.EntityName = "AcDbBlockReference" Then GoTo Skip

  29.         Select Case elemBl.Name

  30.             Case "DWGATTRIBUTES", "dwgattributes", "DWGATTRIBUTES2"

  31.                 X = XValue1: Y = YValue1

  32.             Case "IITITLEHA"

  33.                 X = XValue2: Y = YValue2

  34.             Case "IITITLEVA"

  35.                 X = XValue3: Y = YValue3

  36.             Case Else

  37.                 GoTo Skip

  38.         End Select

  39.             

  40.         point1 = elemBl.InsertionPoint

  41.         point2(0) = elemBl.XScaleFactor * X + point1(0)

  42.         point2(1) = elemBl.YScaleFactor * Y + point1(1)

  43.         iIndex = nGetAttributes(elemBl)  'Get attribute TagString = PG

  44.         If Err.Number  0 Then

  45.             MsgBox "Error - Block without PG: " & elemBl.Name

  46.             Exit Sub

  47.         End If

  48.         

  49.         If iIndex = 0 Then

  50.             MsgBox "Error - Block without PG: " & elemBl.Name

  51.             Exit Sub

  52.         End If

  53.         Set Incview = ThisDrawing.Views.Add(iIndex)

  54.         If Err.Number  0 Then

  55.             MsgBox "Error - Block already exists: " & iIndex

  56.             Exit For

  57.         End If

  58.         Incview.Width = elemBl.XScaleFactor * X

  59.         Incview.Height = elemBl.YScaleFactor * Y

  60.         point2(0) = Incview.Width / 2 + point1(0)

  61.         point2(1) = Incview.Height / 2 + point1(1)

  62.         Incview.Center = point2

  63. Skip:

  64.     Next elemBl

  65. End Sub

回复

使用道具 举报

Bryco

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-5 16:05:47 | 显示全部楼层
还行，离得很近！
如果没有现有的视图，例程将很好地工作。
如果图形中存在除最后一个视图之外的所有视图都被删除，则例程将爆炸。
必须在代码的这一部分中：
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 14:15 , Processed in 0.906138 second(s), 61 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表