天正给水弯头三四通标注并制造统计表

eachy · 发表于 2013-10-18 07:19:40

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

需最新函数支持

(defun c:XDTB_PIPEHead1 (/ ss e pts ptl zh typ tf nl st str nl wh tb i title l1 p
colwidth tbindex strl
)
(xd::begin)
(if (setq ss (ssget '((0 . "TCH_PIPE,TCH_EQUIPMENT"))))
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq pts (mapcar
'(lambda (x)
(mapcar
'fix
x
)
)
(xdrx_entity_getstretchpoint e)
)
)
(if (= (setq typ (xdrx_getentdxf 0))
"TCH_EQUIPMENT"
)
(setq pts (cdr pts)
tf t
)
)
(mapcar
(function (lambda (x / index)
(setq ptl (cons (cons x (if tf
(list (list typ))
(list (list typ (fix
(xdrx_getentdxf 140)
) (rem
(apply
'angle
pts
) pi
)
)
)
)
) ptl
)
)
)
)
pts
)
(setq tf nil)
)
(setq ptl (xd::list:groupbyindex ptl 0))
(setq zh (* 2.5 (getvar "dimscale"))
st "DN"
)
(xdrx_layer_make "XD-管线标注" 1 t)
(mapcar
(function (lambda (x / p ll l pre sub strl l0)
(setq p (car x)
l (length (cdr x))
ll (vl-sort (cdr x) (function (lambda (x1 x2)
(if (< (length x1)
(length x2)
)
(> (car x1)
(car x2)
)
(> (cadr x1)
(cadr x2)
)
)
)
)
)
)
(setq l0 (vl-remove-if '(lambda (x)
(= (length x) 1)
) ll
)
)
(if (> (length l0) 1)
(setq l0 (apply
'append
(setq l1 (vl-sort (mapcar
'(lambda (b)
(if (> (length b) 1)
(vl-sort b '
(lambda
(d e)
(>
(cadr d)
(cadr e)
)
)
)
b
)
)
(mapcar
'cdr
(xd::list:groupbyindex
(mapcar
'
(lambda
(a)
(list
(last a) a
)
)
l0
) 0.1
)
)
) '(lambda (r s)
(> (cadar r)
(cadar s)
)
)
)
)
)
)
)
(if (= l 2)
(setq sub (strcat st (if (= (Length l0) 2)
(xdrx_string_join (mapcar
'itoa
(mapcar
'cadr
l0
)
) "-"
)
(strcat (itoa (cadar l0)) "-")
)
)
pre "弯头-"
)
(setq sub (if (= (length l0) 2)
(strcat st (xdrx_string_join (mapcar
'itoa
(mapcar
'cadr
l0
)
) "-"
) "-"
)
(strcat st (xdrx_string_join (mapcar
'itoa
(mapcar
'cadr
l0
)
) "-"
)
)
)
pre (if (= l 3)
(if (= (length (car l1)) 1)
"中大三通-"
"三通-"
)
"四通-"
)
)
)
(setq str (strcat pre sub)
nl (cons (list sub pre) nl)
)
(xdrx_text_make (polar (car x) (/ pi 4) 100.) str zh 0.)
)
)
(vl-remove-if '(lambda (x /)
(or
(= (length x) 2) ; _堵头
(and
(= (length x) 3)
(equal (cadr x) (caddr x))
)
)
) ptl
)
)
(if (setq p (getpoint "\n表格插入点: "))
(progn
(setq nl (vl-sort (xd::list:groupbyindex nl 0) '(lambda (x y)
(< (cadr x)
(cadr y)
)
)
)
tbindex (cdr (xd::table:Index (length nl) 7)) ; _构造Cell索引
i 1
nl (mapcar
'(lambda (x)
(list (itoa (setq i (1+ i))) ""
(xdrx_string_trimright (cadr x) "-") (car x) "个"
(itoa (1- (length x))) ""
)
)
nl
) ; _构造Cell文字
strl (vl-remove-if '(lambda (x)
(= (last x) "")
) (apply
'append
(mapcar
'(lambda (x y)
(mapcar
'(lambda (a b)
(reverse (cons a
(reverse b)
)
)
)
x
y
)
)
nl
tbindex
)
)
) ; _构造 Cell teststring
)
(xdrx_layer_make "XD-表格" 7 t)
(setq tb (xdrx_table_make p (1+ (length nl)) (* 7 (getvar "dimscale"))
7 (* 7 (getvar "dimscale"))
) ; _制造表格
; title '("序号" "图例" "名称" "规格"
; "单位" "数量" "备注")
colwidth '(1200 2800 4300 4300 1200 1500 4100) ; _列宽
)
(xd::table:begin tb)
(xdrx_table_setgridvisibility tb 2 59 nil) ; _隐藏 Title 边
(mapcar
'(lambda (x)
(xdrx_table_settextheight tb x (* 3 (getvar "dimscale")))
)
'(1 2 4)
) ; _设置所有 Cell 文字高度
(xdrx_table_setalignment tb 1 5) ; _数据区文字对齐方式
(mapcar
'(lambda (x y)
(xdrx_table_setcolumnwidth tb x y)
)
'(0 1 2 3 4 5 6 7)
colwidth
) ; _设置列宽
(xdrx_table_settextstring tb strl) ; _写入文字
(xd::table:end tb)
)
) ; (princ nl)
)
)
(xd::end)
(princ)
)

