jiangmolhm 发表于 2010-8-5 11:44:00

[已解决]如何给两个同名的块重命名?

本帖最后由 作者 于 2010-8-5 13:02:26 编辑 <br /><br /> <p><font face="Verdana">我将一个块复制黏贴成另外一个块后，如何在VBA里给两个块重命名啊?&nbsp;以下代码执行后，两个块还是变成一样的名字</font></p>
<p><font face="Verdana"></font>&nbsp;</p>
<p><font face="Verdana">&nbsp; Dim sset As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Set sset = ThisDrawing.SelectionSets.Add("Selection")<br/>&nbsp;&nbsp;&nbsp; ' Define the filter list, only Circle objects<br/>&nbsp;&nbsp;&nbsp; ' will be selectable<br/>&nbsp;&nbsp;&nbsp; Dim FilterType(0) As Integer<br/>&nbsp;&nbsp;&nbsp; Dim FilterData(0) As Variant<br/>&nbsp;&nbsp;&nbsp; FilterType(0) = 0<br/>&nbsp;&nbsp;&nbsp; FilterData(0) = "Block"<br/>&nbsp;<br/>&nbsp;&nbsp;&nbsp; ' Prompt the user to select objects<br/>&nbsp;&nbsp;&nbsp; ' and add them to the selection set<br/>&nbsp;&nbsp;&nbsp; sset.Select acSelectionSetAll, FilterType, FilterData<br/>&nbsp;<br/>&nbsp;&nbsp;&nbsp; MsgBox "Number of objects selected: " &amp; sset.Count</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp; For Count = 0 To sset.Count - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set BlockObj = ThisDrawing.Blocks(sset.Item(Count).EffectiveName) '感觉是这里有问题，但是不知道怎么分别查找这两个同名块<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; BlockObj.name =&nbsp;sset.Item(Count).ObjectID</font></p>
<p><font face="Verdana">&nbsp;&nbsp;&nbsp; Next Count&nbsp;<br/>&nbsp;&nbsp;&nbsp; sset.Delete</font></p>

jiangmolhm 发表于 2010-8-5 13:04:00

<p>参考代码 <font face="Verdana"><a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79706">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79706</a></font></p>
<p>&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;objBlkRef&nbsp;As&nbsp;AcadBlockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;blockNow&nbsp;As&nbsp;AcadBlock<br/>&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;objb&nbsp;As&nbsp;AcadBlockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;BlockY&nbsp;As&nbsp;AcadBlock<br/>&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;BlockYorg&nbsp;As&nbsp;ACAD_POINT<br/><br/><br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;objBlkRef&nbsp;=&nbsp;elem<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;BlockY&nbsp;=&nbsp;ThisDrawing.Blocks.Item(objBlkRef.EffectiveName)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;BlockYorg&nbsp;=&nbsp;BlockY.Origin<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;blockNow&nbsp;=&nbsp;ThisDrawing.Blocks.Add(BlockYorg,&nbsp;objBlkRef.ObjectID)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;objb&nbsp;=&nbsp;blockNow.InsertBlock(BlockYorg,&nbsp;objBlkRef.name,&nbsp;1,&nbsp;1,&nbsp;1,&nbsp;0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objb.Explode<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objb.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objBlkRef.name&nbsp;=&nbsp;blockNow.name</p>
页: [1]
查看完整版本: [已解决]如何给两个同名的块重命名?