[源码]简单序号累加

004

1.           ;wkq004  20140331
   
2. (PRINC "序号球004，启动命令：xh")
   
3. (defun c:xh (/ ss)
   
4.   
   
5.   (setvar "cmdecho" 0)
   
6. (if (setq layerE (tblobjname "layer" "004序号"))
   
7.   (progn
   
8.     (setq layerEL (entget layerE))
   
9.     (setq ass62 (assoc 62 layerEL))
   
10.     (if  (/= 4 (cdr ass62))
    
11.       (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
    
12.        (entmod layerEL)
    
13.       )
    
14.     )
    
15.   )
    
16.   (entmake (list '(0 . "LAYER")
    
17.      '(100 . "AcDbSymbolTableRecord")
    
18.      '(100 . "AcDbLayerTableRecord")
    
19.      '(70 . 0)
    
20.      '(6 . "Continuous")
    
21.      '(62 . 4)
    
22.      (cons 2 "004序号")
    
23.      )
    
24.   )
    
25. )
    
26.   (defun *error* (msg)
    
27.     (princ "\n取消!")
    
28.     (command "_.erase" SS "")
    
29.     (command ".undo" "end")
    
30.     (setq *error* nil)
    
31.   )
    
32. 
    
33.   (defun fun-xh004 ()
    
34.     (if  (null xh004)
    
35.       (progn (setq xh004 "1")
    
36.        (setq xh004 (itoa (getint "\n请输入起始序号[]<1>：")))
    
37.       )
    
38.     )
    
39.   )
    
40. 
    
41.   (defun rr004 ()
    
42.     (if  (null r004)
    
43.       (progn
    
44.   (command ".circle"
    
45.      (getpoint "\n点取设置序号球半径的大小><:")
    
46.      pause
    
47.   )
    
48.   (setq r004 (getvar "CIRCLERAD"))
    
49.   (entdel (entlast))
    
50.       )
    
51.     )
    
52.   )
    
53.   (fun-xh004)
    
54.   (rr004)
    
55.   (defun msg ()
    
56.     (princ
    
57.       "\n点击放置序号球[右键退出/S设置序号/R设置序号球半径]<左键放置>："
    
58.     )
    
59.   )
    
60.   (msg)
    
61.   (defun main ()
    
62.     (command ".undo" "begin")
    
63.     (setq ss (ssadd))
    
64.     (setq TEST t)
    
65.     (setq a nil)
    
66.     (while TEST
    
67.       (setq TMP (grread t 7 1))
    
68.       (cond
    
69.   ((= (car TMP) 3) ;_左键
    
70.    (setq xh004 (itoa (1+ (atoi xh004))))
    
71.    (setq TEST NIL)
    
72.    (setq a T)
    
73.    
    
74.   )
    
75.   ((= (car TMP) 25) ;_右键
    
76.    (command "_.erase" SS "")
    
77.    (setq TEST NIL)
    
78.   )
    
79.   ((= (car TMP) 5) ;_移动
    
80.    (setq PT (cadr TMP))
    
81.    (command "_.erase" SS "")
    
82.    (entmake
    
83.      (list '(0 . "TEXT")
    
84.      '(8 . "004序号")
    
85.      '(62 . 256)
    
86.      '(7 . "fs")
    
87.      (cons 1 xh004)
    
88.      (cons 10 pt)
    
89.      (cons 40 r004)
    
90. 
    
91.      )
    
92.    )
    
93.    (ssadd (entlast) ss)
    
94.   )
    
95.   ((and (OR (equal (cadr TMP) 114) (equal (cadr TMP) 82))
    
96.         (equal (car TMP) 2)
    
97.    ) ;_序号球半径
    
98. 
    
99.    (progn
    
100.      (command ".circle"
     
101.         (getpoint "\n点取设置序号球半径的大小><:")
     
102.         pause
     
103.      )
     
104.      (setq r004 (getvar "CIRCLERAD"))
     
105.      (princ r004)
     
106.      (msg)
     
107.      (entdel (entlast))
     
108. 
     
109.      (setq TEST NIL)
     
110.      (setq a T)
     
111.    )
     
112.   )
     
113.   ((and (OR (equal (cadr TMP) 83) (equal (cadr TMP) 115))
     
114.         (equal (car TMP) 2)
     
115.    ) ;_设置序号
     
116.    (command "_.erase" SS "")
     
117.    (setq xh004 (itoa (getint "\n请输入序号：")))
     
118.    (msg)
     
119.    (setq TEST NIL)
     
120.    (setq a T)
     
121.   )
     
122.   (t
     
123.    (princ TMP)
     
124.   )
     
125.       )
     
126.     ) ;_结束 while
     
127.     (command ".undo" "end")
     
128.   )
     
129.   
     
130.   (main)
     
131.   
     
132.   (while a
     
133.    
     
134.     (main)
     
135.    
     
136.   )
     
137.   (princ)
     
138. )
     

          ;wkq004  20140331<br /> (PRINC "序号球004，启动命令：xh")<br /> (defun c:xh (/ ss)<br />   <br />   (setvar "cmdecho" 0)<br /> (if (setq layerE (tblobjname "layer" "004序号"))<br />   (progn<br />     (setq layerEL (entget layerE))<br />     (setq ass62 (assoc 62 layerEL))<br />     (if  (/= 4 (cdr ass62))<br />       (progn (setq layerEL (subst (cons 62 4) ass62 layerEL))<br />        (entmod layerEL)<br />       )<br />     )<br />   )<br />   (entmake (list '(0 . "LAYER")<br />      '(100 . "AcDbSymbolTableRecord")<br />      '(100 . "AcDbLayerTableRecord")<br />      '(70 . 0)<br />      '(6 . "Continuous")<br />      '(62 . 4)<br />      (cons 2 "004序号")<br />      )<br />   )<br /> )<br />   (defun *error* (msg)<br />     (princ "\n取消!")<br />     (command "_.erase" SS "")<br />     (command ".undo" "end")<br />     (setq *error* nil)<br />   )<br /> <br />   (defun fun-xh004 ()<br />     (if  (null xh004)<br />       (progn (setq xh004 "1")<br />        (setq xh004 (itoa (getint "\n请输入起始序号[]<1>：")))<br />       )<br />     )<br />   )<br /> <br />   (defun rr004 ()<br />     (if  (null r004)<br />       (progn<br />   (command ".circle"<br />      (getpoint "\n点取设置序号球半径的大小><:")<br />      pause<br />   )<br />   (setq r004 (getvar "CIRCLERAD"))<br />   (entdel (entlast))<br />       )<br />     )<br />   )<br />   (fun-xh004)<br />   (rr004)<br />   (defun msg ()<br />     (princ<br />       "\n点击放置序号球[右键退出/S设置序号/R设置序号球半径]<左键放置>："<br />     )<br />   )<br />   (msg)<br />   (defun main ()<br />     (command ".undo" "begin")<br />     (setq ss (ssadd))<br />     (setq TEST t)<br />     (setq a nil)<br />     (while TEST<br />       (setq TMP (grread t 7 1))<br />       (cond<br />   ((= (car TMP) 3) ;_左键<br />    (setq xh004 (itoa (1+ (atoi xh004))))<br />    (setq TEST NIL)<br />    (setq a T)<br />    <br />   )<br />   ((= (car TMP) 25) ;_右键<br />    (command "_.erase" SS "")<br />    (setq TEST NIL)<br />   )<br />   ((= (car TMP) 5) ;_移动<br />    (setq PT (cadr TMP))<br />    (command "_.erase" SS "")<br />    (entmake<br />      (list '(0 . "TEXT")<br />      '(8 . "004序号")<br />      '(62 . 256)<br />      '(7 . "fs")<br />      (cons 1 xh004)<br />      (cons 10 pt)<br />      (cons 40 r004)<br /> <br />      )<br />    )<br />    (ssadd (entlast) ss)<br />   )<br />   ((and (OR (equal (cadr TMP) 114) (equal (cadr TMP) 82))<br />         (equal (car TMP) 2)<br />    ) ;_序号球半径<br /> <br />    (progn<br />      (command ".circle"<br />         (getpoint "\n点取设置序号球半径的大小><:")<br />         pause<br />      )<br />      (setq r004 (getvar "CIRCLERAD"))<br />      (princ r004)<br />      (msg)<br />      (entdel (entlast))<br /> <br />      (setq TEST NIL)<br />      (setq a T)<br />    )<br />   )<br />   ((and (OR (equal (cadr TMP) 83) (equal (cadr TMP) 115))<br />         (equal (car TMP) 2)<br />    ) ;_设置序号<br />    (command "_.erase" SS "")<br />    (setq xh004 (itoa (getint "\n请输入序号：")))<br />    (msg)<br />    (setq TEST NIL)<br />    (setq a T)<br />   )<br />   (t<br />    (princ TMP)<br />   )<br />       )<br />     ) ;_结束 while<br />     (command ".undo" "end")<br />   )<br />   <br />   (main)<br />   <br />   (while a<br />     <br />     (main)<br />     <br />   )<br />   (princ)<br /> )<br />