求输入tt，点击图块，把图块的数值型 A 的值 复制到粘贴板

664571221

求输入tt，点击图块，把图块的数值型 A  的值 复制到粘贴板

jun353835273

http://bbs.mjtd.com/thread-188597-1-1.html
组合下

飞雪神光

1. (Defun lm-get-attribute (ty sx / lstattrs lstvar tagstring textstring vn0)
   
2.   (setq vn (vlax-ename->vla-object ty))
   
3.   (setq lstVar (vla-getattributes vn))
   
4.   (setq lstAttrs (vlax-safeArray->list (vlax-variant-value lstVar)))
   
5.   (setq TextString nil)
   
6.   (foreach attr        lstAttrs
   
7.     (setq TagString (vla-get-TagString attr))
   
8.     (if        (equal TagString sx)        ;此处为你想要的元素
   
9.       (setq TextString (vla-get-TextString attr))
   
10.     )
    
11.   )
    
12.         TextString
    
13. )
    
14. (defun set-clip-string (str / html result)
    
15.     (and (= (type str) 'str)
    
16.          (setq html (vlax-create-object "htmlfile"))
    
17.          (setq result (vlax-invoke (vlax-get (vlax-get html 'parentwindow) 'clipboarddata ) 'setdata "text" str))
    
18.          (vlax-release-object html)
    
19.     )
    
20. )
    
21. (set-clip-string (lm-get-attribute(car(entsel"\n选择属性块:")) "A"))

(Defun lm-get-attribute (ty sx / lstattrs lstvar tagstring textstring vn0)<br />   (setq vn (vlax-ename->vla-object ty))<br />   (setq lstVar (vla-getattributes vn))<br />   (setq lstAttrs (vlax-safeArray->list (vlax-variant-value lstVar)))<br />   (setq TextString nil)<br />   (foreach attr        lstAttrs<br />     (setq TagString (vla-get-TagString attr))<br />     (if        (equal TagString sx)        ;此处为你想要的元素<br />       (setq TextString (vla-get-TextString attr))<br />     )<br />   )<br />         TextString<br /> )<br /> (defun set-clip-string (str / html result)<br />     (and (= (type str) 'str)<br />          (setq html (vlax-create-object "htmlfile"))<br />          (setq result (vlax-invoke (vlax-get (vlax-get html 'parentwindow) 'clipboarddata ) 'setdata "text" str))<br />          (vlax-release-object html)<br />     )<br /> )<br /> (set-clip-string (lm-get-attribute(car(entsel"\n选择属性块:")) "A"))

llsheng_73

飞雪神光 发表于 2023-9-18 15:14

lm-get-attribute 里边 foreach宜用vl-some

1. (defun getattrib(blk tag)
   
2.   (if(and(equal(VL-CATCH-ALL-APPLY(function vlax-get-property)
   
3.                  (list(setq blk(if(=(type blk)'ename)(vlax-ename->vla-object blk)blk))'HasAttributes)):vlax-true)
   
4.       (=(type tag)'str)
   
5.          (setq tag(strcase tag)))
   
6.     (vl-some(function(lambda(a)(if(=(strcase(vlax-get-property a"TagString"))tag)a)))
   
7.             (vlax-safearray->list(vlax-variant-value(vlax-invoke-method blk'getattributes))))))
   
8. 
   
9. (set-clip-string(VL-CATCH-ALL-APPLY(function vlax-get-property)(list(getattrib(car(entsel""))"A")"TextString")))

(defun getattrib(blk tag)<br />   (if(and(equal(VL-CATCH-ALL-APPLY(function vlax-get-property)<br />                  (list(setq blk(if(=(type blk)'ename)(vlax-ename->vla-object blk)blk))'HasAttributes)):vlax-true)<br />       (=(type tag)'str)<br />          (setq tag(strcase tag)))<br />     (vl-some(function(lambda(a)(if(=(strcase(vlax-get-property a"TagString"))tag)a)))<br />             (vlax-safearray->list(vlax-variant-value(vlax-invoke-method blk'getattributes))))))<br /> <br /> (set-clip-string(VL-CATCH-ALL-APPLY(function vlax-get-property)(list(getattrib(car(entsel""))"A")"TextString")))

飞雪神光

llsheng_73 发表于 2023-9-18 17:29
lm-get-attribute 里边 foreach宜用vl-some

这个好 换了之后简洁好多

magicheno

感谢大佬分享~

edsion24

llsheng_73 发表于 2023-9-18 17:29
lm-get-attribute 里边 foreach宜用vl-some

怎么能把程序变成可以直接运行的程序呢，用一个命令

664571221

edsion24 发表于 2023-9-19 08:28
怎么能把程序变成可以直接运行的程序呢，用一个命令

我也不清楚，你问问大佬，你是做啥行业的兄弟

664571221

飞雪神光 发表于 2023-9-18 15:14

谢谢大佬分享

664571221

llsheng_73 发表于 2023-9-18 17:29
lm-get-attribute 里边 foreach宜用vl-some

谢谢大佬分享