[LISP]R2005 TABLE提取圖面中所有帶屬性圖塊值並表列

龙龙仔 · 发表于 2004-4-7 07:58

;;提取圖面中所有帶屬性圖塊值並表列
;;BY龍龍仔(LUCAS)
;;供測試未完善
(defun C:TT (/ WE N1 EE TITLE INSPT MSPACE TABLE N NN)
(setq WE (TT))
(setq N1 0)
(repeat (length WE)
(setq EE (ssget "x"
(list '(0 . "insert")
'(66 . 1)
(cons 2 (nth N1 WE))
)
)
)
(setq TITLE (VXGETATTS (vlax-ename->vla-object (ssname EE N1))))
(print TITLE)
(setq INSPT (getpoint "\n請選擇表格插入點: "))
(setq MSPACE (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq TABLE (vla-addtable
MSPACE
(vlax-3d-point INSPT)
(1+ (sslength EE))
(length TITLE)
10
25
)
)
(vla-unmergecells TABLE 0 0 0 (1- (length TITLE)))
(vla-setalignment TABLE 1 acmiddlecenter)
(setq N 0)
(foreach ENT TITLE
(vla-settext TABLE 0 N ENT)
(setq N (1+ N))
)
(setq NN 1
EL (sslength EE)
)
(repeat EL
(setq TITLE
(VXGETATTS1 (vlax-ename->vla-object (ssname EE (1- NN))))
)
(prompt (strcat "\n餘" (rtos (- EL NN) 2 0)))
(setq N 0)
(foreach ENT TITLE
(vla-settext TABLE NN N ENT)
(setq N (1+ N))
)
(setq NN (1+ NN))
)
(setq N1 (1+ N1))
)
(vlax-release-object MSPACE)
(princ)
);;TABLE list
(defun TABLE1 (S / D R)
(while (setq D (tblnext S (null D)))
(setq R (cons (cdr (assoc 2 D)) R))
)
)(defun TT (/ BLOCK SS_BLOCK N BLK BLK_LIST ENT ENT1)
(setq BLOCK (vla-get-blocks
(vla-get-activedocument
(vla-get-application
(vlax-get-acad-object)
)
)
)
)
(setq SS_BLOCK (TABLE1 "block"))
(setq N 0)
(repeat (length SS_BLOCK)
(setq BLK (vla-item BLOCK (setq ENT1 (nth N SS_BLOCK))))
(if (/= (vla-get-count BLK) 0)
(vlax-for ENT BLK
(if (and (not (vl-position ENT1 BLK_LIST))
(= (vla-get-objectname ENT) "AcDbAttributeDefinition")
)
(setq BLK_LIST (append BLK_LIST (list ENT1)))
)
)
)
(setq N (1+ N))
)
BLK_LIST
)(defun VXGETATTS (OBJ)
(mapcar
'(lambda (ATT)
(vla-get-tagstring ATT)
)
(vlax-invoke OBJ "GetAttributes")
)
)(defun VXGETATTS1 (OBJ)
(mapcar
'(lambda (ATT)
(vla-get-textstring ATT)
)
(vlax-invoke OBJ "GetAttributes")
)
)

