求钢筋表自动生成lisp

webyl · 发表于 2013-10-10 14:05:37

本帖最后由 webyl 于 2013-10-10 14:07 编辑

求钢筋表自动生成lisp
要求：
输入命令，鼠标框选下图

会自动生成下表，并且是按照序号（1）、（2）依次排列

是原创的或者是推荐的，都可以。要求开源！
附上原来CAD文件

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Drawing1.rar
下载次数:19 文件大小:13.19 KB
下载权限: 不限以上 [免费赚D豆]

st788796 · 发表于 2013-10-10 14:05:38

以下是完整程序，排序换用了eachy的排序函数，非 xd-lisp-lib.vlx 的 xd::pickset:tablesort

;|
禁止表格更新
|;
(defun XD::Table:Begin (tb)
(xdrx_table_SuppressRegenerateTable tb t)
t
)
;|
开启表格更新
|;
(defun XD::Table:End (tb)
(if (xdrx_table_IsRegenerateTableSuppressed tb)
(xdrx_table_SuppressRegenerateTable tb nil)
)
t
)
(defun XD::Pickset:TableSort (lst mod key vx / e1 e2 item nelst nlst tf tf0 tf1 x)
(setq tf0 (listp (caar lst)))
(if (not vx)
(setq vx 0.)
)
(if tf0
(if (= mod 0)
(progn
(setq nlst (vl-sort lst '(lambda (e1 e2)
(> (cadar e1) (cadar e2))
)
)
)
(while nlst
(setq tf t
tf1 t
item (car nlst)
)
(if nelst
(progn
(setq nelst (mapcar
'(lambda (x)
(if (and
tf1
(< (abs (- (cadar item) (cadaar x))) vx)
)
(progn
(setq tf1 nil
tf nil
)
(append
x
(list item)
)
)
x
)
)
nelst
)
)
(if tf
(setq nelst (append
(list (list item))
nelst
)
)
)
)
(setq nelst (list (list item)))
)
(setq nlst (cdr nlst))
)
(setq nelst (mapcar
'(lambda (x)
(vl-sort x '(lambda (e1 e2)
(if (equal (caar e1) (caar e2))
(> (cadar e1) (cadar e2))
(< (caar e1) (caar e2))
)
)
)
)
nelst
)
)
(cond
((= key 2)
(setq nelst (reverse (mapcar
'reverse
nelst
)
)
)
)
((= key 3)
(setq nelst (mapcar
'reverse
nelst
)
)
)
((= key 1)
(setq nelst (reverse nelst))
)
(t
nelst
)
)
)
(progn
(setq nlst (vl-sort lst '(lambda (e1 e2)
(< (caar e1) (caar e2))
)
)
)
(while nlst
(setq tf t
tf1 t
item (car nlst)
)
(if nelst
(progn
(setq nelst (mapcar
'(lambda (x)
(if (and
tf1
(< (abs (- (caar item) (caaar x))) vx)
)
(progn
(setq tf1 nil
tf nil
)
(append
x
(list item)
)
)
x
)
)
nelst
)
)
(if tf
(setq nelst (append
(list (list item))
nelst
)
)
)
)
(setq nelst (list (list item)))
)
(setq nlst (cdr nlst))
)
(setq nelst (mapcar
'(lambda (x)
(vl-sort x '(lambda (e1 e2)
(if (equal (cadar e1) (cadar e2))
(> (caar e1) (caar e2))
(< (cadar e1) (cadar e2))
)
)
)
)
nelst
)
)
(cond
((= key 1)
(setq nelst (reverse (mapcar
'reverse
nelst
)
)
)
)
((= key 2)
(setq nelst (mapcar
'reverse
nelst
)
)
)
((= key 3)
(setq nlst (reverse (mapcar
'reverse
nelst
)
)
)
)
(t
(setq nelst (reverse nelst))
)
)
)
)
(progn
(setq nlst (vl-sort lst '(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
(while nlst
(setq tf t
tf1 t
item (car nlst)
)
(if nelst
(progn
(setq nelst (mapcar
'(lambda (x)
(if (and
tf1
(<= (abs (- (car item) (caar x))) vx)
)
(progn
(setq tf1 nil
tf nil
)
(append
x
(list item)
)
)
x
)
)
nelst
)
)
(if tf
(setq nelst (append
(list (list item))
nelst
)
)
)
)
(setq nelst (list (list item)))
)
(setq nlst (cdr nlst))
)
(setq nelst (mapcar
'(lambda (x)
(vl-sort x '(lambda (e1 e2)
(if (equal (car e1) (car e2))
(> (car e1) (car e2))
(< (car e1) (car e2))
)
)
)
)
nelst
)
)
(setq nelst (reverse nelst))
)
)
nelst
)
(defun c:tt (/ attl colnum colwid e ll myerr n nl olderr p ss str strl tb title)
(if (and
(setq ss (ssget '((2 . "ATTS"))))
(setq p (getpoint "\nTable Position: "))
)
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(mapcar
'(lambda (x)
(if (= (xdrx_getpropertyvalue x "Tag") "C")
(setq nl (cons (list (atoi (xdrx_getpropertyvalue x "Textstring")) e) nl))
)
)
(xdrx_getpropertyvalue e "AttributeEntities")
)
)
(setq attl (mapcar
'(lambda (c / m)
(setq m (car c))
(list (car m) (cadr m) (itoa (apply
'+
(mapcar
'atoi
(mapcar
'caddr
c
)
)
)
) (nth 3 m) (last m)
)
)
(mapcar
'(lambda (x / l)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(xdrx_getpropertyvalue b "Textstring")
)
(xdrx_getpropertyvalue a "AttributeEntities")
)
)
(mapcar
'cadr
x
) ; _仅要实体
)
)
(setq nl (xd::pickset:tablesort nl 0 0 0)) ; _此处索引为实数钢筋编号，仅误差有效
)
)
) ; =0.00617*D2
; 2 12 960 25
(setq str (mapcar
'(lambda (x / a b c d e f g)
(mapcar
'set
'(a b c d)
x
)
(list a b c d (setq e (rtos (* (atoi c) (atoi d) 0.01) 2 2))
(setq f (rtos (* (atoi b) (atoi b) 0.00617) 2 3))
(setq g (rtos (* (distof e) (distof f)) 2 2))
(strcat b " " g "Kg")
)
)
(vl-sort attl '(lambda (e1 e2)
(< (atoi (car e1)) (atoi (car e2)))
)
)
)
)
(setq ll (length nl)
tb (xdrx_table_make p (+ 2 ll) 56. 8 110.)
colnum '(0 1 2 3 4 5 6 7)
colwid '(84 90 100 120 130 120 116 230)
title '("编号" "直径\\P(mm)"
"根数" "单根长\\P(cm)"
"总长\\P(m)" "延米重\\P(Kg)"
"总重\\P(Kg)" "合计"
)
n 1
)
(repeat (1+ ll)
(setq strl (cons (mapcar
'(lambda (x)
(list n x)
)
colnum
) strl
)
n (1+ n)
)
)
(xd::table:begin tb)
(mapcar
'(lambda (i w)
(xdrx_table_setcolumnwidth tb i w)
)
colnum
colwid
)
(xdrx_table_setrowheight tb 1 96)
(xdrx_table_settextheight tb 7 20.)
(xdrx_table_settextstring tb 0 0 "钢筋工程数量表")
(xdrx_table_settextheight tb 2 24.) ; _ Title
(xdrx_table_setalignment tb 1 5) ; _ Data
(xdrx_table_settextstring tb (apply
'append
(mapcar
'(lambda (x y)
(mapcar
'(lambda (a b)
(append
b
(list a)
)
)
x
y
)
)
(cons title str)
(reverse strl)
)
)
)
(xdrx_table_setgridvisibility tb 0 0 9 nil)
(vla-setcellgridvisibility (vlax-ename->vla-object tb) 0 7 ; _此处不是 0 0 要用最后一个列数
acRightMask :vlax-false
)
(xd::table:end tb)
)
)
(princ)
)

