块清理和更新例程

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

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

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

这可能在一定程度上对你有所帮助。这最初是为了将旧标题栏更改为新标题栏
下面的部分创建了块参照的选择集。本人&#039；我使用一个块名数组作为我的列表。这使我能够以不同的方式处理不同的块。一旦我找到一个区块I&#039；m查找时，插入点、比例和旋转角度存储在变量中以供以后使用。如果有属性，则将其存储在一个数组中，以便在删除块时不会破坏这些值

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

这一块是返回的新块，其属性已反馈

copy

Case arOldBlkNames(0)         'CTMl0011
   Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot) 'insert new tblock
      
   varNewAtt = objNewBlk.GetAttributes 'get attributes
   For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
       For intNewCnt = LBound(varNewAtt) To UBound(varNewAtt)
            If varNewAtt(intNewCnt).TagString = varOldAtt(intOldCnt).TagString Then
                varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
      Next
   Next