求大神做个程序根据lisp表绘制cad表格

linshiyin2

根据这个表，在cad里直接绘制一个表格每个格子放置这个表的对应位置的内容

表的格式为如下，可以是字符串或者数字
(1.0 0.0 0.0)
(1.0 0.0 0.0)
(1.0 0.0 0.0)
绘制成表格

wdjy808

大神可以改下：如excel般编辑吗，自定义要多少行列

newbuser

大哥，你有没有看过群共享？里面有很多宝贝哦。
那个刚传上去还剩三天的Excel2CAD.lsp就是你说的程序啊
赶紧抢下吧，晚了就没了。

linshiyin2

2. (defun c:tt (/ B H I J LIS M MM N P0 P1 P2 PT ZG)
   
3.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
4.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
5.   (setq lis (cons '(1.0 0.0 0.0 1) lis))
   
6.   (setq zg 1;字高
   
7.         b 2 ;表格宽度
   
8.         h 3);表格高
   
9.   (setq n (length lis));表格行数n
   
10.   (foreach e lis
    
11.     (setq mm (length e))
    
12.     (if (> mm m) (setq m mm)));表格列数m
    
13.   (setq pt (getpoint "选取表格左上角位置："))
    
14.   (setq i 0)
    
15.   (repeat (1+ m);绘制竖线
    
16.     (setq p1 (polar pt (*  0.0 Pi) (* i b))
    
17.           p2 (polar p1 (* -0.5 Pi) (* n h))
    
18.           i (1+ i))
    
19.    
    
20.     (command "pline" p1 p2 "")
    
21.     )
    
22.   (setq i 0)
    
23.   (repeat (1+ n) ;绘制横线
    
24.     (setq p1 (polar pt (* -0.5 Pi) (* i h))
    
25.           p2 (polar p1 (*  0.0 Pi) (* m b))
    
26.           i (1+ i))
    
27.    
    
28.     (command "pline" p1 p2 "")
    
29.     )
    
30.   (setq i 0
    
31.         j 0
    
32.         p0 (list (+ (car pt) (* 0.5 b)) (- (cadr pt) (* 0.7 h))));定义文字原点
    
33.   (foreach e lis  ;填入表内容
    
34.     (foreach f e
    
35.       (setq p1 (list (+ (car p0) (* j b)) (- (cadr p0) (* i h)))
    
36.             j (1+ j))
    
37.       (command "text" p1 zg 0 (rtos f 2 2))
    
38.       )
    
39.     (setq i (1+ i)
    
40.           j 0)
    
41.    )
    
42.   )

(defun c:tt (/ B H I J LIS M MM N P0 P1 P2 PT ZG)<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0 1) lis))<br />   (setq zg 1;字高<br />         b 2 ;表格宽度<br />         h 3);表格高<br />   (setq n (length lis));表格行数n<br />   (foreach e lis<br />     (setq mm (length e))<br />     (if (> mm m) (setq m mm)));表格列数m<br />   (setq pt (getpoint "选取表格左上角位置："))<br />   (setq i 0)<br />   (repeat (1+ m);绘制竖线<br />     (setq p1 (polar pt (*  0.0 Pi) (* i b))<br />           p2 (polar p1 (* -0.5 Pi) (* n h))<br />           i (1+ i))<br />     <br />     (command "pline" p1 p2 "")<br />     )<br />   (setq i 0)<br />   (repeat (1+ n) ;绘制横线<br />     (setq p1 (polar pt (* -0.5 Pi) (* i h))<br />           p2 (polar p1 (*  0.0 Pi) (* m b))<br />           i (1+ i))<br />     <br />     (command "pline" p1 p2 "")<br />     )<br />   (setq i 0<br />         j 0<br />         p0 (list (+ (car pt) (* 0.5 b)) (- (cadr pt) (* 0.7 h))));定义文字原点<br />   (foreach e lis  ;填入表内容<br />     (foreach f e<br />       (setq p1 (list (+ (car p0) (* j b)) (- (cadr p0) (* i h)))<br />             j (1+ j))<br />       (command "text" p1 zg 0 (rtos f 2 2))<br />       )<br />     (setq i (1+ i)<br />           j 0)<br />    )<br />   )

