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

LIST命令的VBA代码

你好
 
我试图获取图形中所有对象的属性。
类似于在所有对象的循环中使用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。希望对您有所帮助
 
(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)


页: [1] 2
查看完整版本: LIST命令的VBA代码