[LISP程序]：哪位大虾能够帮我看看这个程序哪里出现问题啊。

hbhu

*-*6

AyungerStudio

本论坛下AyungerStudio作者的附件中就有该程序啊。

hbhu

我没见到过，，这个是自已做的。就是不知哪里出现问题啦，，请指教一下。。

xyp1964

2. [FONT=courier new](defun c:test ()
   
3.   (setvar "cmdecho" 0)
   
4.   (setq os (getvar "osmode"))
   
5.   (setvar "osmode" 0)
   
6.   (setq pt1 (getpoint "\n左上角:"))
   
7.   (setq ww (getdist pt1 "\n宽度<50>:"))
   
8.   (if (null ww)
   
9.     (setq ww 50.0)
   
10.   )
    
11.   (setq hh (getdist pt1 "\n每格高度<8>:"))
    
12.   (if (null hh)
    
13.     (setq hh 8.0)
    
14.   )
    
15.   (setq        pt2 (polar pt1 0 ww)
    
16.         pt3 (polar pt2 (* pi 1.5) hh)
    
17.         pt4 (polar pt1 (* pi 1.5) hh)        ;原句有错
    
18.   )
    
19.   (command "PLINE" pt1 pt2 pt3 pt4 "c")
    
20.   (setq        pt5 (polar pt1 0 (/ ww 2))
    
21.         pt6 (polar pt5 (* pi 1.5) hh)
    
22.   )
    
23.   (command ".LINE" pt5 pt6 "")
    
24.   (command "TEXT"
    
25.            "m"
    
26.            (inters pt1 pt6 pt4 pt5 nil)
    
27.            (/ hh 2)
    
28.            0
    
29.            "图块名称"
    
30.   )
    
31.   (command ".TEXT"
    
32.            "m"
    
33.            (inters pt5 pt3 pt2 pt6)
    
34.            (/ hh 2)
    
35.            0
    
36.            "数量"
    
37.   )
    
38.   (setq blk (tblnext "block" t))
    
39.   (while blk
    
40.     (setq blkn          (assoc 2 blk)
    
41.           blk_key (substr (cdr blkn) 1 1)
    
42.     )
    
43.     (if        (/= blk_key "*")
    
44.       (progn
    
45.         (setq ss (ssget "x" (list blkn)))
    
46.         (if (null ss)
    
47.           (setq ssn 0)
    
48.           (setq ssn (sslength ss))
    
49.         )
    
50.         (setq blknn (cdr blkn))
    
51.         (setq pt1 pt4
    
52.               pt5 pt6                        ;原句有错
    
53.               pt2 pt3
    
54.         )
    
55.         (setq pt4 (polar pt1 (* pi 1.5) hh))
    
56.         (setq pt6 (polar pt5 (* pi 1.5) hh))
    
57.         (setq pt3 (polar pt2 (* pi 1.5) hh))
    
58.         (command ".PLINE" pt2 pt3 pt4 pt1 "")
    
59.         (command ".LINE" pt5 pt6 "")
    
60.         (command ".TEXT"
    
61.                  "m"
    
62.                  (inters pt1 pt6 pt4 pt5)
    
63.                  (/ hh 2)
    
64.                  0
    
65.                  blknn
    
66.         )
    
67.         (command ".TEXT"
    
68.                  "m"
    
69.                  (inters pt5 pt3 pt2 pt6)
    
70.                  (/ hh 2)
    
71.                  0
    
72.                  (itoa ssn)
    
73.         )
    
74.       )
    
75.     )
    
76.     (setq blk (tblnext "BLOCK"))
    
77.   )
    
78.   (setvar "osmode" os)
    
79.   (princ)
    
80. )[/FONT]

[FONT=courier new](defun c:test ()<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq pt1 (getpoint "\n左上角:"))<br />   (setq ww (getdist pt1 "\n宽度<50>:"))<br />   (if (null ww)<br />     (setq ww 50.0)<br />   )<br />   (setq hh (getdist pt1 "\n每格高度<8>:"))<br />   (if (null hh)<br />     (setq hh 8.0)<br />   )<br />   (setq        pt2 (polar pt1 0 ww)<br />         pt3 (polar pt2 (* pi 1.5) hh)<br />         pt4 (polar pt1 (* pi 1.5) hh)        ;原句有错<br />   )<br />   (command "PLINE" pt1 pt2 pt3 pt4 "c")<br />   (setq        pt5 (polar pt1 0 (/ ww 2))<br />         pt6 (polar pt5 (* pi 1.5) hh)<br />   )<br />   (command ".LINE" pt5 pt6 "")<br />   (command "TEXT"<br />            "m"<br />            (inters pt1 pt6 pt4 pt5 nil)<br />            (/ hh 2)<br />            0<br />            "图块名称"<br />   )<br />   (command ".TEXT"<br />            "m"<br />            (inters pt5 pt3 pt2 pt6)<br />            (/ hh 2)<br />            0<br />            "数量"<br />   )<br />   (setq blk (tblnext "block" t))<br />   (while blk<br />     (setq blkn          (assoc 2 blk)<br />           blk_key (substr (cdr blkn) 1 1)<br />     )<br />     (if        (/= blk_key "*")<br />       (progn<br />         (setq ss (ssget "x" (list blkn)))<br />         (if (null ss)<br />           (setq ssn 0)<br />           (setq ssn (sslength ss))<br />         )<br />         (setq blknn (cdr blkn))<br />         (setq pt1 pt4<br />               pt5 pt6                        ;原句有错<br />               pt2 pt3<br />         )<br />         (setq pt4 (polar pt1 (* pi 1.5) hh))<br />         (setq pt6 (polar pt5 (* pi 1.5) hh))<br />         (setq pt3 (polar pt2 (* pi 1.5) hh))<br />         (command ".PLINE" pt2 pt3 pt4 pt1 "")<br />         (command ".LINE" pt5 pt6 "")<br />         (command ".TEXT"<br />                  "m"<br />                  (inters pt1 pt6 pt4 pt5)<br />                  (/ hh 2)<br />                  0<br />                  blknn<br />         )<br />         (command ".TEXT"<br />                  "m"<br />                  (inters pt5 pt3 pt2 pt6)<br />                  (/ hh 2)<br />                  0<br />                  (itoa ssn)<br />         )<br />       )<br />     )<br />     (setq blk (tblnext "BLOCK"))<br />   )<br />   (setvar "osmode" os)<br />   (princ)<br /> )[/FONT]

hbhu

哈哈,,!!谢谢....