乐筑天下

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

Acad 2007文件更新?

[复制链接]

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-2 11:11:07 | 显示全部楼层 |阅读模式
以下例程查找所有模型视图,去掉它们的名称,并根据属性重命名它们。该例程是在使用Acad 2002时创建的,效果很好
[代码0;现在我们有了Acad2007,它在分配“后爆炸”;视图1“;留下此错误消息
  1. Error-Block without PG: DWGATTRIBUTES
使用ACAD2007,I#039;我已经在ACAD2002中使用的图纸上进行了测试。问题是我们必须更新到2007年。有人能确定我们需要做什么来纠正这个问题吗?本人'我被难住了
谢谢
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-2 23:21:15 | 显示全部楼层

饼干炸弹的功能不是't包括在内
我重写了代码,向您展示select case的用法,因为它毁了我的啤酒
  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. Set mspace = ThisDrawing.ModelSpace
  20. Set mviews = ThisDrawing.Views
  21.     For Each elem In mviews
  22.         elem.Delete
  23.     Next
  24.     iIndex = 0
  25.    
  26.     For Each elemBl In mspace
  27.         If Not elemBl.EntityName = "AcDbBlockReference" Then GoTo Skip
  28.         Select Case elemBl.Name
  29.             Case "DWGATTRIBUTES", "dwgattributes", "DWGATTRIBUTES2"
  30.                 X = XValue1: Y = YValue1
  31.             Case "IITITLEHA"
  32.                 X = XValue2: Y = YValue2
  33.             Case "IITITLEVA"
  34.                 X = XValue3: Y = YValue3
  35.         End Select
  36.             
  37.         point1 = elemBl.InsertionPoint
  38.         point2(0) = elemBl.XScaleFactor * X + point1(0)
  39.         point2(1) = elemBl.YScaleFactor * Y + point1(1)
  40.         iIndex = 1 ' = nGetAttributes(elemBl) 'Get attribute TagString = PG
  41.         If Err.Number  0 Then
  42.             MsgBox "Error - Block without PG: " & elemBl.Name
  43.             Exit Sub
  44.         End If
  45.         
  46.         If iIndex = 0 Then
  47.             MsgBox "Error - Block without PG: " & elemBl.Name
  48.             Exit Sub
  49.         End If
  50.         Set Incview = ThisDrawing.Views.Add(iIndex)
  51.         If Err.Number  0 Then
  52.             MsgBox "Error - Block already exists: " & iIndex
  53.             Exit For
  54.         End If
  55.         Incview.Width = elemBl.XScaleFactor * X
  56.         Incview.Height = elemBl.YScaleFactor * Y
  57.         point2(0) = Incview.Width / 2 + point1(0)
  58.         point2(1) = Incview.Height / 2 + point1(1)
  59.         Incview.Center = point2
  60. Skip:
  61.     Next elemBl
  62. End Sub
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-5 14:24:17 | 显示全部楼层
谢谢Bryco
有趣的修改。但仍在爆炸。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-5 16:05:47 | 显示全部楼层
包括功能
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-9 12:01:25 | 显示全部楼层
Bryco…
I'我很困惑。你能把你认为应该写的完整代码贴出来吗。本人'我在这方面毫无进展
谢谢
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-9 14:19:42 | 显示全部楼层
我认为Bryco是在要求你发布缺失的功能。他的句子有点不完整,所以你永远不会真正知道。快速看一眼,我并没有看到对externaol函数的任何调用是您的代码,,,,但不管怎样。如果没有,那么您可能已经中断了所有已检查的错误,而不是承担未处理的错误。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-9 16:44:31 | 显示全部楼层
Doh
我以为我在原来的帖子中包含了这个
这些天似乎每天都是星期一
  1. Function nGetAttributes(element)
  2. Dim ArrayAttributes As Variant
  3. Dim I As Integer
  4. ArrayAttributes = element.GetAttributes
  5. nGetAttributes = 0
  6. For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
  7.     If (ArrayAttributes(I).TagString = "PG" Or ArrayAttributes(I).TagString = "PG1" Or ArrayAttributes(I).TagString = "2" Or ArrayAttributes(I).TagString = "PAGE_NO.") Then
  8.         nGetAttributes = ArrayAttributes(I).TextString
  9.         Exit Function
  10.     End If
  11. Next
  12. End Function
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-10 01:27:31 | 显示全部楼层
饼干你可能需要发布一个dwg,因为我不'我不知道你在这些ATT中有什么,你的代码不#039;我的acad2006崩溃了,尽管mspace黯淡,因为AcadModelSpace对2007年的前景并不乐观
  1. Function nGetAttributes(element) As Integer
  2.     Dim ArrayAttributes As Variant
  3.     Dim I As Integer, Num
  4.    
  5.     ArrayAttributes = element.GetAttributes
  6.     For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
  7.         Select Case ArrayAttributes(I).TagString
  8.             Case "PG", "PG1", "2", "PAGE_NO."
  9.                 Num = ArrayAttributes(I).TextString
  10.                 If IsNumeric(Num) Then
  11.                     nGetAttributes = Int(Num)
  12.                 End If
  13.                 Exit Function
  14.        End Select
  15.    
  16.     Next
  17. End Function
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-10 15:11:32 | 显示全部楼层
这是一个已经建立了4个视图的典型图纸
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-4-10 15:16:08 | 显示全部楼层
以防万一……这是现在的常规
  1. ' Author: Wellington Gomes - Darby Anderson
  2. Option Explicit
  3. Sub CreateRunAutoNamedView()
  4.     ThisDrawing.SendCommand ("(defun C:RunAutoNamedView () (setvar ""filedia"" 0) (command ""_VBARUN"" ""CreateNamedViews"") (setvar ""filedia"" 1) )" & vbCr)
  5. End Sub
  6. Sub CreateNamedViews()
  7. Dim mspace As AcadModelSpace
  8. Dim mviews As AcadViews
  9. Dim elem As Variant
  10. Dim elemBl As Variant
  11. Dim Incview As AcadView
  12. Dim iIndex As Integer
  13. Dim sName As String
  14. Const XValue1 = 15.5     ' associated constant to XScale
  15. Const YValue1 = 9.8125   ' associated constant to YScale
  16. Const XValue2 = 11       ' associated constant to XScale
  17. Const YValue2 = 8.5      ' associated constant to YScale
  18. Const XValue3 = 8.5      ' associated constant to XScale
  19. Const YValue3 = 11       ' associated constant to YScale
  20. Dim X As Double, Y As Double
  21. Dim point1 As Variant
  22. Dim point2(0 To 1) As Double
  23. 'On Error Resume Next
  24. Set mspace = ThisDrawing.ModelSpace
  25. Set mviews = ThisDrawing.Views
  26.     For Each elem In mviews
  27.         elem.Delete
  28.     Next
  29.     iIndex = 0
  30.    
  31.     For Each elemBl In mspace
  32.         If Not elemBl.EntityName = "AcDbBlockReference" Then GoTo Skip
  33.         Select Case elemBl.Name
  34.             Case "DWGATTRIBUTES", "dwgattributes", "DWGATTRIBUTES2"
  35.                 X = XValue1: Y = YValue1
  36.             Case "IITITLEHA"
  37.                 X = XValue2: Y = YValue2
  38.             Case "IITITLEVA"
  39.                 X = XValue3: Y = YValue3
  40.         End Select
  41.             
  42.         point1 = elemBl.InsertionPoint
  43.         point2(0) = elemBl.XScaleFactor * X + point1(0)
  44.         point2(1) = elemBl.YScaleFactor * Y + point1(1)
  45.         iIndex = 1 ' = nGetAttributes(elemBl) 'Get attribute TagString = PG
  46.         If Err.Number  0 Then
  47.             MsgBox "Error - Block without PG: " & elemBl.Name
  48.             Exit Sub
  49.         End If
  50.         
  51.         If iIndex = 0 Then
  52.             MsgBox "Error - Block without PG: " & elemBl.Name
  53.             Exit Sub
  54.         End If
  55.         Set Incview = ThisDrawing.Views.Add(iIndex)
  56.         If Err.Number  0 Then
  57.             MsgBox "Error - Block already exists: " & iIndex
  58.             Exit For
  59.         End If
  60.         Incview.Width = elemBl.XScaleFactor * X
  61.         Incview.Height = elemBl.YScaleFactor * Y
  62.         point2(0) = Incview.Width / 2 + point1(0)
  63.         point2(1) = Incview.Height / 2 + point1(1)
  64.         Incview.Center = point2
  65. Skip:
  66.     Next elemBl
  67. End Sub
  68. Function nGetAttributes(element) As Integer
  69.     Dim ArrayAttributes As Variant
  70.     Dim I As Integer, Num
  71.    
  72.     ArrayAttributes = element.GetAttributes
  73.     For I = LBound(ArrayAttributes) To UBound(ArrayAttributes)
  74.         Select Case ArrayAttributes(I).TagString
  75.             Case "PG", "PG1", "2", "PAGE_NO."
  76.                 Num = ArrayAttributes(I).TextString
  77.                 If IsNumeric(Num) Then
  78.                     nGetAttributes = Int(Num)
  79.                 End If
  80.                 Exit Function
  81.        End Select
  82.    
  83.     Next
  84. End Function
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 14:23 , Processed in 2.037836 second(s), 72 queries .

© 2020-2025 乐筑天下

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