统计块数量并绘制表格

13826031454

(defun c:lsp_50()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq pt1 (getpoint "\n左上角: "))
(setq ww (getdist pt1 "\n宽度 <50>: "))
(if (null ww) (setq ww 40.0))
(setq hh (getdist pt1 "\n每格高度 <8>: "))
(if (null hh) (setq hh 8.0))
(setq pt2 (polar pt1 0 ww))
(setq pt3 (polar pt2 (* pi 1.5) hh))
(setq pt4 (polar pt1 (* pi 1.5) hh))
(command "pline" pt1 pt2 pt3 pt4 "c")
(setq pt5 (polar pt1 0 (/ ww 2)))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(command "line" pt5 pt6 "")
(command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "块名称")
(command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 "数量")
(setq blk (tblnext "block" t))
(while blk
(setq blkn (assoc 2 blk))
(setq blk_key (substr (cdr blkn) 1 1))
(if (/= blk_key "*")
(progn
(setq ss (ssget "X" (list blkn)))
(if (null ss)
(setq ssn 0)
(setq ssn (sslength ss))              
)
(setq blknn (cdr blkn))
(setq pt1 pt4 pt5 pt6 pt2 pt3)
(setq pt4 (polar pt1 (* pi 1.5) hh))
(setq pt6 (polar pt5 (* pi 1.5) hh))
(setq pt3 (polar pt2 (* pi 1.5) hh))
(command "pline" pt2 pt3 pt4 pt1 "")
(command "line" pt5 pt6 "")
(command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 blknn)
(command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 (itoa ssn))
)
)
(setq blk (tblnext "block"))
)
(setvar "osmode" os)
(prin1)
)  

77077

送佛送到西，贴上用到的函数

2. ;利用表格型list制作CAD表格 By77077
   
3. ;参数:
   
4. ;lis --- 表格型list
   
5. ;pt --- 表格左上角(点)
   
6. ;zg ---- 字高(数值型)
   
7. ;测试(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)
   
8. (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)
   
9.   (defun emkLine (p1 p2)
   
10.     (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))
    
11.     )
    
12.   (defun emkText (pt str h)
    
13.     (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)))
    
14.     )
    
15.   (setq h (* zg 2)                             ; 表格高
    
16.               len1 (length lis)                      ; 表格行数len1
    
17.               len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2
    
18.               p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点
    
19.               )
    
