[推荐]深入研究《锁定标注文字不随对象缩放而动态变化》示例
本帖最后由 作者 于 2008-4-8 10:36:46 编辑 <br /><br /> <p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">原文及程序详见<font face="Times New Roman">AutoCAD VBA</font>二次开发教程<font face="Times New Roman"><br/> </font>第<font face="Times New Roman">127</font>页<font face="Times New Roman">-132</font>页。</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">以下程序与原程序区别是用<font face="Times New Roman">debug.print</font>，测试关键点返回数据。</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">Function FixDimText(Dimension As AcadDimension) As String</font></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>在复制标注对象前先保存当前图形中的块数量</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Dim BlockCount As Long</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Debug.Print Dimension.ObjectName, Dimension.OwnerID, Dimension.TextOverride</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> BlockCount = ThisDrawing.Blocks.Count</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Debug.Print BlockCount</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>复制需要锁定文字内容的标注对象</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Dim CopyDimension As AcadDimension</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Set CopyDimension = Dimension.Copy</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>检查块数量是否增加，而且新增加的块名前缀是否为<font face="Times New Roman">"*D"</font></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Dim NewBlockCount As Long</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> NewBlockCount = ThisDrawing.Blocks.Count</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Debug.Print NewBlockCount</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> If NewBlockCount = BlockCount + 1 And Left(ThisDrawing.Blocks(BlockCount).Name, 2) = "*D" Then </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>遍历块中的对象，取得文字内容</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Dim EntityInBlock As AcadEntity</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> For Each EntityInBlock In ThisDrawing.Blocks(BlockCount)</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Debug.Print EntityInBlock.ObjectName, EntityInBlock.OwnerID</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> If EntityInBlock.ObjectName = "AcDbMText" Then</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>将文字内容替换掉标注对象的文字内容</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Dimension.TextOverride = EntityInBlock.TextString</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Exit For</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> End If</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> Next</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> End If</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> '</font></span>删除复制的标注对象</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> CopyDimension.Delete</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> FixDimText = Dimension.TextOverride</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">End Function</font></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><p><font face="Times New Roman"> </font></p></p><p><font face="Times New Roman"> </font></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">通过测试不同的施工图（不同的单位、不同的个人的<font face="Times New Roman">dwg</font>文件）后，发现<p></p></p><p></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">NewBlockCount = BlockCount + 1 And Left(ThisDrawing.Blocks(BlockCount).Name, 2) = "*D" <p></p></font></p><p></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">的运行结果为<font face="Times New Roman">False</font>，导致整个程序无法运行。
<p></p></p><p></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><p><font face="Times New Roman"> </font></p></p><p><font face="Times New Roman"> </font></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">正确运行这个程序的结果</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbRotatedDimension<span style="mso-spacerun: yes;"> 2130001144 200{}{}</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> 10 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman"><span style="mso-spacerun: yes;"> 11</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">能找到<font face="Times New Roman">*D</font>的<font face="Times New Roman">OwnerID</font></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbLine<span style="mso-spacerun: yes;"> 2123471264 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbLine<span style="mso-spacerun: yes;"> 2123471264 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbLine<span style="mso-spacerun: yes;"> 2123471264 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbSolid<span style="mso-spacerun: yes;"> 2123471264 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbSolid<span style="mso-spacerun: yes;"> 2123471264 </font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbMText<span style="mso-spacerun: yes;"> 2123471264</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">不正确运行这个程序的结果为</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">AcDbRotatedDimension<span style="mso-spacerun: yes;"> 2130001144 120{}{}</font></span></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">找不到<font face="Times New Roman">*D</font>的<font face="Times New Roman">OwnerID</font></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">讨论的问题是
<p></p></p><p></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">*D</font>与<font face="Times New Roman">dimension</font>的父子关系
<p></p></p><p></p><p></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;"><font face="Times New Roman">*D</font>的<font face="Times New Roman">OwnerID</font>与<font face="Times New Roman">dimension</font>的<font face="Times New Roman">OwnerID</font>的关系。
<p></p></p><p></p><p></p> <p>自从AutoCAD有了关联标注后，使用这种方法来取得标注对应的图块就不灵验了。</p><p>从目前看只能使用你上次外国佬写的那个标注对象所对应图块的程序来解决。</p>
页:
[1]