乐筑天下

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

Acad 2007文件更新?

[复制链接]

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-11 00:02:21 | 显示全部楼层
2006年和2008年,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. 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.             Case Else
  36.                 GoTo Skip
  37.         End Select
  38.             
  39.         point1 = elemBl.InsertionPoint
  40.         point2(0) = elemBl.XScaleFactor * X + point1(0)
  41.         point2(1) = elemBl.YScaleFactor * Y + point1(1)
  42.         iIndex = nGetAttributes(elemBl)  'Get attribute TagString = PG
  43.         If Err.Number  0 Then
  44.             MsgBox "Error - Block without PG: " & elemBl.Name
  45.             Exit Sub
  46.         End If
  47.         
  48.         If iIndex = 0 Then
  49.             MsgBox "Error - Block without PG: " & elemBl.Name
  50.             Exit Sub
  51.         End If
  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 * X
  58.         Incview.Height = elemBl.YScaleFactor * Y
  59.         point2(0) = Incview.Width / 2 + point1(0)
  60.         point2(1) = Incview.Height / 2 + point1(1)
  61.         Incview.Center = point2
  62. Skip:
  63.     Next elemBl
  64. End Sub
回复

使用道具 举报

23

主题

68

帖子

12

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
153
发表于 2007-4-11 12:16:19 | 显示全部楼层
好的,我们很接近
如果没有现有的视图,该例程将非常有效
如果图形中有视图,但最后一个视图被删除,则例程将弹出
必须在代码的这一部分内:
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 14:28 , Processed in 0.786658 second(s), 55 queries .

© 2020-2025 乐筑天下

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