;| 
禁止表格更新 
|; 
(defun XD::Table:Begin (tb) 
  (xdrx_table_SuppressRegenerateTable tb t) 
  t 
) 
;| 
开启表格更新 
|; 
(defun XD::Table:End (tb) 
  (if (xdrx_table_IsRegenerateTableSuppressed tb) 
    (xdrx_table_SuppressRegenerateTable tb nil) 
  ) 
  t 
) 
(defun XD::Pickset:TableSort (lst mod key vx / e1 e2 item nelst nlst tf tf0 tf1 x) 
  (setq tf0 (listp (caar lst))) 
  (if (not vx) 
    (setq vx 0.) 
  ) 
  (if tf0 
    (if (= mod 0) 
      (progn 
        (setq nlst (vl-sort lst '(lambda (e1 e2) 
                                   (> (cadar e1) (cadar e2)) 
                                 ) 
                   ) 
        ) 
        (while nlst 
          (setq tf t 
                tf1 t 
                item (car nlst) 
          ) 
          (if nelst 
            (progn 
              (setq nelst (mapcar 
                            '(lambda (x) 
                               (if (and 
                                     tf1 
                                     (< (abs (- (cadar item) (cadaar x))) vx) 
                                   ) 
                                 (progn 
                                   (setq tf1 nil 
                                         tf nil 
                                   ) 
                                   (append 
                                     x 
                                     (list item) 
                                   ) 
                                 ) 
                                 x 
                               ) 
                             ) 
                            nelst 
                          ) 
              ) 
              (if tf 
                (setq nelst (append 
                              (list (list item)) 
                              nelst 
                            ) 
                ) 
              ) 
            ) 
            (setq nelst (list (list item))) 
          ) 
          (setq nlst (cdr nlst)) 
        ) 
        (setq nelst (mapcar 
                      '(lambda (x) 
                         (vl-sort x '(lambda (e1 e2) 
                                       (if (equal (caar e1) (caar e2)) 
                                         (> (cadar e1) (cadar e2)) 
                                         (< (caar e1) (caar e2)) 
                                       ) 
                                     ) 
                         ) 
                       ) 
                      nelst 
                    ) 
        ) 
        (cond 
          ((= key 2) 
            (setq nelst (reverse (mapcar 
                                   'reverse 
                                   nelst 
                                 ) 
                        ) 
            ) 
          ) 
          ((= key 3) 
            (setq nelst (mapcar 
                          'reverse 
                          nelst 
                        ) 
            ) 
          ) 
          ((= key 1) 
            (setq nelst (reverse nelst)) 
          ) 
          (t 
            nelst 
          ) 
        ) 
      ) 
      (progn 
        (setq nlst (vl-sort lst '(lambda (e1 e2) 
                                   (< (caar e1) (caar e2)) 
                                 ) 
                   ) 
        ) 
        (while nlst 
          (setq tf t 
                tf1 t 
                item (car nlst) 
          ) 
          (if nelst 
            (progn 
              (setq nelst (mapcar 
                            '(lambda (x) 
                               (if (and 
                                     tf1 
                                     (< (abs (- (caar item) (caaar x))) vx) 
                                   ) 
                                 (progn 
                                   (setq tf1 nil 
                                         tf nil 
                                   ) 
                                   (append 
                                     x 
                                     (list item) 
                                   ) 
                                 ) 
                                 x 
                               ) 
                             ) 
                            nelst 
                          ) 
              ) 
              (if tf 
                (setq nelst (append 
                              (list (list item)) 
                              nelst 
                            ) 
                ) 
              ) 
            ) 
            (setq nelst (list (list item))) 
          ) 
          (setq nlst (cdr nlst)) 
        ) 
        (setq nelst (mapcar 
                      '(lambda (x) 
                         (vl-sort x '(lambda (e1 e2) 
                                       (if (equal (cadar e1) (cadar e2)) 
                                         (> (caar e1) (caar e2)) 
                                         (< (cadar e1) (cadar e2)) 
                                       ) 
                                     ) 
                         ) 
                       ) 
                      nelst 
                    ) 
        ) 
        (cond 
          ((= key 1) 
            (setq nelst (reverse (mapcar 
                                   'reverse 
                                   nelst 
                                 ) 
                        ) 
            ) 
          ) 
          ((= key 2) 
            (setq nelst (mapcar 
                          'reverse 
                          nelst 
                        ) 
            ) 
          ) 
          ((= key 3) 
            (setq nlst (reverse (mapcar 
                                  'reverse 
                                  nelst 
                                ) 
                       ) 
            ) 
          ) 
          (t 
            (setq nelst (reverse nelst)) 
          ) 
        ) 
      ) 
    ) 
    (progn 
      (setq nlst (vl-sort lst '(lambda (e1 e2) 
                                 (< (car e1) (car e2)) 
                               ) 
                 ) 
      ) 
      (while nlst 
        (setq tf t 
              tf1 t 
              item (car nlst) 
        ) 
        (if nelst 
          (progn 
            (setq nelst (mapcar 
                          '(lambda (x) 
                             (if (and 
                                   tf1 
                                   (<= (abs (- (car item) (caar x))) vx) 
                                 ) 
                               (progn 
                                 (setq tf1 nil 
                                       tf nil 
                                 ) 
                                 (append 
                                   x 
                                   (list item) 
                                 ) 
                               ) 
                               x 
                             ) 
                           ) 
                          nelst 
                        ) 
            ) 
            (if tf 
              (setq nelst (append 
                            (list (list item)) 
                            nelst 
                          ) 
              ) 
            ) 
          ) 
          (setq nelst (list (list item))) 
        ) 
        (setq nlst (cdr nlst)) 
      ) 
      (setq nelst (mapcar 
                    '(lambda (x) 
                       (vl-sort x '(lambda (e1 e2) 
                                     (if (equal (car e1) (car e2)) 
                                       (> (car e1) (car e2)) 
                                       (< (car e1) (car e2)) 
                                     ) 
                                   ) 
                       ) 
                     ) 
                    nelst 
                  ) 
      ) 
      (setq nelst (reverse nelst)) 
    ) 
  ) 
  nelst 
) 
 