(defun c:XDTB_PIPEHead1 (/ ss e pts ptl zh typ tf nl st str nl wh tb i title l1 p 
                           colwidth tbindex strl 
                        ) 
  (xd::begin) 
  (if (setq ss (ssget '((0 . "TCH_PIPE,TCH_EQUIPMENT")))) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq pts (mapcar 
                    '(lambda (x) 
                       (mapcar 
                         'fix 
                         x 
                       ) 
                     ) 
                    (xdrx_entity_getstretchpoint e) 
                  ) 
        ) 
        (if (= (setq typ (xdrx_getentdxf 0)) 
               "TCH_EQUIPMENT" 
            ) 
          (setq pts (cdr pts) 
                tf t 
          ) 
        ) 
        (mapcar 
          (function (lambda (x / index) 
                      (setq ptl (cons (cons x (if tf 
                                                (list (list typ)) 
                                                (list (list typ (fix 
                                                                     (xdrx_getentdxf 140) 
                                                                ) (rem 
                                                                       (apply 
                                                                         'angle 
                                                                         pts 
                                                                       ) pi 
                                                                  ) 
                                                      ) 
                                                ) 
                                              ) 
                                      ) ptl 
                                ) 
                      ) 
                    ) 
          ) 
          pts 
        ) 
        (setq tf nil) 
      ) 
      (setq ptl (xd::list:groupbyindex ptl 0)) 
      (setq zh (* 2.5 (getvar "dimscale")) 
            st "DN" 
      ) 
      (xdrx_layer_make "XD-管线标注" 1 t) 
      (mapcar 
        (function (lambda (x / p ll l pre sub strl l0) 
                    (setq p (car x) 
                          l (length (cdr x)) 
                          ll (vl-sort (cdr x) (function (lambda (x1 x2) 
                                                          (if (< (length x1) 
                                                                 (length x2) 
                                                              ) 
                                                            (> (car x1) 
                                                               (car x2) 
                                                            ) 
                                                            (> (cadr x1) 
                                                               (cadr x2) 
                                                            ) 
                                                          ) 
                                                        ) 
                                              ) 
                             ) 
                    ) 
                    (setq l0 (vl-remove-if '(lambda (x) 
                                              (= (length x) 1) 
                                            ) ll 
                             ) 
                    ) 
                    (if (> (length l0) 1) 
                      (setq l0 (apply 
                                 'append 
                                 (setq l1 (vl-sort (mapcar 
                                                     '(lambda (b) 
                                                        (if (> (length b) 1) 
                                                          (vl-sort b ' 
                                                                   (lambda 
                                                                     (d e) 
                                                                     (> 
                                                                        (cadr d) 
                                                                        (cadr e) 
                                                                     ) 
                                                                   ) 
                                                          ) 
                                                          b 
                                                        ) 
                                                      ) 
                                                     (mapcar 
                                                       'cdr 
                                                       (xd::list:groupbyindex 
                                                                              (mapcar 
                                                                                ' 
                                                                                (lambda 
                                                                                  (a) 
                                                                                  (list 
                                                                                        (last a) a 
                                                                                  ) 
                                                                                ) 
                                                                                l0 
                                                                              ) 0.1 
                                                       ) 
                                                     ) 
                                                   ) '(lambda (r s) 
                                                        (> (cadar r) 
                                                           (cadar s) 
                                                        ) 
                                                      ) 
                                          ) 
                                 ) 
                               ) 
                      ) 
                    ) 
                    (if (= l 2) 
                      (setq sub (strcat st (if (= (Length l0) 2) 
                                             (xdrx_string_join (mapcar 
                                                                 'itoa 
                                                                 (mapcar 
                                                                   'cadr 
                                                                   l0 
                                                                 ) 
                                                               ) "-" 
                                             ) 
                                             (strcat (itoa (cadar l0)) "-") 
                                           ) 
                                ) 
                            pre "弯头-" 
                      ) 
                      (setq sub (if (= (length l0) 2) 
                                  (strcat st (xdrx_string_join (mapcar 
                                                                 'itoa 
                                                                 (mapcar 
                                                                   'cadr 
                                                                   l0 
                                                                 ) 
                                                               ) "-" 
                                             ) "-" 
                                  ) 
                                  (strcat st (xdrx_string_join (mapcar 
                                                                 'itoa 
                                                                 (mapcar 
                                                                   'cadr 
                                                                   l0 
                                                                 ) 
                                                               ) "-" 
                                             ) 
                                  ) 
                                ) 
                            pre (if (= l 3) 
                                  (if (= (length (car l1)) 1) 
                                    "中大三通-" 
                                    "三通-" 
                                  ) 
                                  "四通-" 
                                ) 
                      ) 
                    ) 
                    (setq str (strcat pre sub) 
                          nl (cons (list sub pre) nl) 
                    ) 
                    (xdrx_text_make (polar (car x) (/ pi 4) 100.) str zh 0.) 
                  ) 
        ) 
        (vl-remove-if '(lambda (x /) 
                         (or 
                           (= (length x) 2) ; _堵头 
                           (and 
                             (= (length x) 3) 
                             (equal (cadr x) (caddr x)) 
                           ) 
                         ) 
                       ) ptl 
        ) 
      ) 
      (if (setq p (getpoint "\n表格插入点: ")) 
        (progn 
          (setq nl (vl-sort (xd::list:groupbyindex nl 0) '(lambda (x y) 
                                                            (< (cadr x) 
                                                               (cadr y) 
                                                            ) 
                                                          ) 
                   ) 
                tbindex (cdr (xd::table:Index (length nl) 7)) ; _构造Cell索引 
                i 1 
                nl (mapcar 
                     '(lambda (x) 
                        (list (itoa (setq i (1+ i))) "" 
                              (xdrx_string_trimright (cadr x) "-") (car x) "个" 
                              (itoa (1- (length x))) "" 
                        ) 
                      ) 
                     nl 
                   )                       ; _构造Cell文字 
                strl (vl-remove-if '(lambda (x) 
                                      (= (last x) "") 
                                    ) (apply 
                                        'append 
                                        (mapcar 
                                          '(lambda (x y) 
                                             (mapcar 
                                               '(lambda (a b) 
                                                  (reverse (cons a 
                                                                 (reverse b) 
                                                           ) 
                                                  ) 
                                                ) 
                                               x 
                                               y 
                                             ) 
                                           ) 
                                          nl 
                                          tbindex 
                                        ) 
                                      ) 
                     )                       ; _构造 Cell teststring 
          ) 
          (xdrx_layer_make "XD-表格" 7 t) 
          (setq tb (xdrx_table_make p (1+ (length nl)) (* 7 (getvar "dimscale")) 
                                    7 (* 7 (getvar "dimscale")) 
                   )                       ; _制造表格 
                                       ; title     '("序号" "图例" "名称" "规格" 
                                       ; "单位" "数量" "备注") 
                colwidth '(1200 2800 4300 4300 1200 1500 4100) ; _列宽 
          ) 
          (xd::table:begin tb) 
          (xdrx_table_setgridvisibility tb 2 59 nil) ; _隐藏 Title 边 
          (mapcar 
            '(lambda (x) 
               (xdrx_table_settextheight tb x (* 3 (getvar "dimscale"))) 
             ) 
            '(1 2 4) 
          )                               ; _设置所有 Cell 文字高度 
          (xdrx_table_setalignment tb 1 5) ; _数据区文字对齐方式 
          (mapcar 
            '(lambda (x y) 
               (xdrx_table_setcolumnwidth tb x y) 
             ) 
            '(0 1 2 3 4 5 6 7) 
            colwidth 
          )                               ; _设置列宽 
          (xdrx_table_settextstring tb strl) ; _写入文字 
          (xd::table:end tb) 
        ) 
      )                                       ; (princ nl) 
    ) 
  ) 
  (xd::end) 
  (princ) 
)

