统计单行文字数量

advksf

原程序源码：统计图块并列表;统计文字并列表
现需求，在统计文字时，代码加个过虑条件，判断字符长度(字符低于4 字符 长于15字符不统计 )
CAD 文档中黄色框为鼠标框选区域，
该怎样写。麻烦会的朋友，帮忙完善，谢谢~

xj6019

advksf 发表于 2022-3-29 13:44
谢谢你的参与，
试了一下，还是会统计到长度 4字符以下的内容，

改了  再试一下   .

xj6019

是这样吗

advksf

xj6019 发表于 2022-3-29 12:32
是这样吗

谢谢你的参与，
试了一下，还是会统计到长度 4字符以下的内容，  

htlaser

xj6019 发表于 2022-3-29 13:57
改了  再试一下   .

(if(and (>(strlen name)4)(<(strlen name)15))  改 (if(and (>(strlen name)4)(<= (strlen name)15))

advksf

htlaser 发表于 2022-3-29 14:16
(if(and (>(strlen name)4)((strlen name)4)(

不知道 是不是我用浩辰的原因。还是不行，
改成(if(and (>(strlen name)4)(<= (strlen name)15)) 之后 统计结果都没有了
回去我用 别的版本试试看。

htlaser

advksf 发表于 2022-3-29 15:17
不知道 是不是我用浩辰的原因。还是不行，
改成(if(and (>(strlen name)4)(

1. (defun c:test (/ en mpl ss n nn m xx pt0 mpl_new i)
   
2.         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=0.1
   
3.         (setq ss (ssget '((0 . "text"))))
   
4.         (or ss (setq ss (ssadd)))
   
5.         (setq n 0 nn (sslength ss) mpl '())
   
6.         (while (< n nn)
   
7.                 (setq en (ssname ss n) data (entget en))
   
8.                 (setq n (1+ n))
   
9.                 (setq name (cdr (assoc 1 data)));;;
   
10.                 (if(and (>(strlen name)4)(<= (strlen name)15))
    
11.                 (progn
    
12.                 (setq xx (assoc name mpl))               
    
13.                 (if xx
    
14.                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))
    
15.                         (setq mpl (append (list (list name 1)) mpl))
    
16.                         ;(setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))
    
17.                         ;(setq mpl (cons (cons name 1) mpl))
    
18.                 )
    
19.                 )
    
20.                 )
    
21.   )
    
22.         (if mpl
    
23.                 (progn
    
24.                         (setq i 0)
    
25.                         (setq mpl_new '())
    
26.                         (foreach x mpl
    
27.                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                               
    
28.                         )                               
    
29.                         (setq mpl_new (append (list (list "序号" "内容" "数量")) (reverse mpl_new)))                       
    
30.                         (initget 0 "S")
    
31.                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)
    
32.                                 (progn
    
33.                                         (while (= pt0 "S")
    
34.                                                 (setq str (strcat "\n(建议高度:"(rtos (* 12 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))
    
35.                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值
    
36.                                                 (initget 0 "S")
    
37.                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))
    
38.                                                 (if (null pt0)(exit))
    
39.                                         )                               
    
40.                                         (if (and pt0 *table-zg)
    
41.                                                 (TableLst2Table mpl_new pt0 *table-zg)                                               
    
42.                                         )
    
43.                                 )
    
44.                         )
    
45.                         (princ "/nNothing!")               
    
46.                 )
    
47.                 (princ)
    
48.         )
    
49. )
    
50. ;参数:
    
51. ;lis --- 表格型list
    
52. ;pt --- 表格左上角(点)
    
53. ;zg ---- 字高(数值型)
    
54. ;测试(TableLst2Table '((1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890)(1.0 0.0 0.0)(100.0 12345.0 "5551000" "1234")) (getpoint) 10)
    
55. (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)
    
56.   (defun emkLine (p1 p2)
    
57.     (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))
    
58.         )
    
59.   (defun emkText (pt str h)
    
60.     (entmake (list '(0 . "TEXT") (cons 1 str) (cons 8 "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))
    
61.         )
    
62.   (setq h (* zg 2)                             ; 表格高
    
63.                 len1 (length lis)                      ; 表格行数len1
    
64.                 len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2
    
65.                 p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点
    
66.         )
    
67.   (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型
    
68.   ; 以下获取列宽表 wlst
    
69.   (setq i 0 w2 0 wlst '())
    
70.   (repeat len2
    
71.     (foreach e lis
    
72.       (setq txt (nth i e))
    
73.       (if (not txt) (setq txt ""))         ;如果没有字符
    
74.       (setq w1 (* (+ (strlen txt) 1) zg))  ; 列宽=(文字长度+1)*zg
    
75.       (if (> w1 w2) (setq w2 w1))          ;取最大列宽
    
76.                 )
    
77.     (setq wlst (cons w2 wlst) w2 0 i (1+ i))
    
78.         )
    
79.   ;以下按行写出文字
    
80.   (setq wlst (reverse wlst))
    
81.   (setq i 0 j 0 w1 0 w2 0)
    
82.   (foreach e lis
    
83.     (setq h1 (- (cadr p0) (* i h)))        ; 文字行的y坐标值
    
84.     (foreach f e
    
85.       (setq w1 (nth j wlst) w2 (+ w2 w1))
    
86.       (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点
    
87.       (emkText P1 f zg)
    
88.       (setq j (1+ j))
    
89.                 )
    
90.     (setq i (1+ i) j 0 w1 0 w2 0)
    
91.         )
    
92.   ; 开始绘制竖线
    
93.   (setq tab_h (* len1 h))                  ; 竖线长
    
94.   (emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线
    
95.   (setq len 0)
    
96.   (foreach x wlst                          ; 绘制竖线
    
97.     (setq len (+ x len) p1 (polar pt 0 len))
    
98.     (emkLine p1 (polar p1 (* Pi 1.5) tab_h))
    
99.         )
    
100.   ; 开始绘制横线
     
101.   (setq i 0 len 0)
     
102.   (setq len (apply '+ wlst))              ; 横线长度
     
103.   (repeat (1+ len1)                       ; 绘制横线
     
104.     (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))
     
105.     (emkLine p1 (polar p1 0 len))
     
106.         )
     
107.   (princ)
     
108. )

(defun c:test (/ en mpl ss n nn m xx pt0 mpl_new i)<br />         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=0.1<br />         (setq ss (ssget '((0 . "text"))))<br />         (or ss (setq ss (ssadd)))<br />         (setq n 0 nn (sslength ss) mpl '())<br />         (while (< n nn)<br />                 (setq en (ssname ss n) data (entget en))<br />                 (setq n (1+ n))<br />                 (setq name (cdr (assoc 1 data)));;;<br />                 (if(and (>(strlen name)4)(<= (strlen name)15))<br />                 (progn<br />                 (setq xx (assoc name mpl))                <br />                 (if xx<br />                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))<br />                         (setq mpl (append (list (list name 1)) mpl))<br />                         ;(setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))<br />                         ;(setq mpl (cons (cons name 1) mpl))<br />                 )<br />                 )<br />                 )<br />   )<br />         (if mpl<br />                 (progn<br />                         (setq i 0)<br />                         (setq mpl_new '())<br />                         (foreach x mpl<br />                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                                <br />                         )                                <br />                         (setq mpl_new (append (list (list "序号" "内容" "数量")) (reverse mpl_new)))                        <br />                         (initget 0 "S")<br />                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)<br />                                 (progn<br />                                         (while (= pt0 "S")<br />                                                 (setq str (strcat "\n(建议高度:"(rtos (* 12 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))<br />                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值<br />                                                 (initget 0 "S")<br />                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))<br />                                                 (if (null pt0)(exit))<br />                                         )                                <br />                                         (if (and pt0 *table-zg)<br />                                                 (TableLst2Table mpl_new pt0 *table-zg)                                                <br />                                         )<br />                                 )<br />                         )<br />                         (princ "/nNothing!")                <br />                 )<br />                 (princ)<br />         )<br /> )<br /> ;参数:<br /> ;lis --- 表格型list<br /> ;pt --- 表格左上角(点)<br /> ;zg ---- 字高(数值型)<br /> ;测试(TableLst2Table '((1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890)(1.0 0.0 0.0)(100.0 12345.0 "5551000" "1234")) (getpoint) 10)<br /> (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)<br />   (defun emkLine (p1 p2)<br />     (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))<br />         )<br />   (defun emkText (pt str h)<br />     (entmake (list '(0 . "TEXT") (cons 1 str) (cons 8 "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))<br />         )<br />   (setq h (* zg 2)                             ; 表格高<br />                 len1 (length lis)                      ; 表格行数len1<br />                 len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2<br />                 p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点<br />         )<br />   (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型<br />   ; 以下获取列宽表 wlst<br />   (setq i 0 w2 0 wlst '())<br />   (repeat len2<br />     (foreach e lis<br />       (setq txt (nth i e))<br />       (if (not txt) (setq txt ""))         ;如果没有字符<br />       (setq w1 (* (+ (strlen txt) 1) zg))  ; 列宽=(文字长度+1)*zg<br />       (if (> w1 w2) (setq w2 w1))          ;取最大列宽<br />                 )<br />     (setq wlst (cons w2 wlst) w2 0 i (1+ i))<br />         )<br />   ;以下按行写出文字<br />   (setq wlst (reverse wlst))<br />   (setq i 0 j 0 w1 0 w2 0)<br />   (foreach e lis<br />     (setq h1 (- (cadr p0) (* i h)))        ; 文字行的y坐标值<br />     (foreach f e<br />       (setq w1 (nth j wlst) w2 (+ w2 w1))<br />       (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点<br />       (emkText P1 f zg)<br />       (setq j (1+ j))<br />                 )<br />     (setq i (1+ i) j 0 w1 0 w2 0)<br />         )<br />   ; 开始绘制竖线<br />   (setq tab_h (* len1 h))                  ; 竖线长<br />   (emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线<br />   (setq len 0)<br />   (foreach x wlst                          ; 绘制竖线<br />     (setq len (+ x len) p1 (polar pt 0 len))<br />     (emkLine p1 (polar p1 (* Pi 1.5) tab_h))<br />         )<br />   ; 开始绘制横线<br />   (setq i 0 len 0)<br />   (setq len (apply '+ wlst))              ; 横线长度<br />   (repeat (1+ len1)                       ; 绘制横线<br />     (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))<br />     (emkLine p1 (polar p1 0 len))<br />         )<br />   (princ)<br /> )

advksf

xj6019 发表于 2022-3-29 12:32
是这样吗

可能是我电脑的问题，换了就好了~
如果要过考虑 中文是否可以实现
好像 一个中文 是2个字符？这个不好定义了吧

htlaser

advksf 发表于 2022-3-29 18:02
可能是我电脑的问题，换了就好了~
如果要过考虑 中文是否可以实现
好像 一个中文 是2个字符？这个不好 ...

不行就做两个命令   最简单的办法!

xj6019

那就只能是多定义一个命令  或者继续搜找相似率更高的条件 ，楼上说了，多定个命令最简单的，方法相同