(defun c:tt (/ attl colnum colwid e ll myerr n nl olderr p ss str strl tb title) 
  (if (and 
        (setq ss (ssget '((2 . "ATTS")))) 
        (setq p (getpoint "\nTable Position: ")) 
      ) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (mapcar 
          '(lambda (x) 
             (if (= (xdrx_getpropertyvalue x "Tag") "C") 
               (setq nl (cons (list (atoi (xdrx_getpropertyvalue x "Textstring")) e) nl)) 
             ) 
           ) 
          (xdrx_getpropertyvalue e "AttributeEntities") 
        ) 
      ) 
      (setq attl (mapcar 
                   '(lambda (c / m) 
                      (setq m (car c)) 
                      (list (car m) (cadr m) (itoa (apply 
                                                     '+ 
                                                     (mapcar 
                                                       'atoi 
                                                       (mapcar 
                                                         'caddr 
                                                         c 
                                                       ) 
                                                     ) 
                                                   ) 
                                             ) (nth 3 m) (last m) 
                      ) 
                    ) 
                   (mapcar 
                     '(lambda (x / l) 
                        (mapcar 
                          '(lambda (a) 
                             (mapcar 
                               '(lambda (b) 
                                  (xdrx_getpropertyvalue b "Textstring") 
                                ) 
                               (xdrx_getpropertyvalue a "AttributeEntities") 
                             ) 
                           ) 
                          (mapcar 
                            'cadr 
                            x 
                          )               ; _仅要实体 
                        ) 
                      ) 
                     (setq nl (xd::pickset:tablesort nl 0 0 0))        ; _此处索引为实数钢筋编号，仅误差有效 
                   ) 
                 ) 
      )                                       ; =0.00617*D2 
                                       ; 2 12 960 25 
      (setq str (mapcar 
                  '(lambda (x / a b c d e f g) 
                     (mapcar 
                       'set 
                       '(a b c d) 
                       x 
                     ) 
                     (list a b c d (setq e (rtos (* (atoi c) (atoi d) 0.01) 2 2)) 
                           (setq f (rtos (* (atoi b) (atoi b) 0.00617) 2 3)) 
                           (setq g (rtos (* (distof e) (distof f)) 2 2)) 
                           (strcat b " " g "Kg") 
                     ) 
                   ) 
                  (vl-sort attl '(lambda (e1 e2) 
                                   (< (atoi (car e1)) (atoi (car e2))) 
                                 ) 
                  ) 
                ) 
      ) 
      (setq ll (length nl) 
            tb (xdrx_table_make p (+ 2 ll) 56. 8 110.) 
            colnum '(0 1 2 3 4 5 6 7) 
            colwid '(84 90 100 120 130 120 116 230) 
            title '("编号" "直径\\P(mm)" 
             "根数" "单根长\\P(cm)" 
             "总长\\P(m)" "延米重\\P(Kg)" 
             "总重\\P(Kg)" "合计" 
            ) 
            n 1 
      ) 
      (repeat (1+ ll) 
        (setq strl (cons (mapcar 
                           '(lambda (x) 
                              (list n x) 
                            ) 
                           colnum 
                         ) strl 
                   ) 
              n (1+ n) 
        ) 
      ) 
      (xd::table:begin tb) 
      (mapcar 
        '(lambda (i w) 
           (xdrx_table_setcolumnwidth tb i w) 
         ) 
        colnum 
        colwid 
      ) 
      (xdrx_table_setrowheight tb 1 96) 
      (xdrx_table_settextheight tb 7 20.) 
      (xdrx_table_settextstring tb 0 0 "钢筋工程数量表") 
      (xdrx_table_settextheight tb 2 24.) ; _ Title 
      (xdrx_table_setalignment tb 1 5) ; _ Data 
      (xdrx_table_settextstring tb (apply 
                                     'append 
                                     (mapcar 
                                       '(lambda (x y) 
                                          (mapcar 
                                            '(lambda (a b) 
                                               (append 
                                                 b 
                                                 (list a) 
                                               ) 
                                             ) 
                                            x 
                                            y 
                                          ) 
                                        ) 
                                       (cons title str) 
                                       (reverse strl) 
                                     ) 
                                   ) 
      ) 
      (xdrx_table_setgridvisibility tb 0 0 9 nil) 
      (vla-setcellgridvisibility (vlax-ename->vla-object tb) 0 7 ; _此处不是 0 0 要用最后一个列数 
                                 acRightMask :vlax-false 
      ) 
      (xd::table:end tb) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2013-10-10 14:32:12

