统计相同曲线(复制)数量并制表

st788796 · 发表于 2014-3-10 19:04:38

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

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

×

;;str -- string
;;h -- height
;;scl -- 宽度比例
(defun XD::String:ActualWidth (str sty h scl)
(and
(or (not sty)
(= sty "")
(not (tblsearch "style" sty))
)
(setq sty (getvar "textstyle"))
)
(abs (car (apply
'mapcar
(cons '-
(textbox (list (cons 1 str)
(cons 7 sty)
(cons 40 h)
(cons 41 scl)
)
)
)
)
)
)
)
(defun XD::String:MaxActualWidth (strl sty h scl)
(apply 'max
(mapcar '(lambda (x)
(XD::String:ActualWidth x sty h scl)
)
strl
)
)
)
(defun XD::Table:Make (lst p RowHeight height
/ _ColumnWidths tb
i _widthL _spa
)
(defun _ColumnWidths (lst h / mL nl)
(setq mL (apply 'max (mapcar 'length lst))
nL (mapcar '(lambda (x)
(XD::List:FillGap x " " mL)
)
lst
)
)
(mapcar '(lambda (x)
(XD::String:MaxActualWidth x "" h 1.)
)
(apply 'mapcar (cons 'list nL))
)
)
(if (or (null height) (= height ""))
(setq height (* RowHeight 0.4))
)
(setq tb (xdrx_table_make
p
(1+ (length lst))
RowHeight
(apply 'max (mapcar 'length lst))
10.
)
_WidthL (_ColumnWidths lst height)
_spa (* 4 (xdrx_table_horzCellMargin tb))
)
(XD::Table:Begin tb)
(xdrx_entity_scale tb p 0.1)
(setq i -1)
(mapcar '(lambda (x)
(xdrx_table_setcolumnwidth tb (setq i (1+ i)) x)
)
(mapcar '(lambda (a) (+ _spa a)) _WidthL)
)
(xdrx_table_setrowheight tb RowHeight)
(xdrx_table_settextheight tb 7 height)
(xdrx_table_setalignment tb 1 5)
(xdrx_table_SetGridVisibility tb 2 41 nil)
(setq i 0)
(mapcar
'(lambda (x / j)
(setq j -1
i (1+ i)
)
(mapcar '(lambda (a)
(xdrx_table_settextstring tb i (setq j (1+ j)) a)
)
x
)
)
lst
)
(XD::Table:End tb)
tb
)
(defun c:XDTB_CalCurve (/ ss lst i p)
(princ "\n选择多义线.....")
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x / bp)
(setq bp (car (xdrx_entity_box x)))
(list (mapcar '(lambda (p)
(mapcar '- p bp)
)
(xdrx_entity_getstretchpoint x)
)
x
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 1)
lst (mapcar 'cdr lst)
)
(XD::Begin)
(setq i 64 ;_编号数量不大於 52 个 A-Z a-z
lst (mapcar '(lambda (x / box p)
(if (> 97 i 90)
(setq i 96)
)
(setq i (1+ i))
(mapcar '(lambda (a)
(setq box (xdrx_entity_box a)
p (xdrx_line_midp (car box) (caddr box))
)
(xdrx_text_make
p
(chr i)
(getvar "textsize")
0.
)
)
x
)
(list (chr i) (itoa (length x)))
)
lst
)
)
(if (setq p (getpoint "\n插入点<回车显示>: "))
(XD::Table:make
(cons '("编号" "数量") lst)
p
8.
3.
)
(foreach x lst
(princ "\n")
(princ x)
)
)
(XD::End)
)
)
(princ)
)

