引用bl的属性
大家好。这是我的第一篇帖子。我正在使用Autocad map 3D 2013。我不知道如何创建任何Lisp程序。谢谢你的帮助，非常感谢，因为我知道这真的占用了你一些时间。我有一个。dwg文件包含大量GPS点，从现场采集并上传到我们的系统。GPS点以具有属性的块的形式出现，我希望一些属性位于多引线（文本区域）中。
对于我来说，用我创建为块的多重引线替换GPS点（块）很容易，在该多重引线中，箭头精确指向GPS点所在的位置。
我使用xpress工具将一个块替换为另一个块，因为所有对应的块的名称都相同，只有属性会更改，所以基本上现在多重引线是GPS点。GPS有两个我需要的属性。间隙_Ft=18.5，交叉类型=车道或我们正在穿越的任何东西。
如果我查询数据，我还可以以文本形式获得实际的属性Clearanace和Crossing type。
在我用多重引线替换点后，我尝试在多重引线中插入字段以拾取它自己的属性，但这不起作用，因为当我按下以插入所需信息时，我在块多重引线中，属性消失，并且只是块编辑器中的多重引线。我尝试连接块属性，但它不起作用，在一个点上，插入字段确实起作用，但它给了我所有点相同的间隙，哈哈。我知道这是错误的。如果我能解决这个问题，这将节省我几个小时的工作，因为现在我必须手动键入每个清除。
当我提到这一部分，我可以获得信息的一点作为一个文本是因为也许你们有一个更好的想法如何解决这个问题。
再次感谢你。
样品图纸 你能把样品寄出去吗。图纸为ACAD2010，因为我无法打开它。 随附ACAD2010样本-2010。图纸
好的，我已经访问了图形和块。是希望多重引线显示两个属性的内容，还是必须是块中的多重引线？
对不起，文件保存为2010年。
可以是多重引线或块，这真的无关紧要。
再次非常感谢。
样品图纸 实际上，考虑一下，我需要一个块，因为我要替换GPS的准确位置，用一个块替换另一个块会更容易，而不是手动在每个位置放置多引线。 这是一个开始，你刚刚推时间重新领导人的设置。这可以进一步扩展，以获得正确的块和属性值等。
(defun c:AHleatt ( / obj bname ss pt1 pt2 atttxt)
(setq olddimsc (getvar 'dimscale))
(setvar 'dimscale 5.0)
(setq obj (vlax-ename->vla-object (car (entsel "\nPick a block"))))
(setq bname (vla-get-name obj))
(setq ss (ssget "X" (list(cons 0 "insert")(cons 2 bname))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq pt1 (vlax-safearray->list (vlax-variant-value(vlax-get-property obj 'insertionpoint))))
(setq pt1 (list (car pt1)(cadr pt1)))
(setq pt2 (polar pt1 0.0 5.75))
(foreach att (vlax-invoke obj 'getattributes)
(if (= "CLEARANCE__FT_" (strcase (vla-get-tagstring att)))
(setq atttxt (vla-get-textstring att))
)
(if (/= atttxt nil)
(command "qleader" pt1 pt2 "" 0.0 (strcat "CL=" atttxt) "")
)
)
)
(setvar 'dimscale olddimscale)
(princ)
)
(c:AHleatt)
试试这个，它不是块而是多重引线。它使用标准ML样式的当前副本，因此需要将其设置为当前。我稍微修改了这个样式的文本高度（1.5->1.0）。
lisp在块插入点插入多重引线，并将文字从两个属性复制到多重引线文字。一切都是自动化的。
加载lisp并键入“test”。
vl-load-com)
(defun c:test (/ *error* c_doc tag_lst ss new_str att_lst blk_ip pts ml_obj)
(defun *error* ( msg )
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
(princ)
);_end_*error*_defun
(setq c_doc (vla-get-ActiveDocument (vlax-get-acad-object))
ms (vla-get-modelspace c_doc)
tag_lst (list "CROSSING_TYPE" "CLEARANCE__FT_")
)
(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark c_doc))
(vla-startundomark c_doc)
(ssget "_X" '((0 . "INSERT") (2 . "2") (8 . "CLEARANCE_OR_SAG")))
(setq ss (vla-get-activeselectionset c_doc))
(vlax-for blk ss
(setq new_str ""
att_lst nil
blk_ip (vlax-get blk 'insertionpoint)
)
(foreach att (vlax-invoke blk 'GetAttributes)
(if (member (strcase (vlax-get att 'tagstring)) tag_lst)
(setq att_lst (cons (list (vlax-get att 'tagstring) (vlax-get att 'textstring)) att_lst))
)
);end_foreach (att)
(if (= (length att_lst) 2)
(progn
(setq pts (vlax-make-safearray vlax-vbDouble '(0 . 5)))
(vlax-safearray-fill pts (list (car blk_ip) (cadr blk_ip) (caddr blk_ip) (+ (car blk_ip) 6) (cadr blk_ip) (caddr blk_ip)))
(setq new_str (strcat "Crossing Type = " (cadr (assoc "CROSSING_TYPE" att_lst)) "\\PCL = \'" (cadr (assoc "CLEARANCE__FT_" att_lst))))
(setq ml_obj (vla-addmleader ms pts 0))
(vla-put-layer ml_obj (vla-get-layer blk))
(vla-put-textstring ml_obj new_str)
)
)
)
(setq ss nil)
(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark c_doc))
);end_defun
我已重新附上该图形，因为它包含修改的多重引线样式 非常感谢。这很快。我今天会在工作中试用，非常感谢。
非常感谢。
非常感谢。我很感谢你的回复，我今天会试试。
非常感谢。
页:
[1]
2