你画图的时候组织好数据，才方便以后的程序统计，如果画的时候，线，文字都是分散的，没规律的，程序也不好做。

这个标注应该做成属性块。

webyl · 发表于 2013-10-10 14:41:14

对的，上面2个① ②都是属性块

下面的表格是根据属性块自动生成的，其中编号、直径、根数，单根长度，都是从属性块中提取的。
延米重，是根据直径判断的（和直径一一对应的），其他的数据都是自动生成的。

属性块是已经定于好的，表格是自动生成的。不需要划线，

不知道我表达清楚了没有啊

newer · 发表于 2013-10-10 15:25:50

webyl 发表于 2013-10-10 14:41
对的，上面2个① ②都是属性块

下面的表格是根据属性块自动生成的，其中编号、直径、根数，单根长度，都 ...

你这个图有几个问题

1、根数，比如528，为什么是单独的文字呢？而没用块里面的NUM属性？
2、钢筋符号，二级钢什么的，为什么没做到属性块里面呢？可以根据这个符号，查到单位重量啊。
3、这些蓝色的标记，和下面的红线（钢筋有关联吗？）
4、表格不是程序生成的？事先就有的？

你应该把所有相关的都做到一个块里面，里面用不同的属性标识出。

webyl · 发表于 2013-10-10 15:56:01

