CAD论坛-AutoCAD，Inventor和其他Autodesk产品的提示，技巧和实用程序数据库[www.cadforum.cz]
捷克文 英语 德意志
登录/注册：
 Visitors: 2953 
在Facebook上成为CADforum的粉丝 在推特上关注我们
百威博客 您Tube频道
CAD工作室
RSS提示 RSS频道-CAD技巧
RSS讨论 RSS频道-CAD讨论

讨论区 讨论区

救命CAD讨论

CAD论坛-主页 CAD讨论论坛-在此处提出任何与CAD相关的问题，并与来自世界各地的同行分享您在AutoCAD，Inventor，Revit和其​​他Autodesk软件方面的CAD知识。要开始一个新主题，请选择一个合适的论坛。

请遵守 规则 这个论坛。

如何发布问题： 注册或登录，请转到特定的论坛，然后单击“新主题”按钮。
  常问问题 常问问题  论坛搜索   大事记   寄存器 寄存器  登录 登录

您在此表单中提供的信息将构成您的论坛个人资料，其他论坛成员可以查看。 您的电子邮件地址仅对论坛管理员和主持人可见，并将用于向您发送论坛通知。要取消您的帐户，请使用页面 选择退出 或联系[email protected]。

主题已关闭VBA GetBox
 Post Reply 发表回复
作者
  主题搜寻 Topic 搜索  主题选项 主题选项
katto01 查看下拉
新手
新手


加入：2009年6月24日
地点：日本
状态：离线
点数：10 		直接链接到这篇文章 主题：VBA GetBox
    发表于：16.Jul.2018 at 17:38
您好，
我正在尝试获取图层上所有实体的边界框。
我希望能够通过EXCEL做到这一点。我试图修改可以在AutoCAD VBA中工作的AutoCAD VBA例程以在EXCEL中工作，但是我似乎错过了一些东西。请在下面查看我的代码。它在ss（0）..行失败。
请指教
谢谢


子Get_BoundingBox（）

昏暗的XNAME作为字符串
'On Error Resume 下一页'，这告诉VBA忽略错误
Set ACAD = GetObject（，“ 的AutoCAD.Application”）'获取类AutoCAD.Application的运行实例

Dim ssetObj作为AcadSelectionSet
暗号作为AcadSelectionSets
昏暗的acadobj作为AcadObject
昏暗的objname作为字符串
Dim ptllmin作为变体
Dim ptllmax作为变体
变暗HH作为变体
昏暗的objlayer作为字符串
Dim 恩tItem作为AcadEntity

昏暗我作为整数
暗角1（0至2）为双
暗角2（0至2）为双

corner1（0）= -10000000000＃：corner1（1）= -10000000000＃：corner1（2）= 0
corner2（0）= 10000000000＃：corner2（1）= 10000000000＃：corner2（2）= 0

I = 0

设置sset = ACAD.ActiveDocument.SelectionSets

对于每个sset
如果UCase（ssetObj.Name）=“ TEST”，则
sset.Item（“ TEST”）。删除
退出
万一
下一页

设置ssetObj = ACAD.ActiveDocument.SelectionSets.Add（“ TEST”）

'将所有对象添加到选择集中
ssetObj.Select acSelectionSetAll
Q $ = Chr（9）
对于ssetObj中的每个acadobj
objname = acadobj.ObjectName
objlayer = acadobj.Layer
HH = acadobj.Handle
  
  Const X = 0
  Const Y = 1

 ss（0）.GetBoundingBox ptMin，ptMax
 对于ss中的每个entItem
     ACAD.ActiveDocument.entItem.GetBoundingBox ptllmin，ptllmax
    If ptllmin(X) <ptMin（X）然后ptMin（X）= ptllmin（X）
    If ptllmin(Y) <ptMin（Y）然后ptMin（Y）= ptllmin（Y）
    If ptllmax(X) >ptMax（X）然后ptMax（X）= ptllmax（X）
    If ptllmax(Y) >ptMax（Y）然后ptMax（Y）= ptllmax（Y）
  下一页
Sheet5.Cells（I，1）.Value = I
Debug.Print objname，Q $，objlayer，Q $，HH
我=我+ 1
Sheet5.Cells（I，1）.Value = I
Sheet5.Cells（I，2）.Value = objname
Sheet5.Cells（I，3）.Value = objlayer
Sheet5.Cells（I，4）.Value = HH
Sheet5.Cells（I，5）.Value = ptMin（X）
Sheet5.Cells（I，6）.Value = ptMin（Y）
Sheet5.Cells（I，7）.Value = ptMax（X）
Sheet5.Cells（I，7）.Value = ptMax（Y）

下一个acadobj

结束子
回到顶部

相关的CAD技巧:


 Post Reply 发表回复
  分享主题   

论坛跳转 论坛权限 查看下拉



此页面是在0.047秒内生成的。
CAD论坛-AutoCAD 发明者 Revit 3ds Max LT提示技巧建议帮助常见问题解答如何支持Autodesk Xanadu 版
Copyright ©2021 CAD工作室 s.r.o. （Arkance Systems）-Autodesk白金合作伙伴&咨询服务合作伙伴
CAD论坛 -技巧，窍门，实用工具，讨论•联系方式： [email protected] • 广告 和我们 • 在线隐私
排行榜