填充图例表（第三版）

newer · 发表于 2018-9-29 02:17:31

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

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

×

根据反馈的建议，调整了第二版，先按颜色排序，同颜色的，按模式排序

(defun c:XDTB_TJHATULI (/ blk clr e h ha hascl i
lst lyr mode name scl ss x y val
info
)
(defun my_err (msg)
(princ "\n")
(princ msg)
(xdrx_end)
(setq *error* nil)
)
(defun _maketuli (clr mode lyr) ;(princ "\nmode=")(princ mode)
(setq name (xdrx_prompt "XD-TJ-HA-" mode "-" clr t))
(if (not (setq blk (xdrx_object_get "block" name)))
(progn (setq e (xdrx_polyline_make
(xd::pnt:getrecpnts '(0 0 0) (* scl 10.) (* 5 scl))
t
)
)
(xdrx_setpropertyvalue
e
"constantwidth"
(* scl 0.3)
"color"
7
"layer"
lyr
)
(setq ha (xdrx_hatch_make e))
(xdrx_setpropertyvalue
(xd::pickset:getsub ha '((0 . "HATCH")))
"color"
clr
"patternname"
mode
"layer"
lyr
)
(xdrx_block_make (strcase name) (list e ha) '(0 0 0.) t)
(xdrx_entity_delete (entlast))
(setq blk (xdrx_object_get "block" name))
(xdrx_draworder->back
(setq ha (car (xdrx_block_getentities blk '((0 . "HATCH")))))
)
(setq hascl (XD::Hatch:GetSclByGap mode (* 1.414 scl)))
(xdrx_setpropertyvalue
ha
"PatternScale"
hascl
"patternname"
(list 1 mode)
)
)
)
blk
)
(xdrx_begin)
(setq *error* my_err)
(if (and (xdrx_initssget "\n选择要统计的填充<退出>:")
(setq ss (xdrx_ssget '((0 . "HATCH"))))
)
(progn (setq scl (* (xd::var:getratio) (xd::var:getscaleratio)))
(setq lst (mapcar '(lambda (x)
(setq info (xdrx_getpropertyvalue
x "color"
t "patternname"
"layer" nil
)
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 0.01)
lst (mapcar '(lambda (x)
(cons (car x)
(vl-sort (xd::list:groupbyindex (cdr x) 0.1)
'(lambda (x y) (< (car x) (car y)))
)
)
)
lst
)
lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
i 0
lst (apply 'append
(mapcar
'(lambda (x)
(setq clr (car x))
(mapcar '(lambda (y)
(setq i (1+ i))
(list (itoa i)
(_maketuli clr (car y) (cadr y))
(vl-princ-to-string clr)
(cadr y)
)
)
(cdr x)
)
)
lst
)
)
lst (append (list (list "填充图例表" nil nil nil)
(list "序号" "图例" "颜色" "图层")
)
lst
)
)
(if (not #hatch_tuli_txth)
(setq #hatch_tuli_txth 5.0)
)
(if (setq
h (getreal (xdrx_prompt "\n字高<" #hatch_tuli_txth ">:" t))
)
(setq #hatch_tuli_txth h)
)
(xdrx_sysvar_push '("cecolor" "7"))
(xd::text:Init 1)
(xd::table:makefromlist
lst
'(0 0 0)
#hatch_tuli_txth
(/ #hatch_tuli_txth 2.0)
)
(if (vl-catch-all-error-p
(vl-catch-all-apply
'XD::Drag:SimpleMove
(list (entlast) "\n表格插入点:" 8 t)
)
)
(xdrx_entity_delete (entlast))
)
)
(prompt "\n没有选择填充实体.")
)
(xdrx_end)
(princ)
)

(defun c:XDTB_TJHATULI (/    blk  clr  e    h         ha   hascl        i 
                        lst  lyr  mode name scl         ss   x           y        val 
                        info 
                       ) 
  (defun my_err        (msg) 
    (princ "\n") 
    (princ msg) 
    (xdrx_end) 
    (setq *error* nil) 
  ) 
  (defun _maketuli (clr mode lyr)        ;(princ "\nmode=")(princ mode) 
    (setq name (xdrx_prompt "XD-TJ-HA-" mode "-" clr t)) 
    (if        (not (setq blk (xdrx_object_get "block" name))) 
      (progn (setq e (xdrx_polyline_make 
                       (xd::pnt:getrecpnts '(0 0 0) (* scl 10.) (* 5 scl)) 
                       t 
                     ) 
             ) 
             (xdrx_setpropertyvalue 
               e 
               "constantwidth" 
               (* scl 0.3) 
               "color" 
               7 
               "layer" 
               lyr 
             ) 
             (setq ha (xdrx_hatch_make e)) 
             (xdrx_setpropertyvalue 
               (xd::pickset:getsub ha '((0 . "HATCH"))) 
               "color" 
               clr 
               "patternname" 
               mode 
               "layer" 
               lyr 
             ) 
             (xdrx_block_make (strcase name) (list e ha) '(0 0 0.) t) 
             (xdrx_entity_delete (entlast)) 
             (setq blk (xdrx_object_get "block" name)) 
             (xdrx_draworder->back 
               (setq ha (car (xdrx_block_getentities blk '((0 . "HATCH"))))) 
             ) 
             (setq hascl (XD::Hatch:GetSclByGap mode (* 1.414 scl))) 
             (xdrx_setpropertyvalue 
               ha 
               "PatternScale" 
               hascl 
               "patternname" 
               (list 1 mode) 
             ) 
      ) 
    ) 
    blk 
  ) 
  (xdrx_begin) 
  (setq *error* my_err) 
  (if (and (xdrx_initssget "\n选择要统计的填充<退出>:") 
           (setq ss (xdrx_ssget '((0 . "HATCH")))) 
      ) 
    (progn (setq scl (* (xd::var:getratio) (xd::var:getscaleratio))) 
           (setq lst (mapcar '(lambda (x) 
                                (setq info (xdrx_getpropertyvalue 
                                             x                "color" 
                                             t                "patternname" 
                                             "layer"        nil 
                                            ) 
                                ) 
                              ) 
                             (xdrx_pickset->ents ss) 
                     ) 
                 lst (xd::list:groupbyindex lst 0.01) 
                 lst (mapcar '(lambda (x) 
                                (cons (car x) 
                                      (vl-sort (xd::list:groupbyindex (cdr x) 0.1) 
                                               '(lambda (x y) (< (car x) (car y))) 
                                      ) 
                                ) 
                              ) 
                             lst 
                     ) 
                 lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))) 
                 i   0 
                 lst (apply 'append 
                            (mapcar 
                              '(lambda (x) 
                                 (setq clr (car x)) 
                                 (mapcar '(lambda (y) 
                                            (setq i (1+ i)) 
                                            (list (itoa i) 
                                                  (_maketuli clr (car y) (cadr y)) 
                                                  (vl-princ-to-string clr) 
                                                  (cadr y) 
                                            ) 
                                          ) 
                                         (cdr x) 
                                 ) 
                               ) 
                              lst 
                            ) 
                     ) 
                 lst (append (list (list "填充图例表" nil nil nil) 
                                   (list "序号" "图例" "颜色" "图层") 
                             ) 
                             lst 
                     ) 
           ) 
           (if (not #hatch_tuli_txth) 
             (setq #hatch_tuli_txth 5.0) 
           ) 
           (if (setq 
                 h (getreal (xdrx_prompt "\n字高<" #hatch_tuli_txth ">:" t)) 
               ) 
             (setq #hatch_tuli_txth h) 
           ) 
           (xdrx_sysvar_push '("cecolor" "7")) 
           (xd::text:Init 1) 
           (xd::table:makefromlist 
             lst 
             '(0 0 0) 
             #hatch_tuli_txth 
             (/ #hatch_tuli_txth 2.0) 
           ) 
           (if (vl-catch-all-error-p 
                 (vl-catch-all-apply 
                   'XD::Drag:SimpleMove 
                   (list (entlast) "\n表格插入点:" 8 t) 
                 ) 
               ) 
             (xdrx_entity_delete (entlast)) 
           ) 
    ) 
    (prompt "\n没有选择填充实体.") 
  ) 
  (xdrx_end) 
  (princ) 
)

cfc123456 · 发表于 2018-9-29 10:35:12

厉害我的哥，自动生成图例。

lz85031 · 发表于 2018-9-29 12:02:43

制图利器，厉害了我的哥！

searinon · 发表于 2018-9-29 14:22:08

厉害了版主。。。

changhui1122 · 发表于 2018-9-29 14:26:24

真是厉害了版主，这都可以。

=^_^= · 发表于 2018-9-29 16:01:49

看样了很不错

lz85031 · 发表于 2018-9-30 00:14:03

得空下载试试看。先谢谢楼主的付出！

evayleung · 发表于 2018-9-30 01:17:50

这功能好，这种统计方面的能省下我们不少时间

ngc · 发表于 2018-10-2 09:59:18

抽空看看，统计方便的同仁，有福了

lz85031 · 发表于 2018-10-3 12:41:28

俺的豆豆不够，得再继续加油才行

86533045 · 发表于 2018-10-11 00:43:55

好东西谢谢分享
来自: 微社区

humaster · 发表于 2018-10-26 11:09:27

dear sir,
looking nice

humaster · 发表于 2018-10-30 08:43:48

厉害我的哥，自动生成图例。

chenruipeng · 发表于 2020-7-24 12:52:16

XDTB_TJHATULI 未知命令“XDTB_TJHATULI”。按 F1 查看帮助。输入的字符串有缺陷

chenruipeng · 发表于 2020-7-24 12:54:42

XDTB_TJHATULI 未知命令“XDTB_TJHATULI”。按 F1 查看帮助。输入的字符串有缺陷

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

[填充] 填充图例表（第三版）

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