newer 发表于 2013-10-10 15:25
你这个图有几个问题

1、根数，比如528，为什么是单独的文字呢？而没用块里面的NUM属性？

不好意思，52那个个地方是个错误，应该是一个属性块，第2个才是正确的属性块

st788796 · 发表于 2013-10-10 18:06:15

这个可以用 Table 表格

webyl · 发表于 2013-10-10 18:07:35

st788796 发表于 2013-10-10 18:06
这个可以用 Table 表格

能具体点吗？

st788796 · 发表于 2013-10-10 20:13:58

本帖最后由 st788796 于 2013-10-11 07:45 编辑

(defun c:tt (/ attl colnum colwid e ll myerr n
nl olderr p ss str strl tb title
)
(defun myerr ()
(mapcar '(lambda (x) (set (read x) nil)) nl)
(setq *error* olderr
myerr nil
)
(princ)
)
(setq olderr *error*
*error* myerr
)
(if (and (setq ss (ssget '((2 . "ATTS"))))
(setq p (getpoint "\nTable Position: "))
)
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(mapcar
'(lambda (x)
(if (= (xdrx_getpropertyvalue x "Tag") "C")
(if
(member
(strcat "XD"
(xdrx_getpropertyvalue x "Textstring")
)
Nl
)
(if
(not
(vl-position
e
(eval
(read (strcat
"XD"
(xdrx_getpropertyvalue x "Textstring")
)
)
)
)
)
(set
(read (strcat
"XD"
(xdrx_getpropertyvalue x "Textstring")
)
)
(cons
e
(eval (read (strcat "XD"
(xdrx_getpropertyvalue
x
"Textstring"
)
)
)
)
)
)
)
(progn
(setq nl
(cons
(strcat
"XD"
(xdrx_getpropertyvalue x "Textstring")
)
nl
)
)
(set
(read (strcat
"XD"
(xdrx_getpropertyvalue x "Textstring")
)
)
(cons
e
(eval (read
(strcat
"XD"
(xdrx_getpropertyvalue x "Textstring")
)
)
)
)
)
)
)
)
)
(xdrx_getpropertyvalue e "AttributeEntities")
)
)
(setq
attl (mapcar
'(lambda (c / m)
(setq m (car c))
(list
(car m)
(cadr m)
(itoa (apply '+ (mapcar 'atoi (mapcar 'caddr c))))
(nth 3 m)
(last m)
)
)
(mapcar
'(lambda (x / l)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(xdrx_getpropertyvalue b "Textstring")
)
(xdrx_getpropertyvalue
a
"AttributeEntities"
)
)
)
(eval (read x))
)
)
nl
)
)
)
;;=0.00617*D2
;; 2 12 960 25
(setq
str
(mapcar
'(lambda (x / a b c d e f g)
(mapcar 'set '(a b c d) x)
(list a
b
c
d
(setq e (rtos (* (atoi c) (atoi d) 0.01) 2 2))
(setq f (rtos (* (atoi b) (atoi b) 0.00617) 2 3))
(setq g (rtos (* (distof e) (distof f)) 2 2))
(strcat b " " g "Kg")
)
)
(vl-sort
attl
'(lambda (e1 e2) (< (atoi (car e1)) (atoi (car e2))))
)
)
)
(setq ll (length nl)
tb (xdrx_table_make p (+ 2 ll) 56. 8 110.)
colnum '(0 1 2 3 4 5 6 7)
colwid '(84 90 100 120 130 120 116 230)
title '("编号" "直径\(mm)" "根数"
"单根长\(cm)" "总长\(m)" "延米重\(Kg)"
"总重\(Kg)" "合计"
)
n 1
)
(repeat (1+ ll)
(setq strl (cons (mapcar '(lambda (x)
(list n x)
)
colnum
)
strl
)
n (1+ n)
)
)
(xd::table:begin tb)
(mapcar '(lambda (i w) (xdrx_table_setcolumnwidth tb i w))
colnum
colwid
)
(xdrx_table_setrowheight tb 1 96)
(xdrx_table_settextheight tb 20. 7)
(xdrx_table_settextstring
tb
(apply
'append
(mapcar '(lambda (x y)
(mapcar '(lambda (a b) (append b (list a))) x y)
)
(cons title str)
(reverse strl)
)
)
)
;;(xdrx_table_deleterows tb 0 1)
(xd::table:end tb)
)
)
(mapcar '(lambda (x) (set (read x) nil)) nl)
(setq *error* olderr)
(princ)
)

