帮忙看下代码从VBA编辑器运行正常，从命令行启动他就显示找不到边界！！
<p>帮忙看下代码从VBA编辑器运行正常，从命令行启动他就显示找不到边界！！（使用的是先选择后执行透明命令方式）</p><p>Public Sub qt() '快速填充<br/> On Error GoTo err<br/> Dim hatchObj As AcadHatch<br/> Dim patternName As String<br/> Dim PatternType As Long<br/> Dim bAssociativity As Boolean<br/> Dim outerLoop(0) As AcadEntity ' 定义图案填充<br/> patternName = "ANSI31"<br/> PatternType = 0<br/> bAssociativity = True<br/> Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) ' 当前图纸的实体数目<br/> Dim n As Long<br/> n = ThisDrawing.ModelSpace.Count ' 调用BOUNDARY命令获取某一点处的边界<br/> Dim Pt As Variant<br/> Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br/> ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr ' 如果存在边界，则会生成新的实体<br/> ThisDrawing.Regen True<br/> If ThisDrawing.ModelSpace.Count > n Then<br/> Set outerLoop(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<br/> Else<br/> MsgBox "没有找到边界！"<br/> GoTo err<br/> End If<br/> hatchObj.AppendOuterLoop outerLoop ' 计算并显示图案填充<br/> hatchObj.Evaluate<br/> outerLoop(0).Delete<br/> ThisDrawing.Regen True<br/>err:<br/>End Sub<br/></p> 补充说明：在命令行执行中其实通过《ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr ' 如果存在边界，则会生成新的实体》后模型空间中已经创建了封闭对象的，但是下一句ThisDrawing.ModelSpace.Count 就统计不到刚才生成的这个对象数量。请问是不是要在执行生成封闭对象后要更新或延时下呢？如何操作。 本帖最后由 作者 于 2008-5-15 14:23:16 编辑 <br /><br /> <p>我没有办法了！只有采用一个很笨的办法，先用一个命令生成边界后再在命令行调用另外一个命令生成填充</p><p>Public Sub qt() '快速填充<br/> On Error GoTo err<br/> Dim hatchObj As AcadHatch<br/> Dim patternName As String<br/> Dim PatternType As Long<br/> Dim bAssociativity As Boolean<br/> Dim outerLoop(0) As AcadEntity ' 定义图案填充<br/> Dim eNt As AcadEntity<br/> patternName = "ANSI31"<br/> PatternType = 0<br/> bAssociativity = True<br/> Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) </p><p> ' 当前图纸的实体数目<br/> Dim sset As AcadSelectionSet<br/> Set sset = ThisDrawing.SelectionSets.Add("ss")<br/> sset.Select acSelectionSetLast'得到最近一次创建的图元<br/> For Each eNt In sset<br/> Set outerLoop(0) = eNt<br/> Next<br/> hatchObj.AppendOuterLoop outerLoop ' 计算并显示图案填充<br/> hatchObj.Evaluate<br/> outerLoop(0).Delete<br/> ThisDrawing.Regen True<br/>err:<br/>sset.Delete<br/>End Sub<br/>Public Sub bb() '快速填充前先画出边界准备<br/> Dim Pt As Variant<br/> Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br/> ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr </p><p>ThisDrawing.SendCommand "qt" & vbCr </p><p>& Pt(0) & "," & Pt(1) & vbCr & vbCr ' 如果存在边界，则会生成新的实体<br/>End Sub</p>
页:
[1]