绿化乔木统计（图块统计）

77077 · 发表于 2015-4-24 13:21:07

本帖最后由 77077 于 2015-4-24 13:22 编辑

走过路过，可以进来看看，不收钱不代表不好用~~~

;========================
; 绿化乔木统计
;========================
;
;
;图块选择集到图块名列表
(defun ss-insert-namelist (ss / i en lst_en)
(setq lst_en '()
i 0
)
(repeat (sslength ss)
(setq en (ssname ss i)
en (cdr(assoc 2 (entget en)))
lst_en (cons en lst_en)
i (1+ i)
)
)
(reverse lst_en)
)
;;;统计同名块数量，并格式化数据
(defun Countblocklist (lst / a len x return)
(while lst
(setq a (car lst))
(setq len (length lst))
(setq lst (vl-remove-if '(lambda (x) (= a x)) lst))
(setq return (cons (list a a (itoa(- len (length lst))) "-" "-" "-" "-" "-") return))
)
return
)
;图块列表输出到屏幕
(defun BLKLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)
(defun emkLine (p1 p2)
(entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))
)
(defun emkText (pt str h)
(entmake (list '(0 . "TEXT") (cons 1 str) '(8 . "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))
)
(defun emkInsert (pt blkname bl)
(entmake (list '(0 . "INSERT") (cons 2 blkname) (cons 8 "DM_文字表格") (cons 10 pt)(cons 41 bl)(cons 42 bl)))
)
(setq h (* zg 2)
len1 (length lis)
len2 8
p0 (list (car pt) (- (cadr pt) (* 0.5 h)))
wlst (mapcar '(lambda(x) (* x zg)) '(4 8 6 6 6 6 6 10))
)
(setq i 0 j 0 w1 0 w2 0)
(foreach e lis
(setq h1 (- (cadr p0) (* i h)))
(foreach f e
(setq w1 (nth j wlst) w2 (+ w2 w1))
(setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1))
(if (= i 0)
(emkText P1 f zg)
(if (= j 0)
(emkInsert P1 f zg)
(emkText P1 f zg)
)
)
(setq j (1+ j))
)
(setq i (1+ i) j 0 w1 0 w2 0)
)
(setq tab_h (* len1 h))
(emkLine pt (polar pt (* pi 1.5) tab_h))
(setq len 0)
(foreach x wlst
(setq len (+ x len) p1 (polar pt 0 len))
(emkLine p1 (polar p1 (* Pi 1.5) tab_h))
)
(setq i 0 len 0)
(setq len (apply '+ wlst))
(repeat (1+ len1)
(setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))
(emkLine p1 (polar p1 0 len))
)
(princ)
)
;main
(defun c:TreeCount( / os lst sslst x zg pt )
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq lst '("图例" "植物名称" "数量(株)" "株高(CM)" "胸径(CM)" "地径(CM)" "冠幅(CM)" "备注"))
(setq sslst(ssget (list '(0 . "INSERT"))))
(if sslst
(progn
(setq sslst (ss-insert-namelist sslst)
sslst (Countblocklist sslst)
lst (cons lst sslst)
)
(setq zg(getreal "\n字高: ")
pt(getpoint "\n左上角: ")
)
(BLKLst2Table lst pt zg)
)
(alert "没选到图块！")
)
(setvar "osmode" os)
(prin1)
)

;======================== 
;   绿化乔木统计          
;======================== 
; 
; 
;图块选择集到图块名列表 
(defun ss-insert-namelist (ss / i en lst_en) 
  (setq lst_en '() 
  i 0 
  ) 
  (repeat (sslength ss) 
    (setq en (ssname ss i) 
    en (cdr(assoc 2 (entget en))) 
    lst_en (cons en lst_en) 
    i (1+ i) 
    ) 
    ) 
  (reverse lst_en) 
  ) 
;;;统计同名块数量，并格式化数据 
(defun Countblocklist (lst / a len x return) 
  (while lst 
    (setq a (car lst)) 
    (setq len (length lst)) 
    (setq lst (vl-remove-if '(lambda (x) (= a x)) lst)) 
    (setq return (cons (list a a (itoa(- len (length lst))) "-" "-" "-" "-" "-") return)) 
    ) 
  return 
  ) 
;图块列表输出到屏幕 
(defun BLKLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt) 
  (defun emkLine (p1 p2) 
    (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2))) 
    ) 
  (defun emkText (pt str h) 
    (entmake (list '(0 . "TEXT") (cons 1 str) '(8 . "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2))) 
    ) 
  (defun emkInsert (pt blkname bl) 
    (entmake (list '(0 . "INSERT") (cons 2 blkname) (cons 8 "DM_文字表格") (cons 10 pt)(cons 41 bl)(cons 42 bl))) 
    ) 
  (setq h (* zg 2) 
  len1 (length lis) 
  len2 8 
  p0 (list (car pt) (- (cadr pt) (* 0.5 h))) 
  wlst (mapcar '(lambda(x) (* x zg)) '(4 8 6 6 6 6 6 10)) 
  ) 
  (setq i 0 j 0 w1 0 w2 0) 
  (foreach e lis 
    (setq h1 (- (cadr p0) (* i h))) 
    (foreach f e 
      (setq w1 (nth j wlst) w2 (+ w2 w1)) 
      (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) 
      (if (= i 0) 
  (emkText P1 f zg) 
  (if (= j 0) 
    (emkInsert P1 f zg) 
    (emkText P1 f zg) 
    ) 
  ) 
      (setq j (1+ j)) 
      ) 
    (setq i (1+ i) j 0 w1 0 w2 0) 
    ) 
  (setq tab_h (* len1 h)) 
  (emkLine pt (polar pt (* pi 1.5) tab_h)) 
  (setq len 0) 
  (foreach x wlst 
    (setq len (+ x len) p1 (polar pt 0 len)) 
    (emkLine p1 (polar p1 (* Pi 1.5) tab_h)) 
    ) 
  (setq i 0 len 0) 
  (setq len (apply '+ wlst)) 
  (repeat (1+ len1) 
    (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i)) 
    (emkLine p1 (polar p1 0 len)) 
    ) 
  (princ) 
  ) 
;main 
(defun c:TreeCount( / os lst sslst x zg pt ) 
  (setvar "cmdecho" 0) 
  (setq os (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setq lst '("图例" "植物名称" "数量(株)" "株高(CM)" "胸径(CM)" "地径(CM)" "冠幅(CM)" "备注")) 
  (setq sslst(ssget (list '(0 . "INSERT")))) 
  (if sslst 
    (progn 
      (setq sslst (ss-insert-namelist sslst) 
      sslst (Countblocklist sslst) 
      lst (cons lst sslst) 
      ) 
      (setq zg(getreal "\n字高: ") 
      pt(getpoint "\n左上角: ") 
      ) 
      (BLKLst2Table lst pt zg) 
      ) 
    (alert "没选到图块！") 
    ) 
  (setvar "osmode" os) 
  (prin1) 
  )

594826903 · 发表于 2019-12-16 10:42:19

图块比例和图框不统一，统计图例变得很大！

tender138 · 发表于 2024-8-18 08:07:22

感谢 77077 分享程序赞一个!

mocheng · 发表于 2019-12-16 19:07:16

谢谢楼主分享

海盗曹 · 发表于 2015-4-24 13:32:15

沙发，学习一下

spp_wall · 发表于 2015-4-24 14:51:28

支持！！！！

eii · 发表于 2015-4-24 16:29:49

不错，赞一个

yoyoho · 发表于 2015-4-24 19:02:23

感谢 77077 分享程序赞一个!

zzyong00 · 发表于 2015-4-24 22:04:58

顶一下，不错........

xiang19751218 · 发表于 2015-4-25 08:48:52

很实用的插件，谢谢共享。

tianyi1230 · 发表于 2015-4-25 11:16:48

绝对喜欢，可是楼主能像严大师那样变成这样的效果吗？
http://bbs.mjtd.com/forum.php?mo ... C%BF%E9%CD%B3%BC%C6

tianyi1230 · 发表于 2015-4-25 17:23:14

这个是一个免费版本的园林工具

用户3766035971 · 发表于 2015-4-25 17:37:09

不错，赞一个

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

[源码] 绿化乔木统计（图块统计）

本帖子中包含更多资源

评分

相关帖子

本帖子中包含更多资源