(defun c:tt (/     attl   colnum colwid e ll     myerr  n 
      nl     olderr p   ss  str strl   tb     title 
     ) 
  (defun myerr () 
    (mapcar '(lambda (x) (set (read x) nil)) nl) 
    (setq *error* olderr 
   myerr   nil 
    ) 
    (princ) 
  ) 
  (setq olderr *error* 
 *error* myerr 
  ) 
  (if (and (setq ss (ssget '((2 . "ATTS")))) 
    (setq p (getpoint "\nTable Position: ")) 
      ) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
 (mapcar 
   '(lambda (x) 
      (if (= (xdrx_getpropertyvalue x "Tag") "C") 
        (if 
   (member 
     (strcat "XD" 
      (xdrx_getpropertyvalue x "Textstring") 
     ) 
     Nl 
   ) 
    (if 
      (not 
        (vl-position 
   e 
   (eval 
     (read (strcat 
      "XD" 
      (xdrx_getpropertyvalue x "Textstring") 
    ) 
     ) 
   ) 
        ) 
      ) 
       (set 
         (read (strcat 
          "XD" 
          (xdrx_getpropertyvalue x "Textstring") 
        ) 
         ) 
         (cons 
    e 
    (eval (read (strcat "XD" 
          (xdrx_getpropertyvalue 
            x 
            "Textstring" 
          ) 
         ) 
          ) 
    ) 
         ) 
       ) 
    ) 
    (progn 
      (setq nl 
      (cons 
        (strcat 
          "XD" 
          (xdrx_getpropertyvalue x "Textstring") 
        ) 
        nl 
      ) 
      ) 
      (set 
        (read (strcat 
         "XD" 
         (xdrx_getpropertyvalue x "Textstring") 
       ) 
        ) 
        (cons 
   e 
   (eval (read 
    (strcat 
      "XD" 
      (xdrx_getpropertyvalue x "Textstring") 
    ) 
         ) 
   ) 
        ) 
      ) 
    ) 
        ) 
      ) 
    ) 
   (xdrx_getpropertyvalue e "AttributeEntities") 
 ) 
      ) 
      (setq 
 attl (mapcar 
        '(lambda (c / m) 
    (setq m (car c)) 
    (list 
      (car m) 
      (cadr m) 
      (itoa (apply '+ (mapcar 'atoi (mapcar 'caddr c)))) 
      (nth 3 m) 
      (last m) 
    ) 
  ) 
        (mapcar 
   '(lambda (x / l) 
      (mapcar 
        '(lambda (a) 
    (mapcar 
      '(lambda (b) 
         (xdrx_getpropertyvalue b "Textstring") 
       ) 
      (xdrx_getpropertyvalue 
        a 
        "AttributeEntities" 
      ) 
    ) 
         ) 
        (eval (read x)) 
      ) 
    ) 
   nl 
        ) 
      ) 
      ) 
      ;;=0.00617*D2 
      ;; 2 12 960 25 
      (setq 
 str 
  (mapcar 
    '(lambda (x / a b c d e f g) 
       (mapcar 'set '(a b c d) x) 
       (list a 
      b 
      c 
      d 
      (setq e (rtos (* (atoi c) (atoi d) 0.01) 2 2)) 
      (setq f (rtos (* (atoi b) (atoi b) 0.00617) 2 3)) 
      (setq g (rtos (* (distof e) (distof f)) 2 2)) 
      (strcat b " " g "Kg") 
       ) 
     ) 
    (vl-sort 
      attl 
      '(lambda (e1 e2) (< (atoi (car e1)) (atoi (car e2)))) 
    ) 
  ) 
      ) 
      (setq ll    (length nl) 
     tb    (xdrx_table_make p (+ 2 ll) 56. 8 110.) 
     colnum '(0 1 2 3 4 5 6 7) 
     colwid '(84 90 100 120 130 120 116 230) 
     title  '("编号"     "直径\(mm)"    "根数" 
       "单根长\(cm)"  "总长\(m)"    "延米重\(Kg)" 
       "总重\(Kg)"    "合计" 
      ) 
     n    1 
      ) 
      (repeat (1+ ll) 
 (setq strl (cons (mapcar '(lambda (x) 
        (list n x) 
      ) 
     colnum 
    ) 
    strl 
     ) 
       n    (1+ n) 
 ) 
      ) 
      (xd::table:begin tb) 
      (mapcar '(lambda (i w) (xdrx_table_setcolumnwidth tb i w)) 
       colnum 
       colwid 
      ) 
      (xdrx_table_setrowheight tb 1 96) 
      (xdrx_table_settextheight tb 20. 7) 
      (xdrx_table_settextstring 
 tb 
 (apply 
   'append 
   (mapcar '(lambda (x y) 
       (mapcar '(lambda (a b) (append b (list a))) x y) 
     ) 
    (cons title str) 
    (reverse strl) 
   ) 
 ) 
      ) 
      ;;(xdrx_table_deleterows tb 0 1) 
      (xd::table:end tb) 
    ) 
  ) 
  (mapcar '(lambda (x) (set (read x) nil)) nl) 
  (setq *error* olderr) 
  (princ) 
)

