[求助]圖形屬性讀取
<P></P><P>如何读到图元中的属性？用ARX可以读到 ，但是lisp搞不定，求各位帮忙啦</P> lazybug 发表于 2006-11-16 16:14
;关于块的遍历(defun c:blk () (setq ent (car (entsel "\n选择一个块"))) & ...
感謝大大提供源碼
我做了小小的改變,可不可以在改進一下.
;加入翔虹科技 林美櫻老師 提供的群碼一覽程式,再次感謝林老師,順便提供給大家參考
;在2022版上試用過 可行 用記事本寫入 好做比對
(defun c:blk ()
(vl-load-com)
(setq ent (car (entsel "\n選擇一個塊")))
(setq blk (cdr (assoc 2 (entget ent))))
(setq filename (getstring "\n 輸入圖元名稱:"))
;或者用下面一句替代上面兩行:
;(setq blk (getstring "請輸入塊名:"))
(setq file (getfiled "圖元群碼列表"
(strcat "c:/Users/Users/Desktop/";放在你想存放的地方
filename
"群碼列表"
".num"
) ;
"num"
1
)
)
(setq ff (open file "w"))
(write-line "圖元群碼一覽表" ff)
(setq e1 (tblsearch "BLOCK" blk))
(setq e1 (cdr (assoc -2 e1)))
(setq en_data (entget e1))
(while (setq e1 (entnext e1))
(setq en_data (entget e1))
(write-line "=============================" ff)
(foreach en_num en_data (princ en_num ff) (princ "\n" ff))
)
(close ff)
(command "notepad" file)
(prin1)
) 支持一下 用vla-get-……各函数就可以读各种属性。 我试过，可能是水平问题，没有搞定 <P>没说明白！</P>
<P>“图元中的属性”什么东西？</P>
<P>知道DXF组码么，估计那就是你所要的。</P>
<P>如果是指属性块的属性，那根普通块一样，用entnext就能取出来</P>
<P>看看函数说明吧</P>
<P> </P> 呵呵，是属性块，但是与我们常规的做发不一样，用entnext读不出来，否则我也不会请教各位啦 <P>这个是用在五金模具上的，其数据格式为保存在XData中，ARX-VBA-LSP-VLISP中都可以读的到的.</P>
<P>(-3 ("AUTOMARK" (1002 . "{") (1000 . "AB-d1") (1000 . "NO") <BR>(1040 . 0.0) (1041 . 0.0) (1000 . "20E8E") (1002 . "}"))))</P> lisp读属性块没有任何问题。别将ARX编程思想带入LISP中。切记。 <P>那些扩展数据读取没有问题的，不知道各位有没有看过图形，图形与平常的块一样，但是确实是属性块，爆炸开才能看见，在插入点位置有很小的字，那就是块属性 </P> <P>;关于块的遍历<BR>(defun c:blk ()<BR> (setq ent (car (entsel "\n选择一个块")))<BR> (setq blk (cdr (assoc 2 (entget ent))))<BR> ;或者用下面一句替代上面两行:<BR> ;(setq blk (getstring "请输入块名:"))<BR> (setq e1 (tblsearch "BLOCK" blk))<BR> (princ "\n")<BR> (princ e1)<BR> (setq e1 (cdr (assoc -2 e1)))<BR> (setq en_data (entget e1)) <BR> (princ "\n")<BR> (princ en_data)<BR> (while (setq e1 (entnext e1))<BR> (setq en_data (entget e1))<BR> (princ "\n")<BR> (princ en_data)<BR> )<BR> (princ)<BR>)<BR></P>
<P> </P>
<P>做出你图中这个效果，用xdata多方便啊。</P>
<P>干吗绕这么大弯？</P> <P>原来又是一个 不可见的Attdef啊</P>
<P>(Defun C:Test (/ en vn atts)<BR> (vl-load-com)<BR> (setq en (vl-catch-all-apply 'entsel (list "\nPlease select a block:")))<BR> (if (and (not (vl-catch-all-error-p en))<BR> (setq vn (vlax-ename->vla-object (car en)))<BR> (equal (vla-get-ObjectName vn) "AcDbBlockReference")<BR> )<BR> (progn<BR> (if (and (equal (vla-get-HasAttributes vn) :vlax-true)<BR> (setq atts (vlax-variant-value (vla-getAttributes vn)))<BR> (/= (vlax-safeArray-get-u-bound atts 1) -1)<BR> )<BR> (foreach att (vlax-safeArray->list atts)<BR> (princ (strcat "\n" (vla-get-TagString att) "---" (vla-get-TextString att)))<BR> )<BR> )</P>
<P> (if (and (setq atts (vla-getConstantAttributes vn))<BR> (setq atts (vlax-variant-value atts))<BR> (/= (vlax-safeArray-get-u-bound atts 1) -1)<BR> )<BR> (foreach att (vlax-safeArray->list atts)<BR> (princ (strcat "\n" (vla-get-TagString att) "---" (vla-get-TextString att)))<BR> )<BR> )</P>
<P> )<BR> )<BR> (prin1)<BR>)</P>
页:
[1]
2