在其他软件里面生成的文件，lisp不知道怎么实现，自己研究半天，弄不出来

shang_123

楼主 顶起来 别让沉了

hhh454

请Gu_XL版主帮忙解决，谢谢。

Gu_xl

hhh454 发表于 2012-3-15 22:15
请Gu_XL版主帮忙解决，谢谢。

完整代码如下:

1. (defun c:tt (/ OSMODE  CMDECHO   W W2   W22  H    KD   P1  P2
   
2.         P3   P4  WH   NW   NH P    W0   H0   K    I  NN
   
3.         NNN  FLAG NNH KD1
   
4.        )
   
5.   (defun *error* (msg)
   
6.     (setvar 'osmode osmode)
   
7.   (setvar 'cmdecho cmdecho)
   
8.     (princ msg) (princ)
   
9.     )
   
10.   (setq osmode (getvar 'osmode))
    
11.   (setq cmdecho (getvar 'cmdecho))
    
12.   (setq w (getreal "\n砖块宽度<10.0>:"))
    
13.   (if (null w) (setq w 10.0))
    
14.   (setq w2 (* 0.5 w) w22 w2)
    
15.   (setq h (getreal "\n砖块高度<5.0>:"))
    
16.   (if (null h) (setq h 5.0))
    
17.   (initget 7 "Yes No  ")
    
18.   (setq KD1 (getkword "\n砖块尺寸余数是否取整[Yes/No]<No>:"))
    
19.   (if (= kd1 "") (setq kd1 "No"))
    
20.   (initget 7 "1 2  ")
    
21.   (setq kd (getkword "\n[交错1/平行2]<1>"))
    
22.   (if (= kd "") (setq kd "1"))
    
23.   
    
24.   (setq p1 (getpoint "\n左下角点:")
    
25. p2 (getcorner p1 "\n右上角点:")
    
26. )
    
27.   (setvar 'osmode 0)
    
28.   (setvar 'cmdecho 0)
    
29.   (setq p3 (apply 'mapcar (list 'min p1 p2))
    
30. p4 (apply 'mapcar (list 'max p1 p2))
    
31. wh (mapcar '- p4 p3)
    
32. nw (fix (/ (car wh) w2))
    
33. nh (fix (/ (cadr wh) h))
    
34. p p3 ;(polar p3 0 w2)
    
35. )
    
36.   ;;计算砖块宽度余数
    
37.   (if (equal nw (/ (car wh) w2) 1e-5)
    
38.     (setq w0 w2)
    
39.     (setq w0 (- (car wh) (* nw w2))
    
40.    nw (1+ nw)
    
41.     )
    
42.   )
    
43.   ;;计算砖块高度余数
    
44.   (if (equal nh (/ (cadr wh) h) 1e-5)
    
45.     (progn
    
46.       (setq h0 h)
    
47.     )
    
48.     (setq h0 (- (cadr wh) (* nh h))
    
49.    nh (1+ nh)
    
50.     )
    
51.   )
    
52.   (if (= "No" KD1)
    
53.     ;;砖块余数不取整
    
54.     (progn
    
55.       (setq k -1
    
56.      i -1
    
57.      nn 0
    
58.      nnn (/ nw 2)
    
59.       )
    
60.       (if (/= nw (* nnn 2))
    
61. (setq nnn (1+ nnn))
    
62.       )
    
63.       (vl-cmdf "_rectang" p1 p2)
    
64.     )
    
65.     ;;砖块余数取整
    
66.     (progn
    
67.       (if (>= w0 (* 0.5 w2))
    
68.            (setq W0 W2)
    
69.     (setq w0 w2 nw (1- nw))
    
70. )
    
71.       (if (>= h0 (* 0.5 h))
    
72.            (setq h0 h)
    
73.     (setq h0 h nh (1- nh))
    
74. )
    
75.       (setq k -1
    
76.      i -1
    
77.      nn 0
    
78.      nnn (/ nw 2)
    
79.       )
    
80.       (if (/= nw (* nnn 2))
    
81. (setq nnn (1+ nnn))
    
82.       )
    
83.       (vl-cmdf "_rectang" p3 (strcat "@" (rtos (* nw w2) 2 4) "," (rtos (* nh h) 2 4)))
    
84.       )
    
85.     )
    
86.   (cond ((= kd "1")
    
87.   (vl-cmdf "_pline") (vl-cmdf p)
    
88.   (repeat nnn
    
89.     (setq nn (1+ nn))
    
90.     (if (= nn nnn) (setq w2 w0))
    
91.     (setq k (* -1 k))
    
92.     (setq flag (not flag))
    
93.     (setq nnh 0)
    
94.     (repeat nh
    
95.       (setq i (* -1 i) nnh (1+ nnh))
    
96.       (if flag
    
97. (progn
    
98.    (if (/= nn nnn)
    
99.             (vl-cmdf (strcat "@" (rtos (* i w2) 2 4) "<0"))
    
100.      (vl-cmdf (strcat "@" (rtos (* i w0) 2 4) "<0"))
     
101.      )
     
102.       (if (/= nnh nh)
     
103.           (vl-cmdf (strcat "@" (rtos (* k h) 2 4) "<90"))
     
104. (vl-cmdf (strcat "@" (rtos (* k h0) 2 4) "<90"))
     
105. )
     
106.       )
     
107. 
     
108. (progn
     
109.    (if (/= 1 nnh)
     
110.            (vl-cmdf (strcat "@" (rtos (* k h) 2 4) "<90"))
     
111.      (vl-cmdf (strcat "@" (rtos (* k h0) 2 4) "<90"))
     
112.      )
     
113.       (if (< nnh nh)
     
114. (if (/= nn nnn)
     
115. (vl-cmdf (strcat "@" (rtos (* i w2) 2 4) "<0"))
     
116.    (vl-cmdf (strcat "@" (rtos (* i w0) 2 4) "<0"))
     
117.    )
     
118. )
     
119.       )
     
120. )
     
121.       
     
122.       )
     
123.    
     
124.       (if (< nn nnn)
     
125. (if flag
     
126.          (vl-cmdf (strcat "@" (rtos w 2 4) "<0"))
     
127.    (vl-cmdf (strcat "@" (rtos w2 2 4) "<0"))
     
128.    )
     
129.     )
     
130.       
     
131.    
     
132.     )
     
133.   (vl-cmdf "")
     
134.   (setq i -1 w2 w22)
     
135.   (vl-cmdf "_pline") (vl-cmdf p3)
     
136.   (setq nn 0)
     
137.   (repeat nh
     
138.     (setq i (* -1 i) nn (1+ nn))
     
139.     (if (= "No" kd1)
     
140.     (vl-cmdf (strcat "@" (rtos (* i (car wh)) 2 4) "<0"))
     
141.       (vl-cmdf (strcat "@" (rtos (* i (* nw w2)) 2 4) "<0"))
     
142.       )
     
143.     (if (/= nn nh)
     
144.     (vl-cmdf (strcat "@" (rtos h 2 4) "<90"))
     
145.       (vl-cmdf (strcat "@" (rtos h0 2 4) "<90"))
     
146.       )
     
147.     )
     
148.   
     
149.   (vl-cmdf "")
     
150.   )
     
151. ;;平行
     
152. (t
     
153.       (setq i -1)
     
154.   (vl-cmdf "_pline") (vl-cmdf p3)
     
155.   (setq nn 0)
     
156.   (repeat nw
     
157.     (setq i (* -1 i) nn (1+ nn))
     
158.     (if (= "No" kd1)
     
159.     (vl-cmdf (strcat "@" (rtos (* i (cadr wh)) 2 4) "<90"))
     
160.       (vl-cmdf (strcat "@" (rtos (* i (* nh h)) 2 4) "<90"))
     
161.       )
     
162.     (if (/= nn nw)
     
163.     (vl-cmdf (strcat "@" (rtos w2 2 4) "<0"))
     
164.       (vl-cmdf (strcat "@" (rtos w0 2 4) "<0"))
     
165.       )
     
166.     )
     
167.   
     
168.   (vl-cmdf "")
     
169.   
     
170.   (setq i -1)
     
171.   (vl-cmdf "_pline") (vl-cmdf p3)
     
172.   (setq nn 0)
     
173.   (repeat nh
     
174.     (setq i (* -1 i) nn (1+ nn))
     
175.     (if (= "No" kd1)
     
176.     (vl-cmdf (strcat "@" (rtos (* i (car wh)) 2 4) "<0"))
     
177.       (vl-cmdf (strcat "@" (rtos (* i (* nw w2)) 2 4) "<0"))
     
178.       )
     
179.     (if (/= nn nh)
     
180.     (vl-cmdf (strcat "@" (rtos h 2 4) "<90"))
     
181.       (vl-cmdf (strcat "@" (rtos h0 2 4) "<90"))
     
182.       )
     
183.     )
     
184.   
     
185.   (vl-cmdf "")
     
186.   )
     
187. )
     
188.     (setvar 'osmode osmode)
     
189.   (setvar 'cmdecho cmdecho)
     
190. (princ)
     
191.   )
     

(defun c:tt (/ OSMODE  CMDECHO   W W2   W22  H    KD   P1  P2<br />         P3   P4  WH   NW   NH P    W0   H0   K    I  NN<br />         NNN  FLAG NNH KD1<br />        )<br />   (defun *error* (msg)<br />     (setvar 'osmode osmode)<br />   (setvar 'cmdecho cmdecho)<br />     (princ msg) (princ)<br />     )<br />   (setq osmode (getvar 'osmode))<br />   (setq cmdecho (getvar 'cmdecho))<br />   (setq w (getreal "\n砖块宽度<10.0>:"))<br />   (if (null w) (setq w 10.0))<br />   (setq w2 (* 0.5 w) w22 w2)<br />   (setq h (getreal "\n砖块高度<5.0>:"))<br />   (if (null h) (setq h 5.0))<br />   (initget 7 "Yes No  ")<br />   (setq KD1 (getkword "\n砖块尺寸余数是否取整[Yes/No]<No>:"))<br />   (if (= kd1 "") (setq kd1 "No"))<br />   (initget 7 "1 2  ")<br />   (setq kd (getkword "\n[交错1/平行2]<1>"))<br />   (if (= kd "") (setq kd "1"))<br />   <br />   (setq p1 (getpoint "\n左下角点:")<br /> p2 (getcorner p1 "\n右上角点:")<br /> )<br />   (setvar 'osmode 0)<br />   (setvar 'cmdecho 0)<br />   (setq p3 (apply 'mapcar (list 'min p1 p2))<br /> p4 (apply 'mapcar (list 'max p1 p2))<br /> wh (mapcar '- p4 p3)<br /> nw (fix (/ (car wh) w2))<br /> nh (fix (/ (cadr wh) h))<br /> p p3 ;(polar p3 0 w2)<br /> )<br />   ;;计算砖块宽度余数<br />   (if (equal nw (/ (car wh) w2) 1e-5)<br />     (setq w0 w2)<br />     (setq w0 (- (car wh) (* nw w2))<br />    nw (1+ nw)<br />     )<br />   )<br />   ;;计算砖块高度余数<br />   (if (equal nh (/ (cadr wh) h) 1e-5)<br />     (progn<br />       (setq h0 h)<br />     )<br />     (setq h0 (- (cadr wh) (* nh h))<br />    nh (1+ nh)<br />     )<br />   )<br />   (if (= "No" KD1)<br />     ;;砖块余数不取整<br />     (progn<br />       (setq k -1<br />      i -1<br />      nn 0<br />      nnn (/ nw 2)<br />       )<br />       (if (/= nw (* nnn 2))<br /> (setq nnn (1+ nnn))<br />       )<br />       (vl-cmdf "_rectang" p1 p2)<br />     )<br />     ;;砖块余数取整<br />     (progn<br />       (if (>= w0 (* 0.5 w2))<br />            (setq W0 W2)<br />     (setq w0 w2 nw (1- nw))<br /> )<br />       (if (>= h0 (* 0.5 h))<br />            (setq h0 h)<br />     (setq h0 h nh (1- nh))<br /> )<br />       (setq k -1<br />      i -1<br />      nn 0<br />      nnn (/ nw 2)<br />       )<br />       (if (/= nw (* nnn 2))<br /> (setq nnn (1+ nnn))<br />       )<br />       (vl-cmdf "_rectang" p3 (strcat "@" (rtos (* nw w2) 2 4) "," (rtos (* nh h) 2 4)))<br />       )<br />     )<br />   (cond ((= kd "1")<br />   (vl-cmdf "_pline") (vl-cmdf p)<br />   (repeat nnn<br />     (setq nn (1+ nn))<br />     (if (= nn nnn) (setq w2 w0))<br />     (setq k (* -1 k))<br />     (setq flag (not flag))<br />     (setq nnh 0)<br />     (repeat nh<br />       (setq i (* -1 i) nnh (1+ nnh))<br />       (if flag<br /> (progn<br />    (if (/= nn nnn)<br />             (vl-cmdf (strcat "@" (rtos (* i w2) 2 4) "<0"))<br />      (vl-cmdf (strcat "@" (rtos (* i w0) 2 4) "<0"))<br />      )<br />       (if (/= nnh nh)<br />           (vl-cmdf (strcat "@" (rtos (* k h) 2 4) "<90"))<br /> (vl-cmdf (strcat "@" (rtos (* k h0) 2 4) "<90"))<br /> )<br />       )<br /> <br /> (progn<br />    (if (/= 1 nnh)<br />            (vl-cmdf (strcat "@" (rtos (* k h) 2 4) "<90"))<br />      (vl-cmdf (strcat "@" (rtos (* k h0) 2 4) "<90"))<br />      )<br />       (if (< nnh nh)<br /> (if (/= nn nnn)<br /> (vl-cmdf (strcat "@" (rtos (* i w2) 2 4) "<0"))<br />    (vl-cmdf (strcat "@" (rtos (* i w0) 2 4) "<0"))<br />    )<br /> )<br />       )<br /> )<br />       <br />       )<br />     <br />       (if (< nn nnn)<br /> (if flag<br />          (vl-cmdf (strcat "@" (rtos w 2 4) "<0"))<br />    (vl-cmdf (strcat "@" (rtos w2 2 4) "<0"))<br />    )<br />     )<br />       <br />     <br />     )<br />   (vl-cmdf "")<br />   (setq i -1 w2 w22)<br />   (vl-cmdf "_pline") (vl-cmdf p3)<br />   (setq nn 0)<br />   (repeat nh<br />     (setq i (* -1 i) nn (1+ nn))<br />     (if (= "No" kd1)<br />     (vl-cmdf (strcat "@" (rtos (* i (car wh)) 2 4) "<0"))<br />       (vl-cmdf (strcat "@" (rtos (* i (* nw w2)) 2 4) "<0"))<br />       )<br />     (if (/= nn nh)<br />     (vl-cmdf (strcat "@" (rtos h 2 4) "<90"))<br />       (vl-cmdf (strcat "@" (rtos h0 2 4) "<90"))<br />       )<br />     )<br />   <br />   (vl-cmdf "")<br />   )<br /> ;;平行<br /> (t<br />       (setq i -1)<br />   (vl-cmdf "_pline") (vl-cmdf p3)<br />   (setq nn 0)<br />   (repeat nw<br />     (setq i (* -1 i) nn (1+ nn))<br />     (if (= "No" kd1)<br />     (vl-cmdf (strcat "@" (rtos (* i (cadr wh)) 2 4) "<90"))<br />       (vl-cmdf (strcat "@" (rtos (* i (* nh h)) 2 4) "<90"))<br />       )<br />     (if (/= nn nw)<br />     (vl-cmdf (strcat "@" (rtos w2 2 4) "<0"))<br />       (vl-cmdf (strcat "@" (rtos w0 2 4) "<0"))<br />       )<br />     )<br />   <br />   (vl-cmdf "")<br />   <br />   (setq i -1)<br />   (vl-cmdf "_pline") (vl-cmdf p3)<br />   (setq nn 0)<br />   (repeat nh<br />     (setq i (* -1 i) nn (1+ nn))<br />     (if (= "No" kd1)<br />     (vl-cmdf (strcat "@" (rtos (* i (car wh)) 2 4) "<0"))<br />       (vl-cmdf (strcat "@" (rtos (* i (* nw w2)) 2 4) "<0"))<br />       )<br />     (if (/= nn nh)<br />     (vl-cmdf (strcat "@" (rtos h 2 4) "<90"))<br />       (vl-cmdf (strcat "@" (rtos h0 2 4) "<90"))<br />       )<br />     )<br />   <br />   (vl-cmdf "")<br />   )<br /> )<br />     (setvar 'osmode osmode)<br />   (setvar 'cmdecho cmdecho)<br /> (princ)<br />   )<br />

2012.03.18更新代码，增加砖块尺寸余数是否取整可选项。

仲文玉

G版的程序一定要看，支持

yzr2002626

G版的程序，一定先顶再看

yshf

G版的程序一定要看，看了还要再看

shang_123

Gu_xl 发表于 2012-3-16 21:13
代码如下:
**** 本内容被作者隐藏 ****

G版 不错  要是能捕捉点就好了！！

shang_123

问题 已解决！！！

shang_123

Gu_xl 发表于 2012-3-16 21:13
代码如下:
**** 本内容被作者隐藏 ****

  出现这种问题 要不不够 要不大出 G版能弄成下面这种吗？ 在最上面或最右边的时候 让它根据范围缩小

Gu_xl

shang_123 发表于 2012-3-18 12:48
出现这种问题 要不不够 要不大出 G版能弄成下面这种吗？ 在最上面或最右边的时候 让它根据范围缩小

13楼代码按要求更新，增加是否调整砖块余数尺寸可选项。