[求助]圖形屬性讀取

lilq_78

如何读到图元中的属性？用ARX可以读到 ，但是lisp搞不定，求各位帮忙啦

hoodpinrh

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)
   )

LIULISHENG

支持一下   

tcsl9621

用vla-get-……各函数就可以读各种属性。

lilq_78

我试过，可能是水平问题，没有搞定

lazybug

没说明白！

“图元中的属性”什么东西？

知道DXF组码么，估计那就是你所要的。

如果是指属性块的属性，那根普通块一样，用entnext就能取出来

看看函数说明吧

 

lilq_78

呵呵，是属性块，但是与我们常规的做发不一样，用entnext读不出来，否则我也不会请教各位啦

HuaiYu

这个是用在五金模具上的，其数据格式为保存在XData中，ARX-VBA-LSP-VLISP中都可以读的到的.

(-3 ("AUTOMARK" (1002 . "{") (1000 . "AB-d1") (1000 . "NO")
(1040 . 0.0) (1041 . 0.0) (1000 . "20E8E") (1002 . "}"))))

tcsl9621

lisp读属性块没有任何问题。别将ARX编程思想带入LISP中。切记。

lilq_78

那些扩展数据读取没有问题的，不知道各位有没有看过图形，图形与平常的块一样，但是确实是属性块，爆炸开才能看见，在插入点位置有很小的字，那就是块属性

lazybug

;关于块的遍历
(defun c:blk ()
    (setq ent (car (entsel "\n选择一个块")))
    (setq blk (cdr (assoc 2 (entget ent))))
    ;或者用下面一句替代上面两行:
    ;(setq blk (getstring "请输入块名:"))
    (setq e1 (tblsearch "BLOCK" blk))
    (princ "\n")
    (princ e1)
    (setq e1 (cdr (assoc -2 e1)))
    (setq en_data (entget e1))   
    (princ "\n")
    (princ en_data)
    (while (setq e1 (entnext e1))
 (setq en_data (entget e1))
 (princ "\n")
 (princ en_data)
    )
    (princ)
)

 

做出你图中这个效果，用xdata多方便啊。

干吗绕这么大弯？

HuaiYu

原来又是一个 不可见的Attdef啊

(Defun C:Test (/ en vn atts)
  (vl-load-com)
  (setq en (vl-catch-all-apply 'entsel (list "\nPlease select a block:")))
  (if (and (not (vl-catch-all-error-p en))
    (setq vn (vlax-ename->vla-object (car en)))
    (equal (vla-get-ObjectName vn) "AcDbBlockReference")
      )
    (progn
      (if (and (equal (vla-get-HasAttributes vn) :vlax-true)
        (setq atts (vlax-variant-value (vla-getAttributes vn)))
        (/= (vlax-safeArray-get-u-bound atts 1) -1)
   )
 (foreach att (vlax-safeArray->list atts)
   (princ (strcat "\n" (vla-get-TagString att) "---" (vla-get-TextString att)))
 )
      )

      (if (and (setq atts (vla-getConstantAttributes vn))
        (setq atts (vlax-variant-value atts))
        (/= (vlax-safeArray-get-u-bound atts 1) -1)
   )
 (foreach att (vlax-safeArray->list atts)
   (princ (strcat "\n" (vla-get-TagString att) "---" (vla-get-TextString att)))
 )
      )

    )
  )
  (prin1)
)