区块清理和更新程序
嗨，沼泽成员：我继承了一堆图纸，我需要执行大量的清理和重组，以使图纸上的块标准化为公司格式和可用形状。
我对VBA比较陌生，并且一直在尝试开发一个可以在选定的图形组上使用的例程，并提供具有以下选项的按钮：
1）重命名图形上的块
2）重新定义图形上的块
3）替换图形上的块（用新块替换现有块）
4）更新块并同步图形
上的属性到目前为止，我在完成这项任务方面几乎没有取得什么成功.....任何人都可以提供一些帮助或指导我在哪里可以找到我正在寻找的子例程或做一些研究来开发它们。
任何帮助将不胜感激.
问候，
文斯
**** Hidden Message ***** 这可能会对您有所帮助。这最初是为了将旧标题栏更改为新标题块而编写的。
下面的部分创建了块参照的选择集。我使用一个块名称数组作为我的列表。这使我能够以不同的方式处理不同的块。找到要查找的块后，插入点、刻度和旋转角度将存储在变量中供以后使用。如果存在属性，则这些属性将存储在一个数组中，以便在删除块时不会破坏这些值。
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
这块是带有反馈属性的新块
。
我会挑容易的。
这张图纸。Blocks("OldBlockName ")。Name = "NewBlockName " 嗨，文斯
这是我解决你的任务的一点小意思，
虽然还没完成
胖子
~'J'~ 所有这些任务都有在 ACAD 或 Express 工具中为其编写的工具。看看你的菜单...
页:
[1]