;;提取圖面中所有帶屬性圖塊值並表列
;;BY龍龍仔(LUCAS)
;;供測試未完善
(defun C:TT (/ WE N1 EE TITLE INSPT MSPACE TABLE N NN)
   (setq WE (TT))
   (setq N1 0)
   (repeat (length WE)
       (setq EE (ssget "x"
           (list '(0 . "insert")
         '(66 . 1)
         (cons 2 (nth N1 WE))
           )
           )
       )
       (setq TITLE (VXGETATTS (vlax-ename->vla-object (ssname EE N1))))
       (print TITLE)
       (setq INSPT (getpoint "\n請選擇表格插入點: "))
       (setq MSPACE (vla-get-modelspace
         (vla-get-activedocument (vlax-get-acad-object))
     )
       )
       (setq TABLE  (vla-addtable
       MSPACE
       (vlax-3d-point INSPT)
       (1+ (sslength EE))
       (length TITLE)
       10
       25
    )
       )
       (vla-unmergecells TABLE 0 0 0 (1- (length TITLE)))
       (vla-setalignment TABLE 1 acmiddlecenter)
       (setq N 0)
       (foreach ENT TITLE
           (vla-settext TABLE 0 N ENT)
           (setq N (1+ N))
       )
       (setq NN 1
     EL (sslength EE)
       )
       (repeat EL
           (setq TITLE
           (VXGETATTS1 (vlax-ename->vla-object (ssname EE (1- NN))))
           )
           (prompt (strcat "\n餘" (rtos (- EL NN) 2 0)))
           (setq N 0)
           (foreach ENT TITLE
  (vla-settext TABLE NN N ENT)
  (setq N (1+ N))
           )
           (setq NN (1+ NN))
       )
       (setq N1 (1+ N1))
   )
   (vlax-release-object MSPACE)
   (princ)
);;TABLE list
(defun TABLE1 (S / D R)
   (while (setq D (tblnext S (null D)))
       (setq R (cons (cdr (assoc 2 D)) R))
   )
)(defun TT (/ BLOCK SS_BLOCK N BLK BLK_LIST ENT ENT1)
   (setq  BLOCK (vla-get-blocks
    (vla-get-activedocument
       (vla-get-application
           (vlax-get-acad-object)
       )
    )
             )
   )
   (setq SS_BLOCK (TABLE1 "block"))
   (setq N 0)
   (repeat (length SS_BLOCK)
       (setq BLK (vla-item BLOCK (setq ENT1 (nth N SS_BLOCK))))
       (if  (/= (vla-get-count BLK) 0)
           (vlax-for  ENT BLK
  (if (and (not (vl-position ENT1 BLK_LIST))
     (= (vla-get-objectname ENT) "AcDbAttributeDefinition")
         )
     (setq BLK_LIST (append BLK_LIST (list ENT1)))
  )
           )
       )
       (setq N (1+ N))
   )
   BLK_LIST
)(defun VXGETATTS (OBJ)
   (mapcar
       '(lambda (ATT)
             (vla-get-tagstring ATT)
         )
       (vlax-invoke OBJ "GetAttributes")
   )
)(defun VXGETATTS1 (OBJ)
   (mapcar
       '(lambda (ATT)
             (vla-get-textstring ATT)
         )
       (vlax-invoke OBJ "GetAttributes")
   )
)

citykunan · 发表于 2004-4-8 15:45

有没有适合2002的？

meflying · 发表于 2004-4-8 16:11

2004还没有table这种对象类型

byhabyh · 发表于 2004-4-8 19:33

太好了，我正在对这样的问题苦恼呢！可是楼主的程序为什么不加入标注解释部分呢？这样也好懂一些，或者讲一下编制的思路呢？期待楼主能够解释一下你的思路！

龙龙仔 · 发表于 2004-4-9 08:54

;;完整版功能暫定:
;;1.能自動調整欄寬
;;2.可設定字型
;;3.可設定字高
;;4.可選擇插入所有圖塊列表 or 單一圖塊列表
;;5.增加進度條顯示
;;6.插入Table能在所有空間使用
;;7......暫無提供 8-(

mccad · 发表于 2004-4-9 13:54

程序需要再完善：
1.程序是读取所有带属性图块的数量，但取属性值填表只取了第一种图块，就象我程序中有A块和B块，取到A块后，不会再去读B块。所以最后的表格没有填满。所以象我写的那样，让用户选择要输出的哪种块比较好。
2.字体没有调整，显得表格大，字体小。
3.应该把Header行隐去，保存Data和Title行。这样才可以避免数据行的格式不一致。

龙龙仔 · 发表于 2004-4-9 16:54

本帖最后由作者于 2004-4-10 8:06:17 编辑

1. SORRY!COPY漏一行!(第一版就可以列出所有圖塊屬性,這版怎可能沒有呢!)
(repeat (length WE)
(setq EE (ssget "x"
(list '(0 . "insert")
'(66 . 1)
(cons 2 (nth N1 WE))
)
)
)
(setq TITLE (VXGETATTS (vlax-ename->vla-object (ssname EE 1));注意:N1→1
vla-get-tagstring ;提取屬性標題
)
) 2.& 3. 把屬性分開寫就會有效(title & header & data),沒必要把Header行隱去 (vla-unmergecells TABLE 0 0 0 (1- (length TITLE))) ;首行合併
(vla-setalignment TABLE 2 acmiddlecenter) ;增加
(vla-setalignment TABLE 4 acmiddlecenter) ;增加
(vla-setalignment TABLE 1 acmiddlecenter) ;增加
(vla-settextheight TABLE 2 5) ;增加
(vla-settextheight TABLE 4 5) ;增加
(vla-settextheight TABLE 1 5) ;增加

linear · 发表于 2004-4-13 07:46

喜欢这样的句子：且放白鹿青崖间，须行即骑访名山。
安能摧眉折腰事权贵，使我不得开心颜！

yxl88168 · 发表于 2011-3-31 19:33

谢谢楼主，这真是个好程序

daiguafan · 发表于 2011-6-7 16:27

程序很不错，期待高手继续更新，完善

账号		自动登录	找回密码
密码			注册

[LISP]R2005 TABLE提取圖面中所有帶屬性圖塊值並表列

评分

本帖被以下淘专辑推荐:

本帖子中包含更多资源

点评

评分