区块清理和更新程序

Vince · 发表于 2006-9-20 08:01:01

嗨，沼泽成员：
我继承了一堆图纸，我需要执行大量的清理和重组，以使图纸上的块标准化为公司格式和可用形状。
我对VBA比较陌生，并且一直在尝试开发一个可以在选定的图形组上使用的例程，并提供具有以下选项的按钮：
1）重命名图形上的块
2）重新定义图形上的块
3）替换图形上的块（用新块替换现有块）
4）更新块并同步图形
上的属性到目前为止，我在完成这项任务方面几乎没有取得什么成功.....任何人都可以提供一些帮助或指导我在哪里可以找到我正在寻找的子例程或做一些研究来开发它们。
任何帮助将不胜感激.
问候，
文斯

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Arizona · 发表于 2006-9-20 12:41:29

这可能会对您有所帮助。这最初是为了将旧标题栏更改为新标题块而编写的。
下面的部分创建了块参照的选择集。我使用一个块名称数组作为我的列表。这使我能够以不同的方式处理不同的块。找到要查找的块后，插入点、刻度和旋转角度将存储在变量中供以后使用。如果存在属性，则这些属性将存储在一个数组中，以便在删除块时不会破坏这些值。

copy

Set objAcadSSet = ThisDrawing.SelectionSets.Add("sSet2")
 
intTextCodes(0) = 0 'set code for entities
varCodeValues(0) = "INSERT" 'set entity type to filter
objAcadSSet.Select acSelectionSetAll, , , intTextCodes, varCodeValues   'create set
For Each objOldBlk In objAcadSSet
   BName = UCase(objOldBlk.Name)
      Select Case BName
      
          Case arOldBlkNames(0)     'ctml0011
              InsertPt(0) = objOldBlk.InsertionPoint(0)
              InsertPt(1) = objOldBlk.InsertionPoint(1)
              InsertPt(2) = objOldBlk.InsertionPoint(2)
              xScale = objOldBlk.XScaleFactor
              yScale = objOldBlk.YScaleFactor
              zScale = objOldBlk.ZScaleFactor
              Rot = objOldBlk.Rotation
           If objOldBlk.HasAttributes Then
              varOldAtt = objOldBlk.GetAttributes     'get block attributes
            End If
          For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
            Set objOldAttRef = varOldAtt(intOldCnt)
          Next intOldCnt
            NewBlkName = "CTML0013.dwg"
      NewBlk