st788796 · 发表于 2013-10-10 21:13:02

本帖最后由 st788796 于 2013-10-10 21:16 编辑

后面table比较麻烦，手册不全，要试着写
现在每行的基本数据有了，差个总长计算，重量计算不懂

Throne · 发表于 2013-10-10 21:28:28

用户组？？？怎么样可以查看？

st788796 · 发表于 2013-10-11 06:46:09

本帖最后由 st788796 于 2013-10-11 06:58 编辑

楼上代码已更新
主要功能已实现，api 环境CAD2005+，表格部分耗了太多时间，API手册不全，只能对照ActiveX Help逐个寻找测试，目前仅剩下两个小问题，一是标题行文字没写，二是数据区的文字对齐没有找到可用函数，两者解决了就可以做为专业插件发布
测试过程中有个问题，就是出错时自定义*error*没起作用，变量未清空，有待进一步研究

Lisphk · 发表于 2013-10-11 08:30:25

本帖最后由 Lisphk 于 2013-10-11 08:50 编辑

测试了下，很棒啊，有个建议，文字垂直方向能对中不？另外表头，文字能在对齐美化下不，或者一行里面充满，或者分两行等分写。
QQ截图20131011082815.jpg

webyl · 发表于 2013-10-11 08:39:37

Lisphk 发表于 2013-10-11 08:30
测试了下，很棒啊，有个建议，文字垂直方向能对中不？另外表头，文字能在对齐美化下不，或者一行里面充满 ...

lisphk
你能不能把权限设置低点

我都看不见，没有办法给你分

Lisphk · 发表于 2013-10-11 08:43:12

webyl 发表于 2013-10-11 08:39
lisphk
你能不能把权限设置低点

我设置啥权限？

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

[已解决] 求钢筋表自动生成lisp

最佳答案

点评

点评

点评

点评

点评

点评

点评

点评

点评