我需要一个用于Lis的Autocad LISP
大家好，我的第一个帖子是紧急求助，我有一个关于结构梁的AutoCAD绘图。我需要这些梁的名称和尺寸作为Excel列表。
梁的名称和尺寸（宽度和深度）均以文本形式写在两个不同的层中。梁的线条在另一层上
尺寸（宽度和深度）写在梁上。由于梁仅由两条线组成，因此应使用DIM命令从项目中读取高度。
可以在附件中找到dwg的屏幕截图。你需要的所有层都是紫色的。
基本上，LISP应该能够获得名称并将其写入Excel第1列、第2列和第3列的维度（或者只有第2列，我可以设法将其分隔开来）以及这些文本上方和下方这两行的长度，并将其写入另一列。
你知道什么Lisp程序可以满足我的需要吗？
谢谢
你有一个问题是的，所有的文本都可以写是的，行长度可以写，但两者是无关的。
但并非全无2种方法，你可以找到文字并在附近寻找物体，在这种情况下，是图层上的一条线。根据文本放置的位置，您可能会得到错误的答案，这里的提示位于中间而不是角落。另一种稍微复杂一点的方法是将长度和宽度设为一个块，其中一个字段是所需行的长度。哦，第三种是使用扩展数据，将线路链接到一些数据。
谷歌也会在区块和字段方面提供一些帮助。可以关闭块中的属性，这样就看不到这些值，但可以检索它们。
块
宽度
身高
名称不可见字段读取其他文本
长度不可见字段读取行长度
我现在得走了，但可能会有人给你一个街区。 看看这个。下一步是使用lisp重新关联新文本和行，现在只需复制行文本和块。
新建块。图纸 这是为了匹配您的请求而编写的，但可以轻松更改以适应其他块更新。
; This updates a block with 4 attributes
; Just insert block with 4 attributes 1st
; insert block or copy etc
; by Alan H June 2017
(defun c:blk4 ( / len t1 t2 obj desc x att )
(vl-load-com)
(while (/=(vlax-property-available-p (setq obj (vlax-ename->vla-object (car (entsel "Select Block")))) 'Hasattributes) T)
(alert "You have not picked a block object ")
)
(setq att (vlax-invoke obj 'getattributes))
(while (/=(vlax-property-available-p (setq len (vlax-ename->vla-object (car (entsel "\nSelect Line: ")))) 'length) T)
(alert "You have not picked a P/line object ")
)
(while (/=(vlax-property-available-p (setq t1 (vlax-ename->vla-object (car (entsel "\nSelect Text 1: ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(while (/=(vlax-property-available-p (setq t2 (vlax-ename->vla-object (car (entsel "\nSelect Text 2: ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(while (/=(vlax-property-available-p (setq desc (vlax-ename->vla-object (car (entsel "\nSelect Description : ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(setq atlength (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid len)) ">%).Length>%"))
(setq att1 (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid t1)) ">%).TextString>%"))
(setq att2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid t2)) ">%).TextString>%"))
(setq atdesc (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid desc)) ">%).TextString>%"))
; this is for 1st 4 attributes starts at 0 not 1 tested on block with 16 attributes.
(vla-put-textstring (nth 0 att) atlength)
(vla-put-textstring (nth 1 att) atdesc)
(vla-put-textstring (nth 2 att) att1)
(vla-put-textstring (nth 3 att) att2)
(command "regen")
(princ)
) ; defun
(c:blk4)
有趣的建议BIGAL，这可能是一个更方便的版本：
; http://www.cadtutor.net/forum/showthread.php?100975-I-need-an-Autocad-LISP-for-Listing-Beam-Sizes
; Simple field attributes - original concept by BIGAL
(defun C:test ( / e )
(and (or (setq e (car (entsel "\nSelect attributed block: "))) (prompt "\nInvalid selection."))
(vl-every '(lambda (x) (member x (entget e))) '((0 . "INSERT") (66 . 1)))
(progn
(foreach att (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
(and (vlax-write-enabled-p att)
(setq e (car (nentsel (strcat "\nSelect object for \"" (vla-get-TagString att) "\" attribute: "))))
(vl-some
'(lambda (x)
(if (vlax-property-available-p (vlax-ename->vla-object e) x)
(vla-put-TextString att
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-ObjectId (vlax-ename->vla-object e)))
">%)." x ">%"
); strcat
); vla-put-TextString
); if
); lambda
'("Length" "TextString") ; "Area" could be added, list is sorted by priority
); vl-some
); and
); foreach
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
); progn
); and
(princ)
); defun 嗨，Grr，我确实考虑过使用nentsel，但这意味着需要更多的选择，而不仅仅是填充所需的4个值。我也知道检查属性，但确实提到它希望用户选择正确的对象。版本2现在具有属性检查。
我要做的一个更改是不使用foreach，而是直接编辑属性，它的VL项或计数今天将有一些时间来研究这个方法。结果是一个列表。
上面的代码已经更改为直接更新正确的属性，而不使用foreach测试。
该代码可以在任何块上使用，只要该测试具有4个或更多属性。
页:
[1]