LIST命令的VBA代码

katto01 · 发表于 2022-7-6 22:16:45

你好

我试图获取图形中所有对象的属性。
类似于在所有对象的循环中使用LIST命令。
假设我有100条ACDBPolyline，我需要提取每个点的坐标，以便进一步计算。
以交互方式，我会一次单击一条多段线，单击列表，然后（手动）复制点的坐标。
我想在VBA中循环使用这个过程。
我做了大量的搜索来寻找这个问题的答案，但什么也没有找到。
非常感谢。

BlackBox · 发表于 2022-7-6 22:22:46

我不确定我完全理解你到底想做什么。

一般来说，您可以考虑使用DATAEXTRACTION命令，如果您需要特定的工具来提取每个实体的坐标（遵循您的示例），那么这可以很容易地完成；只需要了解所需的输出（即命令行提示、写入CSV等）。

需要更多信息。

Tyke · 发表于 2022-7-6 22:30:40

黑匣子是正确的，我们需要更多的信息。

但是，如果我在VBA中正确理解了您的意思，那么您需要创建一个包含图形中所有多段线的选择集，并为每个多段线提取每个多段线的“坐标”属性，然后执行一些操作（？）和他们在一起。

这是一项足够简单的工作，但让我们更了解如何处理每个节点的坐标。在每个多段线的数组或列表中、在文本文件中或仅在VBA内部使用。世界是你的牡蛎，但请把它打开，里面可能有颗珍珠；-}

ps BB：今天是星期四！

katto01 · 发表于 2022-7-6 22:36:41

我有以下代码：
------------代码开始----------------
子allonspecifiedlayer（）
'此例程允许用户选择屏幕上的所有内容。然后一切都会过去
'并将其与图层名一起放在列表中。
'需要创建一个名为objectsfrm的表单，并将一个名为listbox1的列表框添加到表单中。

'标注这些变量
将ssetObj设置为AcadSelectionSet
将sset设置为AcadSelectionSets
Dim acadobj作为AcadObject
Dim objname作为字符串
Dim objlayer作为字符串
Dim I为整数
I=0
设置sset=ThisDrawing。选择集
对于sset中的每个ssetObj
如果UCase（ssetObj.Name）=“TEST”，则
sset。项目（“测试”）。删去
退出
如果结束
下一个
设置ssetObj=ThisDrawing。选择集。添加（“测试”）
'将所有对象添加到选择集
ssetObj。选择acSelectionSetAll
对于ssetObj中的每个acadobj
'过滤掉指定层上的所有内容。
如果是阿卡多布。层=“对象”，然后
objname=acadobj。对象名称
objlayer=acadobj。层
调试。打印objname，acadobj。处理“objectsfrm”。ListBox1.AddItem对象名
I=I+1
如果结束
下一个acadobj
'显示表单
'对象窗体。显示
末端接头
------------代码结束-------------

对于循环中的每个objname，我想提取所有信息（尤其是坐标）并将其写入excel表

Tyke · 发表于 2022-7-6 22:40:08

你需要仔细阅读邮寄代码。你将在你的脖子上得到一个你刚刚发布的mod！

Tyke · 发表于 2022-7-6 22:44:02

与其过滤图形中的所有对象，不如只过滤该图层上的多段线。目前，我没有在使用AutoCAD的机器上工作，因此帮不了我多少忙。

你想要的是可行的。编码如下：

过滤图层上的所有多段线（？或图形中的所有多段线？）
连接到Excel
对于选择集中的每个多段线，创建一个循环，将每个节点的坐标写入Excel，并增加每个点的Excel单元格值
在Excel中输入空行（？）显示新的多段线即将开始
完成后，关闭与Excel的连接

SLW210 · 发表于 2022-7-6 22:50:03

请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。

BlackBox · 发表于 2022-7-6 22:54:56

*Tips帽子*

... 但昨天不是。

不幸的是，您仍然没有提供足够的信息。。。我们得知您想要将数据导出到Excel。。。作为所有坐标的CSV转储？每个多段线一个CSV？我们需要一些所需输出的示例，以便开始为您提供正确方向的指针，以便您可以编写所需的代码。

干杯

katto01 · 发表于 2022-7-6 23:00:47

我道歉。让我试试这个：

1.我有一张有许多不同对象（多段线、轻多段线、立方体、球体等）的图纸
2、我需要获得与命令列表提供的信息相当的信息。
3.LIST命令以类似的方式将表格中的信息组织到excel文件（非csv）中

LWPOLYLINE图层“0”
手柄1bd
关闭
恒定宽度0.0000
区域6.8234
周长10.4581
在点X=12.0160 Y=11.8917 Z=0.0000处
在点X=14.7416 Y=11.8917 Z=0.0000处
在点X=14.7416 Y=9.3883 Z=0.0000处
在点X=12.0160 Y=9.3883 Z=0.0000处

BIGAL · 发表于 2022-7-6 23:06:36

这是VL代码，但很容易转换为VBA。它使用properties函数获得与您可以获得“layer”“Color”“width”等相同的co ORD。希望对您有所帮助

copy

(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)
(defun co-ords2xy (I numb xy)
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy)
(princ co-ordsxy)

[编程交流] LIST命令的VBA代码

发表回复

精选推荐