;;str -- string 
;;h   -- height 
;;scl -- 宽度比例 
(defun XD::String:ActualWidth (str sty h scl) 
  (and 
    (or        (not sty) 
        (= sty "") 
        (not (tblsearch "style" sty)) 
    ) 
    (setq sty (getvar "textstyle")) 
  ) 
  (abs (car (apply 
              'mapcar 
              (cons '- 
                    (textbox (list (cons 1 str) 
                                   (cons 7 sty) 
                                   (cons 40 h) 
                                   (cons 41 scl) 
                             ) 
                    ) 
              ) 
            ) 
       ) 
  ) 
) 
(defun XD::String:MaxActualWidth (strl sty h scl) 
  (apply 'max 
         (mapcar '(lambda (x) 
                    (XD::String:ActualWidth x sty h scl) 
                  ) 
                 strl 
         ) 
  ) 
) 
(defun XD::Table:Make (lst         p           RowHeight height 
                       /         _ColumnWidths             tb 
                       i         _widthL   _spa 
                      ) 
  (defun _ColumnWidths (lst h / mL nl) 
    (setq mL (apply 'max (mapcar 'length lst)) 
          nL (mapcar '(lambda (x) 
                        (XD::List:FillGap x " " mL) 
                      ) 
                     lst 
             ) 
    ) 
    (mapcar '(lambda (x) 
               (XD::String:MaxActualWidth x "" h 1.) 
             ) 
            (apply 'mapcar (cons 'list nL)) 
    ) 
  ) 
  (if (or (null height) (= height "")) 
    (setq height (* RowHeight 0.4)) 
  ) 
  (setq        tb        (xdrx_table_make 
                  p 
                  (1+ (length lst)) 
                  RowHeight 
                  (apply 'max (mapcar 'length lst)) 
                  10. 
                ) 
        _WidthL        (_ColumnWidths lst height) 
        _spa        (* 4 (xdrx_table_horzCellMargin tb)) 
  ) 
  (XD::Table:Begin tb) 
  (xdrx_entity_scale tb p 0.1) 
  (setq i -1) 
  (mapcar '(lambda (x) 
             (xdrx_table_setcolumnwidth tb (setq i (1+ i)) x) 
           ) 
          (mapcar '(lambda (a) (+ _spa a)) _WidthL) 
  ) 
  (xdrx_table_setrowheight tb RowHeight) 
  (xdrx_table_settextheight tb 7 height) 
  (xdrx_table_setalignment tb 1 5) 
  (xdrx_table_SetGridVisibility tb 2 41 nil) 
  (setq i 0) 
  (mapcar 
    '(lambda (x / j) 
       (setq j -1 
             i (1+ i) 
       ) 
       (mapcar '(lambda        (a) 
                  (xdrx_table_settextstring tb i (setq j (1+ j)) a) 
                ) 
               x 
       ) 
     ) 
    lst 
  ) 
  (XD::Table:End tb) 
  tb 
) 
(defun c:XDTB_CalCurve (/ ss lst i p) 
  (princ "\n选择多义线.....") 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x / bp) 
                           (setq bp (car (xdrx_entity_box x))) 
                           (list (mapcar '(lambda (p) 
                                            (mapcar '- p bp) 
                                          ) 
                                         (xdrx_entity_getstretchpoint x) 
                                 ) 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (xd::list:groupbyindex lst 1) 
            lst        (mapcar 'cdr lst) 
      ) 
      (XD::Begin) 
      (setq i        64 ;_编号数量不大於 52 个 A-Z a-z 
            lst        (mapcar        '(lambda (x / box p) 
                           (if (> 97 i 90) 
                             (setq i 96) 
                           ) 
                           (setq i (1+ i)) 
                           (mapcar '(lambda (a) 
                                      (setq box        (xdrx_entity_box a) 
                                            p        (xdrx_line_midp (car box) (caddr box)) 
                                      ) 
                                      (xdrx_text_make 
                                        p 
                                        (chr i) 
                                        (getvar "textsize") 
                                        0. 
                                      ) 
                                    ) 
                                   x 
                           ) 
                           (list (chr i) (itoa (length x))) 
                         ) 
                        lst 
                ) 
      ) 
      (if (setq p (getpoint "\n插入点<回车显示>: ")) 
        (XD::Table:make 
          (cons '("编号" "数量") lst) 
          p 
          8. 
          3. 
        ) 
        (foreach x lst 
          (princ "\n") 
          (princ x) 
        ) 
      ) 
      (XD::End) 
    ) 
  ) 
  (princ) 
)

树櫴希德 · 发表于 2014-3-11 20:51:31

好程序，强烈支持。

树櫴希德 · 发表于 2014-3-11 21:19:02

命令: xdtb
选择多义线.....
选择对象: 指定对角点: 找到 10 个

选择对象: no function definition: XDRX_PICKSET->ENTS

树櫴希德 · 发表于 2014-3-11 21:30:28

是不是要装XD工具箱？

树櫴希德 · 发表于 2014-3-11 23:25:12

XDRX_PICKSET->ENTS这个找不到

st788796 · 发表于 2014-3-12 00:01:30

加载xdrxapi

西楚河神 · 发表于 2014-3-12 16:47:12

本帖最后由西楚河神于 2014-3-12 17:57 编辑

大师再造一个构件统计吧DWG图纸链接