自己写的，没有判断每个格子内容长短

ZZXXQQ

2. ;先写内容再画表，自适应文字宽度 明经 ZZXXQQ 2013.8.30
   
3. (defun c:tt (/ B H I J LIS M MM N P0 P1 P2 PT ZG)
   
4.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
5.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
6.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
7.   (setq zg 1;字高
   
8.         h 3);表格高
   
9.   (setq n (length lis) m 1);表格行数n
   
10.   (foreach e lis
    
11.     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m
    
12.   (setq pt (getpoint "选取表格左上角位置："))
    
13.   (setq i 0 tabl 0 ;表长
    
14.         j 0 tabbl (list)
    
15.         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点
    
16.   (foreach e lis  ;填入表内容
    
17.    (setq tabll (list)) ;行长
    
18.    (setq tabb (list))
    
19.    (foreach f e
    
20.     (setq txtf (rtos f 2 2)
    
21.           txtl (strlen txtf)
    
22.           tabb (cons txtl tabb)
    
23.           tabll (+ tabl txtl 2))
    
24.     (setq p1 (list (+ (car p0) tabll (/ txtl 2) -1) (- (cadr p0) (* i h))))
    
25.     (command "text" "C" p1 zg 0 txtf)
    
26.    )
    
27.    (if (> tabll tabl) (setq tabl tabll tabbl tabb))
    
28.    (setq i (1+ i))
    
29.   )
    
30.   (command ".line" p1 (polar p1(/ pi 2) (* n h)) "")
    
31.   (foreach x tabbl ;绘制竖线
    
32.     (setq p1 (polar pt 0 (+ x 2)))
    
33.     (command ".line" p1 (polar p1 (/ Pi 2) (* n h)) "")
    
34.   )
    
35.   (setq i 0)
    
36.   (repeat (1+ n) ;绘制横线
    
37.     (setq p1 (polar pt (/ Pi 2) (* i h))
    
38.           i (1+ i))
    
39.     (command "pline" p1 (polar p1 0 tabl) "")
    
40.   )
    
41.   (princ)
    
42. )
    

;先写内容再画表，自适应文字宽度 明经 ZZXXQQ 2013.8.30<br /> (defun c:tt (/ B H I J LIS M MM N P0 P1 P2 PT ZG)<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq zg 1;字高<br />         h 3);表格高<br />   (setq n (length lis) m 1);表格行数n<br />   (foreach e lis<br />     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m<br />   (setq pt (getpoint "选取表格左上角位置："))<br />   (setq i 0 tabl 0 ;表长<br />         j 0 tabbl (list)<br />         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点<br />   (foreach e lis  ;填入表内容<br />    (setq tabll (list)) ;行长<br />    (setq tabb (list))<br />    (foreach f e<br />     (setq txtf (rtos f 2 2)<br />           txtl (strlen txtf)<br />           tabb (cons txtl tabb)<br />           tabll (+ tabl txtl 2))<br />     (setq p1 (list (+ (car p0) tabll (/ txtl 2) -1) (- (cadr p0) (* i h))))<br />     (command "text" "C" p1 zg 0 txtf)<br />    )<br />    (if (> tabll tabl) (setq tabl tabll tabbl tabb))<br />    (setq i (1+ i))<br />   )<br />   (command ".line" p1 (polar p1(/ pi 2) (* n h)) "")<br />   (foreach x tabbl ;绘制竖线<br />     (setq p1 (polar pt 0 (+ x 2)))<br />     (command ".line" p1 (polar p1 (/ Pi 2) (* n h)) "")<br />   )<br />   (setq i 0)<br />   (repeat (1+ n) ;绘制横线<br />     (setq p1 (polar pt (/ Pi 2) (* i h))<br />           i (1+ i))<br />     (command "pline" p1 (polar p1 0 tabl) "")<br />   )<br />   (princ)<br /> )<br />

linshiyin2

2. ;先写内容再画表，自适应文字宽度 明经 ZZXXQQ 2013.8.30
   
3. (defun c:tt1 (/ B H I J LIS M MM N P0 P1 P2 PT ZG)
   
4.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
5.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
6.   (setq lis (cons '(1.0 0.0 0.0 "ff") lis))
   
7.   (setq zg 1;字高
   
8.         h 3);表格高
   
9.   (setq n (length lis) m 1);表格行数n
   
10.   (foreach e lis
    
11.     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m
    
12.   (setq pt (getpoint "选取表格左上角位置："))
    
13.   (setq i 0 tabl 0 ;表长
    
14.         j 0 tabbl (list);表宽列表
    
15.         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点
    
16.   (foreach e lis  ;填入表内容
    
17.    (setq tabll 0) ;行长
    
18.    (setq tabb (list))
    
19.    (foreach f e
    
20.      (if (/= (type f) 'STR) (setq txtf (rtos f 2 2)) (setq txtf f));判断f是否是字符串
    
21.     (setq txtl (strlen txtf)
    
22.           tabb (cons txtl tabb)
    
23.           tabll (+ tabll txtl 2))
    
24.     (setq p1 (list (+ (car p0) tabll (/ txtl 2) -1) (- (cadr p0) (* i h))))
    
25.     (command "text" "C" p1 zg 0 txtf)
    
26.    )
    
27.    (if (> tabll tabl) (setq tabl tabll tabbl tabb))
    
28.    (setq i (1+ i))
    
29.   )
    
30.   (command ".line" pt (polar pt (/ pi -2) (* n h)) "")
    
31.   (setq len 0)
    
32.   (foreach x tabbl ;绘制竖线
    
33.     (setq len (+ x len 2))
    
34.     (setq p1 (polar pt 0 len))
    
35.     (command ".line" p1 (polar p1 (/ Pi -2) (* n h)) "")
    
36.   )
    
37.   (setq i 0)
    
38.   (repeat (1+ n) ;绘制横线
    
39.     (setq p1 (polar pt (/ Pi -2) (* i h)) i (1+ i))
    
40.     (command "pline" p1 (polar p1 0 tabl) "")
    
41.   )
    
42.   (princ)
    
43. )

;先写内容再画表，自适应文字宽度 明经 ZZXXQQ 2013.8.30<br /> (defun c:tt1 (/ B H I J LIS M MM N P0 P1 P2 PT ZG)<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(1.0 0.0 0.0 "ff") lis))<br />   (setq zg 1;字高<br />         h 3);表格高<br />   (setq n (length lis) m 1);表格行数n<br />   (foreach e lis<br />     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m<br />   (setq pt (getpoint "选取表格左上角位置："))<br />   (setq i 0 tabl 0 ;表长<br />         j 0 tabbl (list);表宽列表<br />         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点<br />   (foreach e lis  ;填入表内容<br />    (setq tabll 0) ;行长<br />    (setq tabb (list))<br />    (foreach f e<br />      (if (/= (type f) 'STR) (setq txtf (rtos f 2 2)) (setq txtf f));判断f是否是字符串<br />     (setq txtl (strlen txtf)<br />           tabb (cons txtl tabb)<br />           tabll (+ tabll txtl 2))<br />     (setq p1 (list (+ (car p0) tabll (/ txtl 2) -1) (- (cadr p0) (* i h))))<br />     (command "text" "C" p1 zg 0 txtf)<br />    )<br />    (if (> tabll tabl) (setq tabl tabll tabbl tabb))<br />    (setq i (1+ i))<br />   )<br />   (command ".line" pt (polar pt (/ pi -2) (* n h)) "")<br />   (setq len 0)<br />   (foreach x tabbl ;绘制竖线<br />     (setq len (+ x len 2))<br />     (setq p1 (polar pt 0 len))<br />     (command ".line" p1 (polar p1 (/ Pi -2) (* n h)) "")<br />   )<br />   (setq i 0)<br />   (repeat (1+ n) ;绘制横线<br />     (setq p1 (polar pt (/ Pi -2) (* i h)) i (1+ i))<br />     (command "pline" p1 (polar p1 0 tabl) "")<br />   )<br />   (princ)<br /> )

增加了判断字符格式，修改了zzxxqq的错误部分

linshiyin2

ZZXXQQ 发表于 2013-8-30 08:19

还不完善，需改进，先写表格内容部分文字的位置需要调整，调整最好根据开头定义的字体高度自动的来调整。

linshiyin2

2. ;将表打印出来 2013年9月2日
   
3. (defun c:tt1 (/ H I J LEN LIS LIS1 LIS2 M MM N P0 P1 PT TAB TABBL TABL TXT ZG)
   
4.   (setq lis (cons '(1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890) lis))
   
5.   (setq lis (cons '(1.0 0.0 0.0) lis))
   
6.   (setq lis (cons '(100.0 12345.0 "5551000" "1234") lis))
   
7.   (setq zg 1;字高
   
8.         h 3);表格高
   
9.   (setq n (length lis) m 1);表格行数n
   
10.   (foreach e lis
    
11.     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m
    
12.   (setq pt (getpoint "选取表格左上角位置："))
    
13.   (setq i    0
    
14.         tabl 0 ;表长
    
15.         j    0
    
16.         tabbl (list);表宽表
    
17.         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点
    
18.   ;将表中的数字全部变为字符串
    
19.   (setq lis1 (list)
    
20.         lis2 (list))
    
21.   (foreach e lis
    
22.     (foreach f e
    
23.       (if (and (/= (type f) 'STR) f) (setq f (rtos f 2 2)))
    
24.       (setq lis1 (cons f lis1))      )
    
25.     (setq lis2 (cons (reverse lis1) lis2)
    
26.           lis1 nil)    )
    
27.   (setq lis (reverse lis2))
    
28. 
    
29.   ;以下获取列宽表 tabbl
    
30.   (setq i 0)
    
31.   (repeat m
    
32.     (foreach e lis
    
33.       (setq txt (nth i e))
    
34.       (if (and (/= (type txt) 'STR) txt) (setq txt (rtos txt 2 2)))
    
35.       (if (not txt) (setq txt ""))
    
36.       (setq tab (strlen txt))
    
37.       (if (> tab tabl) (setq tabl tab)) ;找到此列最长的长度
    
38.       )
    
39.     (setq tabbl (cons tabl tabbl))
    
40.     (setq tabl 0)
    
41.     (setq i (1+ i))
    
42.     )
    
43.   (setq tabbl (reverse tabbl))
    
44.    ;填入表内容
    
45.   (setq i 0
    
46.         j 0
    
47.         tab 0
    
48.         tabl 0)
    
49.   (foreach e lis
    
50.     (foreach f e
    
51.       (setq tab (nth j tabbl)
    
52.             tabl (+ tabl tab 1))
    
53.       (setq p1 (list (- (+ (car p0) tabl) (* tab 0.5)) (- (cadr p0) (* i h))))
    
54.       (command "text" "C" p1 zg 0 f)
    
55.       (setq tabl (+ tabl 1))
    
56.       (setq j (1+ j))
    
57.      )
    
58.     (setq i (1+ i) j 0 tab 0 tabl 0)
    
59.     )
    
60. ;一下绘制竖线
    
61.   (command ".line" pt (polar pt (/ pi -2) (* n h)) "")
    
62.   (setq len 0)
    
63.   (foreach x tabbl ;绘制竖线
    
64.     (setq len (+ x len 2))
    
65.     (setq p1 (polar pt 0 len))
    
66.     (command ".line" p1 (polar p1 (/ Pi -2) (* n h)) "")  )
    
67.   (setq i 0        len 0)
    
68.   (foreach e tabbl
    
69.     (setq len (+ len e 2)));横线长度
    
70.   (repeat (1+ n) ;绘制横线
    
71.     (setq p1 (polar pt (* Pi -0.5) (* i h)) i (1+ i))
    
72.     (command "pline" p1 (polar p1 0 len) "")  )
    
73.   (princ)
    
74. )

;将表打印出来 2013年9月2日<br /> (defun c:tt1 (/ H I J LEN LIS LIS1 LIS2 M MM N P0 P1 PT TAB TABBL TABL TXT ZG)<br />   (setq lis (cons '(1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890) lis))<br />   (setq lis (cons '(1.0 0.0 0.0) lis))<br />   (setq lis (cons '(100.0 12345.0 "5551000" "1234") lis))<br />   (setq zg 1;字高<br />         h 3);表格高<br />   (setq n (length lis) m 1);表格行数n<br />   (foreach e lis<br />     (if (> (setq mm (length e)) m) (setq m mm)));表格列数m<br />   (setq pt (getpoint "选取表格左上角位置："))<br />   (setq i    0<br />         tabl 0 ;表长<br />         j    0<br />         tabbl (list);表宽表<br />         p0 (list (car pt) (- (cadr pt) (* 0.7 h))));定义文字原点<br />   ;将表中的数字全部变为字符串<br />   (setq lis1 (list)<br />         lis2 (list))<br />   (foreach e lis<br />     (foreach f e<br />       (if (and (/= (type f) 'STR) f) (setq f (rtos f 2 2)))<br />       (setq lis1 (cons f lis1))      )<br />     (setq lis2 (cons (reverse lis1) lis2)<br />           lis1 nil)    )<br />   (setq lis (reverse lis2))<br /> <br />   ;以下获取列宽表 tabbl<br />   (setq i 0)<br />   (repeat m<br />     (foreach e lis<br />       (setq txt (nth i e))<br />       (if (and (/= (type txt) 'STR) txt) (setq txt (rtos txt 2 2)))<br />       (if (not txt) (setq txt ""))<br />       (setq tab (strlen txt))<br />       (if (> tab tabl) (setq tabl tab)) ;找到此列最长的长度<br />       )<br />     (setq tabbl (cons tabl tabbl))<br />     (setq tabl 0)<br />     (setq i (1+ i))<br />     )<br />   (setq tabbl (reverse tabbl))<br />    ;填入表内容<br />   (setq i 0<br />         j 0<br />         tab 0<br />         tabl 0)<br />   (foreach e lis <br />     (foreach f e<br />       (setq tab (nth j tabbl)<br />             tabl (+ tabl tab 1))<br />       (setq p1 (list (- (+ (car p0) tabl) (* tab 0.5)) (- (cadr p0) (* i h))))<br />       (command "text" "C" p1 zg 0 f)<br />       (setq tabl (+ tabl 1))<br />       (setq j (1+ j))<br />      )<br />     (setq i (1+ i) j 0 tab 0 tabl 0)<br />     )<br /> ;一下绘制竖线<br />   (command ".line" pt (polar pt (/ pi -2) (* n h)) "")<br />   (setq len 0)<br />   (foreach x tabbl ;绘制竖线<br />     (setq len (+ x len 2))<br />     (setq p1 (polar pt 0 len))<br />     (command ".line" p1 (polar p1 (/ Pi -2) (* n h)) "")  )<br />   (setq i 0        len 0)<br />   (foreach e tabbl<br />     (setq len (+ len e 2)));横线长度<br />   (repeat (1+ n) ;绘制横线<br />     (setq p1 (polar pt (* Pi -0.5) (* i h)) i (1+ i))<br />     (command "pline" p1 (polar p1 0 len) "")  )<br />   (princ)<br /> )

461045462

linshiyin2 发表于 2013-9-2 03:27

谢谢分享
先收集下来，等会看看，学习学习。
谢谢

77077

linshiyin2 发表于 2013-9-2 03:27

不错不错很实用~可以修改下弄成lst2tab函数了!
有一点小瑕疵
(setq zg 1 h zg 3)==> (setq zg 1 h (* zg 2))
(setq tab (strlen txt))==>(setq tab (* (strlen txt) zg))

树櫴希德

看看好不好用