“Ac”层下的面积声明

sanju2323 · 发表于 2022-7-5 20:08:39

我需要通过使用闭合多段线的Lisp将“获取的编号和面积”层下的现有编号转换为csv的面积声明。
请注意，合并区域编号相同。
要求区域声明。csv
蒂哈尔。图纸

BIGAL · 发表于 2022-7-5 20:21:00

非常简单，只需列出多边形内的文本，然后运行Bpoly命令，其属性之一是区域写出答案。一个问题是18P，它的插入点是外侧多边形，不过可以修改。有人可能已经Lisp程序了。

sanju2323 · 发表于 2022-7-5 20:31:11

比加尔，
我已经有了类似的lisp，但在这个lisp中创建自己的顺序连续边界文本。我需要多段线边界下的现有文字创建面积语句。
连接到XLS的多个区域。lsp

BIGAL · 发表于 2022-7-5 20:39:44

我想你想要的东西有点啰嗦，如果有人不先提出一些东西，我会回来的。

快到了，轮到你的时间不多了

copy


(defun textarea ( / obj obj2 ss pt point1 Tarea Textval)
(setq obj (vlax-ename->vla-object (car (entsel "Pick text"))))
(setq layname (vla-get-layer obj))
(setq ss (ssget (list (cons 0 "Text")(cons 8 layname))))
(setq x -1)
(setq len (sslength ss))
(repeat len 
(setq tobj (vlax-ename->vla-object (ssname ss (setq x (+ x 1)))))
(setq pt (vla-get-Insertionpoint tobj))
(setq texval (vla-get-Textstring tobj))
(setq point1 (vlax-safearray->list (vlax-variant-value pt)))
(bpoly)(vl-cmdf point1 "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq Tarea (vla-get-area obj2))
(vl-cmdf "erase" "last" "") ; remove bpoly
; write out answers now to csv
(princ (strcat "\nLabel " texval " Area " (rtos Tarea 2 0)))
)
)
(textarea)