明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1477|回复: 2

帮忙看下代码从VBA编辑器运行正常,从命令行启动他就显示找不到边界!!

[复制链接]
发表于 2008-5-15 10:43:00 | 显示全部楼层 |阅读模式

帮忙看下代码从VBA编辑器运行正常,从命令行启动他就显示找不到边界!!(使用的是先选择后执行透明命令方式)

Public Sub qt() '快速填充
    On Error GoTo err
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim outerLoop(0) As AcadEntity    ' 定义图案填充
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)   ' 当前图纸的实体数目
    Dim n As Long
    n = ThisDrawing.ModelSpace.Count    ' 调用BOUNDARY命令获取某一点处的边界
    Dim Pt As Variant
    Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
    ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr    ' 如果存在边界,则会生成新的实体
    ThisDrawing.Regen True
    If ThisDrawing.ModelSpace.Count > n Then
        Set outerLoop(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
    Else
        MsgBox "没有找到边界!"
        GoTo err
    End If
    hatchObj.AppendOuterLoop outerLoop    ' 计算并显示图案填充
    hatchObj.Evaluate
    outerLoop(0).Delete
    ThisDrawing.Regen True
err:
End Sub

 楼主| 发表于 2008-5-15 10:50:00 | 显示全部楼层
补充说明:在命令行执行中其实通过《ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr    ' 如果存在边界,则会生成新的实体》后模型空间中已经创建了封闭对象的,但是下一句ThisDrawing.ModelSpace.Count 就统计不到刚才生成的这个对象数量。请问是不是要在执行生成封闭对象后要更新或延时下呢?如何操作。
 楼主| 发表于 2008-5-15 11:51:00 | 显示全部楼层
本帖最后由 作者 于 2008-5-15 14:23:16 编辑

我没有办法了!只有采用一个很笨的办法,先用一个命令生成边界后再在命令行调用另外一个命令生成填充

Public Sub qt() '快速填充
    On Error GoTo err
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim outerLoop(0) As AcadEntity    ' 定义图案填充
    Dim eNt As AcadEntity
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

  ' 当前图纸的实体数目
    Dim sset As AcadSelectionSet
    Set sset = ThisDrawing.SelectionSets.Add("ss")
    sset.Select acSelectionSetLast'得到最近一次创建的图元
    For Each eNt In sset
        Set outerLoop(0) = eNt
    Next
    hatchObj.AppendOuterLoop outerLoop    ' 计算并显示图案填充
    hatchObj.Evaluate
    outerLoop(0).Delete
    ThisDrawing.Regen True
err:
sset.Delete
End Sub
Public Sub bb() '快速填充前先画出边界准备
    Dim Pt As Variant
    Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
    ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr

ThisDrawing.SendCommand "qt" & vbCr

& Pt(0) & "," & Pt(1) & vbCr & vbCr    ' 如果存在边界,则会生成新的实体
End Sub

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 09:36 , Processed in 0.183359 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表