块清理和更新例程
大家好，Swarm的成员们：我继承了一堆乱七八糟的图纸，我需要进行大量的清理和重组，以使图纸上的块标准化为公司格式并具有可用的形状我对VBA比较陌生，一直在尝试开发一个可用于选定图形组的例程，并提供具有以下选项的按钮：
1）重命名图形上的块
2）重新定义图形上的图块
3）替换图纸上的块（用新块替换现有块）
4）更新块并同步图形上的属性到目前为止，我在完成这项任务方面几乎没有成功……谁能提供一些帮助或给我指示，让我在哪里可以找到我正在寻找的子例程，或者做一些研究来开发它们
任何帮助都将不胜感激
问候，文斯
这可能在一定程度上对你有所帮助。这最初是为了将旧标题栏更改为新标题栏
下面的部分创建了块参照的选择集。本人'；我使用一个块名数组作为我的列表。这使我能够以不同的方式处理不同的块。一旦我找到一个区块I'；m查找时，插入点、比例和旋转角度存储在变量中以供以后使用。如果有属性，则将其存储在一个数组中，以便在删除块时不会破坏这些值
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
这一块是返回的新块，其属性已反馈
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
我将挑选一个简单的。这个绘图。块（“OldBlockName”）。名称=“”；NewBlockName“； 嗨，文斯，这是我为解决你的任务而做的拙劣的尝试，虽然胖子还没有完成；J#039~ 所有这些任务都有在ACAD或express tools中为其编写的工具。只要看看你的菜单就可以了…
页:
[1]