st788796 · 发表于 2014-3-12 17:06:36

西楚河神发表于 2014-3-12 16:47
大师再造一个构件统计吧

什么构件？
用GroupByIndex Table:Make造这样的表应该是一种程式了，可以自己试着写一个

西楚河神 · 发表于 2014-3-12 17:14:41

st788796 发表于 2014-3-12 17:06
什么构件？
用GroupByIndex Table:Make造这样的表应该是一种程式了，可以自己试着写一个

{:soso_e127:}职业是预算.翻样这个.......我是搞不懂.写不出这个表是精品世家的构件统计来的....它那个要注册不太方便

st788796 · 发表于 2014-3-12 17:46:01

西楚河神发表于 2014-3-12 17:14
职业是预算.翻样这个.......我是搞不懂.写不出这个表是精品世家的构件统计来的....它那 ...

块统计？线长统计？总要有个特性和样图才能说清

西楚河神 · 发表于 2014-3-12 18:01:00

7楼有样图链接现在再附上个动画录的有点大了,压缩了下传上来

st788796 · 发表于 2014-3-12 18:23:57

西楚河神发表于 2014-3-12 18:01
7楼有样图链接现在再附上个动画录的有点大了,压缩了下传上来

你这构件名称是哪来的

st788796 · 发表于 2014-3-12 19:14:11

西楚河神发表于 2014-3-12 18:01
7楼有样图链接现在再附上个动画录的有点大了,压缩了下传上来

你这个还是文字统计，论坛上写过很多，用最新的 Table:Make 函数就可以出表格，连线的写过程序

当然完全仿这个也没有问题，这些文字要有一定的特征，L 包括了 Lxxxx KLxxxx LLxxx，Q 是 Q开头匹配文字，Z应该是 Z 匹配文字了

st788796 · 发表于 2014-3-12 20:09:31

本帖最后由 st788796 于 2014-3-12 20:15 编辑

西楚河神发表于 2014-3-12 18:01
7楼有样图链接现在再附上个动画录的有点大了,压缩了下传上来

统计 L 并制表

(defun c:L (/ ss h lst p i tb)
(if (and (setq ss (ssget '((0 . "text") (1 . "*L*"))))
(setq p (getpoint "\nInsert Point: "))
)
(progn
(sssetfirst nil ss)
(setq h (xdrx_getpropertyvalue (ssname ss 0) "height")
lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Textstring")
x
)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 0)
i 0
lst (mapcar '(lambda (x)
(list (itoa (setq i (1+ i)))
(car x)
(itoa (length (cdr x)))
)
)
lst
)
tb (XD::Table:make
(cons '("编号" "构件名称" "数量") lst)
p
(* 2.25 h)
h
)
)
)
)
(princ)
)

(defun c:L (/ ss h lst p i tb) 
  (if (and (setq ss (ssget '((0 . "text") (1 . "*L*")))) 
           (setq p (getpoint "\nInsert Point: ")) 
      ) 
    (progn 
      (sssetfirst nil ss) 
      (setq h        (xdrx_getpropertyvalue (ssname ss 0) "height") 
            lst        (mapcar        '(lambda (x) 
                           (list (xdrx_getpropertyvalue x "Textstring") 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (XD::List:GroupByIndex lst 0) 
            i        0 
            lst        (mapcar        '(lambda (x) 
                           (list (itoa (setq i (1+ i))) 
                                 (car x) 
                                 (itoa (length (cdr x))) 
                           ) 
                         ) 
                        lst 
                ) 
            tb        (XD::Table:make 
                  (cons '("编号" "构件名称" "数量") lst) 
                  p 
                  (* 2.25 h) 
                  h 
                ) 
      ) 
    ) 
  ) 
  (princ) 
)

把 "*L*" 换成 "Q*" 就是统计 Q

西楚河神 · 发表于 2014-3-12 21:52:38

st788796 发表于 2014-3-12 20:09
统计 L 并制表

把 "*L*" 换成 "Q*" 就是统计 Q

刚试了只能是查找后会亮显要效果是:查找到后先亮显,这样可以先目测大体可检查下看看是否有漏选的,目测检查完毕后左键指定放置统计表的位置 (最好是手动输入要查找的构件关键字比如任意形式的梁,输入"L" 任意的柱,输入"Z",只要是单行文字里包含任意输入的字母都统计汇总成表)

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

[工具] 统计相同曲线(复制)数量并制表

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

点评

点评

点评