填充图例表（第二版）

newer · 发表于 2018-7-23 19:24:28

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

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

×

根据模式、图层、颜色分类，提取当前图中的填充作成图例表

(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)
(if (not #xd_var_global_hatch_tj_mode)
(setq #xd_var_global_hatch_tj_mode 2))
(xdrx_initget "0 1 2")
(if (setq mode (getint (xdrx_prompt "\n统计模式[图层(0)/颜色(1)/模式(2)]<" #xd_var_global_hatch_tj_mode ">:" t)))
(setq #xd_var_global_hatch_tj_mode mode))
(xdrx_initget)
(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 "patternname" "layer" nil "color" t))
(setq val (cond ((= #xd_var_global_hatch_tj_mode 2)
(car info))
((= #xd_var_global_hatch_tj_mode 0)
(cadr info))
(t
(last info))))
(if (/= (type val) 'STR)
(setq val (vl-princ-to-string val)))
(list val (car info)(cadr info)(caddr info) x))
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 0.01)
lst (vl-sort lst '(lambda (x y)
(< (car x) (car y))
)
)
lst (mapcar
'cadr
lst
)
i 0
lst (mapcar
'(lambda (x)
(setq i (1+ i))
(list (itoa i) (_maketuli (caddr x)(car x)(cadr x))
(car x)(cadr x)
(vl-princ-to-string (caddr x))
)
)
lst
)
lst (append
(list (list "填充图例表" nil 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) 
  (if (not #xd_var_global_hatch_tj_mode) 
    (setq #xd_var_global_hatch_tj_mode 2)) 
 
  (xdrx_initget "0 1 2") 
  (if (setq mode (getint (xdrx_prompt "\n统计模式[图层(0)/颜色(1)/模式(2)]<" #xd_var_global_hatch_tj_mode ">:" t))) 
    (setq #xd_var_global_hatch_tj_mode mode)) 
  (xdrx_initget) 
  (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 "patternname" "layer" nil "color" t)) 
                     (setq val (cond ((= #xd_var_global_hatch_tj_mode 2) 
                                                           (car info)) 
                                                          ((= #xd_var_global_hatch_tj_mode 0) 
                                                           (cadr info)) 
                                                          (t 
                                                           (last info)))) 
                     (if (/= (type val) 'STR) 
                       (setq val (vl-princ-to-string val))) 
                     (list val (car info)(cadr info)(caddr info) x)) 
                  (xdrx_pickset->ents ss) 
                ) 
            lst (xd::list:groupbyindex lst 0.01) 
            lst (vl-sort lst '(lambda (x y) 
                                (< (car x) (car y)) 
                              ) 
                ) 
            lst (mapcar 
                  'cadr 
                  lst 
                ) 
            i 0 
            lst (mapcar 
                  '(lambda (x) 
                     (setq i (1+ i)) 
                     (list (itoa i) (_maketuli (caddr x)(car x)(cadr x)) 
                                    (car x)(cadr x) 
                           (vl-princ-to-string (caddr x)) 
                     ) 
                   ) 
                  lst 
                ) 
            lst (append 
                  (list (list "填充图例表" nil 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) 
)

dwg001 · 发表于 2018-7-23 20:48:21

精彩创意！学习了！要是同时发布“脱裤”版本，用起来更加方便。

newer · 发表于 2018-7-23 21:00:59

本帖最后由 newer 于 2018-7-23 21:03 编辑

dwg001 发表于 2018-7-23 20:48
精彩创意！学习了！要是同时发布“脱裤”版本，用起来更加方便。

如果要脱裤，要写很长代码，也要很长的时间。你就不会看到这么多插件了。
用XDRX API，我10分钟就一个这样的插件，没它，可能要几天。

画图要快，是因为不做重复的事情，写代码一样，总做低级、重复的事情也不高明啊。
站在前人的肩膀上，看的才比前人更远。

longer88 · 发表于 2018-7-24 00:04:47

感谢分享。

lixiaolin · 发表于 2018-7-24 08:18:52

感谢分享

yangjian001 · 发表于 2018-7-24 08:48:28

做一个热心并受欢迎的人

zhangfaren · 发表于 2018-7-24 08:48:42

感谢版主分享！

t666666 · 发表于 2018-7-24 19:12:56

很好的工具，谢谢楼主了！

feeling_chin · 发表于 2021-6-16 15:54:42

还没试，但是应该先点个赞

hh_lj007 · 发表于 2021-9-10 09:01:43

感谢分享！

九天揽月亮 · 发表于 2021-9-14 10:16:39

感谢楼主分享！！！

yaojing38 · 发表于 2022-4-11 11:03:14

太好用了，，谢谢分享！！

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

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

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

点评