20.   (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型
    
21.   ; 以下获取列宽表 wlst
    
22.   (setq i 0 w2 0 wlst '())
    
23.   (repeat len2
    
24.     (foreach e lis
    
25.       (setq txt (nth i e))
    
26.       (if (not txt) (setq txt ""))         ;如果没有字符
    
27.       (setq w1 (* (+ (strlen txt) 1) zg))  ; 列宽=(文字长度+1)*zg
    
28.       (if (> w1 w2) (setq w2 w1))          ;取最大列宽
    
29.       )
    
30.     (setq wlst (cons w2 wlst) w2 0 i (1+ i))
    
31.     )
    
32.   ;以下按行写出文字
    
33.   (setq wlst (reverse wlst))
    
34.   (setq i 0 j 0 w1 0 w2 0)
    
35.   (foreach e lis
    
36.     (setq h1 (- (cadr p0) (* i h)))        ; 文字行的y坐标值
    
37.     (foreach f e
    
38.       (setq w1 (nth j wlst) w2 (+ w2 w1))
    
39.       (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点
    
40.       (emkText P1 f zg)
    
41.       (setq j (1+ j))
    
42.       )
    
43.     (setq i (1+ i) j 0 w1 0 w2 0)
    
44.     )
    
45.   ; 开始绘制竖线
    
46.   (setq tab_h (* len1 h))                  ; 竖线长
    
47.   (emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线
    
48.   (setq len 0)
    
49.   (foreach x wlst                          ; 绘制竖线
    
50.     (setq len (+ x len) p1 (polar pt 0 len))
    
51.     (emkLine p1 (polar p1 (* Pi 1.5) tab_h))
    
52.     )
    
53.   ; 开始绘制横线
    
54.   (setq i 0 len 0)
    
55.   (setq len (apply '+ wlst))              ; 横线长度
    
56.   (repeat (1+ len1)                       ; 绘制横线
    
57.     (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))
    
58.     (emkLine p1 (polar p1 0 len))
    
59.     )
    
60.   (princ)
    
61.   )

;利用表格型list制作CAD表格 By77077<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 />   )

qazxswk

77077 发表于 2015-4-22 23:49
送佛送到西，贴上用到的函数

感觉TableLst2Table函数，控制列表的宽度很难操作，内容最宽的，列表宽度反而最小。怎么样修改一下，方便控制列表的宽度？

583775698

blklst2tab  把这个函数法出来啊   大家学习一下

434939575

这个挺好的，请问同名块是哪里加上去的，没看明白！

77077

伪源码

2. 
   
3. (defun c:tt( / os lst blk blkn zg pt x)
   
4.   (setvar "cmdecho" 0)
   
5.   (setq os (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setq lst (list '("图例" "块名" "数量"))
   
8.         blk (tblnext "block" t)
   
9.         )
   
10.   (while blk
    
11.     (setq blkn (cdr(assoc 2 blk))
    
12.           ss (ssget "X" (list '(0 . "INSERT")(cons 2 blkn)))
    
13.           x (list blkn (sslength ss))
    
14.           lst (cons x lst))
    
15.     (setq blk (tblnext "block"))
    
16.     )
    
17.   (setq zg(getreal "\n字高: ")
    
18.         pt(getpoint "\n左上角: ")
    
19.         )
    
20.   (blklst2tab (reverse lst) pt zg)
    
21.   (setvar "osmode" os)
    
22.   (prin1)
    
23.   )
    

<br /> (defun c:tt( / os lst blk blkn zg pt x)<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq lst (list '("图例" "块名" "数量"))<br />         blk (tblnext "block" t)<br />         )<br />   (while blk<br />     (setq blkn (cdr(assoc 2 blk))<br />           ss (ssget "X" (list '(0 . "INSERT")(cons 2 blkn)))<br />           x (list blkn (sslength ss))<br />           lst (cons x lst))<br />     (setq blk (tblnext "block"))<br />     )<br />   (setq zg(getreal "\n字高: ")<br />         pt(getpoint "\n左上角: ")<br />         )<br />   (blklst2tab (reverse lst) pt zg)<br />   (setvar "osmode" os)<br />   (prin1)<br />   )<br />

yoyoho

感谢 77077  分享程序源码!

ZZWQ2002

学习学习 谢谢分享

皇上快溜

你好，可以帮我做个类似的程序吗？
人工输入长宽尺寸
程序逐行往下提出用户跟据板材名称选择厚度值
板A   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板b   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板c   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
.........总计十几行完成
程序提示用户第二次人工输入长宽尺寸
程序逐行往下提出用户跟据板材名称选择厚度值
板A1   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板b2   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板c3   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
.........总计十几行完成
程序提示用户第三次人工输入长宽尺寸
。。。。。。
。。。。。。
最后结束，程序制表并根据上面的输入自动填表，表的形成如下
板A      长宽高尺寸    备注一     备注二
板A1    长宽高尺寸     备注一     备注二
板b      长宽高尺寸    备注一     备注二
板b1    长宽高尺寸     备注一     备注二
板c      长宽高尺寸    备注一     备注二
板c1    长宽高尺寸     备注一     备注二

皇上快溜

77077 发表于 2015-4-22 23:06
伪源码

你好，可以帮我做个类似的程序吗？
人工输入长宽尺寸
程序逐行往下提出用户跟据板材名称选择厚度值
板A   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板b   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板c   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
.........总计十几行完成
程序提示用户第二次人工输入长宽尺寸
程序逐行往下提出用户跟据板材名称选择厚度值
板A1   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板b2   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
板c3   (人工输入选项确认厚度值：1：15mm  2:20mm  3:25mm  4:30mm)
.........总计十几行完成
程序提示用户第三次人工输入长宽尺寸
。。。。。。
。。。。。。
最后结束，程序制表并根据上面的输入自动填表，表的形成如下
板A      长宽高尺寸    备注一     备注二
板A1    长宽高尺寸     备注一     备注二
板b      长宽高尺寸    备注一     备注二
板b1    长宽高尺寸     备注一     备注二
板c      长宽高尺寸    备注一     备注二
板c1    长宽高尺寸     备注一     备注二

lxdz443

77077 发表于 2015-4-22 23:06
伪源码

可以把blklst2tab这个函数发出来吗？