CAD论坛-AutoCAD,Inventor和其他Autodesk产品的提示,技巧和实用程序数据库[www.cadforum.cz]
捷克文 英语 德意志
登录/注册:
 Visitors: 2953 
RSS提示 RSS频道-CAD技巧
RSS讨论 RSS频道-CAD讨论

讨论区 讨论区

救命CAD讨论

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

请遵守 规则 这个论坛。

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

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

主题已关闭VBA GetBox

 Post Reply 发表回复
作者
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秒内生成的。