xiaomm250 · 发表于 2013-10-18 09:56:46

虽然暂时用不到,但是围观一下

xskfq · 发表于 2013-10-18 13:34:01

谢谢，做的真不错！

zhong2013 · 发表于 2013-10-18 14:16:16

试试这个函数怎么样……。

zhuo2013 · 发表于 2013-10-25 15:59:20

新人入论坛学习

h163y163h163 · 发表于 2014-4-12 23:18:35

CAD2012下能用吗，怎样操作

liuchong1988 · 发表于 2014-4-13 08:29:23

谢谢，做的真不错！

h163y163h163 · 发表于 2014-4-13 11:18:06

用XDRX_API.R18.X64函数吗，

bzhjl · 发表于 2014-4-13 17:17:56

谢谢！从常用操作考虑，做的很好！

liuchong1988 · 发表于 2014-4-18 14:13:41

谢谢，做的真不错！

liuchong1988 · 发表于 2014-4-18 16:28:13

这个只能识别天正的吗？CAD图纸识别不了啊，消防水管道也识别不了，

liuchong1988 · 发表于 2014-4-20 08:55:51

虽然暂时用不到,但是围观一下

h163y163h163 · 发表于 2014-4-29 21:17:21

在autoCAD2012平台，天正2014上加载XDRX_API.R18.X64函数，使用这个插件不成功，想请教什么原因，

h163y163h163 · 发表于 2014-4-29 21:18:18

系统是win7

curtian · 发表于 2015-4-16 22:25:00

感谢分享

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

[专业] 天正给水弯头三四通标注并制造统计表

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子