-
Notifications
You must be signed in to change notification settings - Fork 7
/
BLT3.LSP
462 lines (449 loc) · 12.4 KB
/
BLT3.LSP
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
(defun c:BLT3 ()
;(IF (= (TYPE F1) 'FILE ) "YES" (STOP))
;(IF (= (TYPE F2) 'FILE ) "YES" (STOP))
(COMMAND "SETVAR" "CMDECHO" 0)
(SETQ NY (GETVAR "CLAYER"))
(setq BLSET (findfile "c:/acad/HON/SET/BL3.SET"))
(IF (= BLSET NIL)
(PROGN
(SETQ TEST 1)
(PROMPT "\nPLEASE SETTING LAYER SKT-BLT :" )
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "w"))
(setq BLCNT (GETSTRING T"\nSETTING SKT-BLT LAYER OF CONTNIUE LINE/<DRAW>:"))
(IF (= BLCNT "")
(WRITE-LINE "DRAW" FC)
(WRITE-LINE BLCNT FC)
)
(setq BLCEN (GETSTRING T"\nSETTING SKT-BLT LAYER OF CENTER LINE/<CENTER>:"))
(IF (= BLCEN "")
(WRITE-LINE "CENTER" FC)
(WRITE-LINE BLCEN FC)
)
(setq BLHID (GETSTRING T"\nSETTING SKT-BLT LAYER OF HIDDEN LINE/<HIDDEN>:"))
(IF (= BLHID "")
(WRITE-LINE "HIDDEN" FC)
(WRITE-LINE BLHID FC)
)
(setq BLDIM (GETSTRING T"\nSETTING SKT-BLT LAYER OF DIMESION /<TEXT>:"))
(IF (= BLDIM "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLDIM FC)
)
(setq BLTXT (GETSTRING T"\nSETTING SKT-BLT LAYER OF TEXT /<TEXT>:"))
(IF (= BLTXT "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLTXT FC)
)
(CLOSE FC)
)
)
(IF (/= BLSET NIL)
(PROGN
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "r"))
(SETQ BLCNT (READ-LINE FC))
(SETQ BLCEN (READ-LINE FC))
(SETQ BLHID (READ-LINE FC))
(SETQ BLDIM (READ-LINE FC))
(SETQ BLTXT (READ-LINE FC))
(IF (OR (= BLCNT "") (= BLCEN "") (= BLHID "") (= BLDIM "") (= BLTXT "")
(= BLCNT NIL) (= BLCEN NIL) (= BLHID NIL) (= BLDIM NIL) (= BLTXT NIL))
(CLOSE FC)
)
(IF (OR (= BLCNT "") (= BLCEN "") (= BLHID "") (= BLDIM "") (= BLTXT "")
(= BLCNT NIL) (= BLCEN NIL) (= BLHID NIL) (= BLDIM NIL) (= BLTXT NIL))
(PROGN
(PROMPT "\nPLEASE SETTING LAYER OF SCREW :" )
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "w"))
(setq BLCNT (GETSTRING T"\nSETTING SKT-BLT LAYER OF CONTNIUE LINE/<DRAW>:"))
(IF (= BLCNT "")
(WRITE-LINE "DRAW" FC)
(WRITE-LINE BLCNT FC)
)
(setq BLCEN (GETSTRING T"\nSETTING SKT-BLT LAYER OF CENTER LINE/<CENTER>:"))
(IF (= BLCEN "")
(WRITE-LINE "CENTER" FC)
(WRITE-LINE BLCEN FC)
)
(setq BLHID (GETSTRING T"\nSETTING SKT-BLT LAYER OF HIDDEN LINE/<HIDDEN>:"))
(IF (= BLHID "")
(WRITE-LINE "HIDDEN" FC)
(WRITE-LINE BLHID FC)
)
(setq BLDIM (GETSTRING T"\nSETTING SKT-BLT LAYER OF DIMESION/<TEXT>:"))
(IF (= BLDIM "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLDIM FC)
)
(setq BLTXT (GETSTRING T"\nSETTING SKT-BLT LAYER OF TEXT /<TEXT>:"))
(IF (= BLTXT "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLTXT FC)
)
(CLOSE FC)
)
)
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "r"))
(SETQ BLCNT (READ-LINE FC))
(SETQ BLCEN (READ-LINE FC))
(SETQ BLHID (READ-LINE FC))
(SETQ BLDIM (READ-LINE FC))
(SETQ BLTXT (READ-LINE FC))
(CLOSE FC)
(PROMPT "\nSCREW CONTINUE OF LAYER IS:" )(PROMPT BLCNT)(TERPRI)
(PROMPT "\nSCREW CENTER OF LAYER IS:" ) (PROMPT BLCEN)(TERPRI)
(PROMPT "\nSCREW HIDDEN OF LAYER IS:" ) (PROMPT BLHID)(TERPRI)
(PROMPT "\nSCREW DIMENSION OF LAYER IS:" ) (PROMPT BLDIM)(TERPRI)
(PROMPT "\nSCREW TEXT OF LAYER IS:" ) (PROMPT BLTXT)(TERPRI)
)
)
(SETQ ANS (strcase (GETSTRING "\nDO YOU WANT TO CHANGE LAST SETTING <Y/N> N:")))
(IF (= ANS "Y")
(PROGN
(PROMPT "\nPLEASE SETTING LAYER:" )
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "w"))
(PROMPT "\nSCREW CONTINUE OF LAYER <" )(PROMPT BLCNT)(PROMPT">:")
(setq BLCNT (GETSTRING T))
(IF (= BLCNT "")
(WRITE-LINE "DRAW" FC)
(WRITE-LINE BLCNT FC)
)
(PROMPT "\nSCREW CENTER OF LAYER <" )(PROMPT BLCEN)(PROMPT">:")
(setq BLCEN (GETSTRING T))
(IF (= BLCEN "")
(WRITE-LINE "CENTER" FC)
(WRITE-LINE BLCEN FC)
)
(PROMPT "\nSCREW HIDDEN OF LAYER <" )(PROMPT BLHID)(PROMPT">:")
(setq BLHID (GETSTRING T))
(IF (= BLHID "")
(WRITE-LINE "HIDDEN" FC)
(WRITE-LINE BLHID FC)
)
(PROMPT "\nSCREW DIMESION OF LAYER <" )(PROMPT BLDIM)(PROMPT">:")
(setq BLDIM (GETSTRING T))
(IF (= BLDIM "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLDIM FC)
)
(PROMPT "\nSCREW TEXT OF LAYER <" )(PROMPT BLTXT)(PROMPT">:")
(setq BLTXT (GETSTRING T))
(IF (= BLTXT "")
(WRITE-LINE "TEXT" FC)
(WRITE-LINE BLTXT FC)
)
(CLOSE FC)
(SETQ FC (OPEN "c:/acad/HON/SET/BL3.SET" "r"))
(SETQ BLCNT (READ-LINE FC))
(SETQ BLCEN (READ-LINE FC))
(SETQ BLHID (READ-LINE FC))
(SETQ BLDIM (READ-LINE FC))
(SETQ BLTXT (READ-LINE FC))
(CLOSE FC)
(PROMPT "\nSCREW CONTINUE OF LAYER NOW IS:" )(PROMPT BLCNT)(TERPRI)
(PROMPT "\nSCREW CENTER OF LAYER NOW IS:" ) (PROMPT BLCEN)(TERPRI)
(PROMPT "\nSCREW HIDDEN OF LAYER NOW IS:" ) (PROMPT BLHID)(TERPRI)
(PROMPT "\nSCREW DIM OF LAYER NOW IS:" ) (PROMPT BLDIM)(TERPRI)
(PROMPT "\nSCREW TEXT OF LAYER NOW IS:" ) (PROMPT BLTXT)(TERPRI)
)
)
;THE POINT IS FIST COUNTER Y THEN X
(MENUCMD "S=BLT")
(SETQ D (GETREAL"\nSelect dim:"))
(GRAPHSCR) (TERPRI) ;GRAPHICS MODE
(SETQ ANS1 "Y")
(IF (= D 3)
(PROGN
(SETQ D2 3.3)
(SETQ BD1 5)
(SETQ BD2 6)
(SETQ H1 3)
(SETQ H2 4)
(SETQ SP 0.25)
(SETQ SPP 0.5)
(SETQ TTH 2.5)
)
)
(IF (= D 4)
(PROGN
(SETQ D2 4.5)
(SETQ BD1 6.5)
(SETQ BD2 7.5)
(SETQ H1 4)
(SETQ H2 5)
(SETQ SP 0.35)
(SETQ SPP 0.7)
(SETQ TTH 2.5)
)
)
(IF (= D 5)
(PROGN
(SETQ D2 5.5)
(SETQ BD1 8)
(SETQ BD2 9)
(SETQ H1 5)
(SETQ H2 6.5)
(SETQ SP 0.4)
(SETQ SPP 1)
(SETQ TTH 2.7)
)
)
(IF (= D 6)
(PROGN
(SETQ D2 6.5)
(SETQ BD1 10)
(SETQ BD2 11)
(SETQ H1 6)
(SETQ H2 7.5)
(SETQ SP 0.5)
(SETQ SPP 1)
(SETQ TTH 2.7)
)
)
(IF (= D 8)
(PROGN
(SETQ D2 8.8)
(SETQ BD1 13)
(SETQ BD2 14)
(SETQ H1 8)
(SETQ H2 9.5)
(SETQ SP 0.63)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 10)
(PROGN
(SETQ D2 11)
(SETQ BD1 16)
(SETQ BD2 17.5)
(SETQ H1 10)
(SETQ H2 11.5)
(SETQ SP 0.75)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 12)
(PROGN
(SETQ D2 13)
(SETQ BD1 18)
(SETQ BD2 20)
(SETQ H1 12)
(SETQ H2 13.5)
(SETQ SP 0.88)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 14)
(PROGN
(SETQ D2 15.5)
(SETQ BD1 21)
(SETQ BD2 23)
(SETQ H1 14)
(SETQ H2 15.5)
(SETQ SP 1.0)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 16)
(PROGN
(SETQ D2 18)
(SETQ BD1 24)
(SETQ BD2 26)
(SETQ H1 16)
(SETQ H2 17.5)
(SETQ SP 1.0)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 20)
(PROGN
(SETQ D2 22)
(SETQ BD1 28)
(SETQ BD2 30)
(SETQ H1 20)
(SETQ H2 21.5)
(SETQ SP 1.25)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 22)
(PROGN
(SETQ D2 24)
(SETQ BD1 30)
(SETQ BD2 32)
(SETQ H1 22)
(SETQ H2 23.5)
(SETQ SP 1.25)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 24)
(PROGN
(SETQ D2 26)
(SETQ BD1 33)
(SETQ BD2 35)
(SETQ H1 24)
(SETQ H2 25.5)
(SETQ SP 1.5)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 30)
(PROGN
(SETQ D2 33)
(SETQ BD1 42)
(SETQ BD2 45)
(SETQ H1 30)
(SETQ H2 32)
(SETQ SP 1.75)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
(IF (= D 36)
(PROGN
(SETQ D2 39)
(SETQ BD1 50)
(SETQ BD2 54)
(SETQ H1 36)
(SETQ H2 38)
(SETQ SP 1.75)
(SETQ SPP 1)
(SETQ TTH 3)
)
)
;(SETQ P1 (LIST -5.31 3.64))
;(SETQ P2 (LIST -5.31 133.64))
(SETQ P1 (GETPOINT "\nP1:"))
(SETQ P2 (GETPOINT P1 "\nDIRECTION:"))
(SETQ AG1 (ANGLE P1 P2))
(SETQ AG2 (* PI 0.5))
(SETQ LSE (DISTANCE P1 P2)) ;DIST FOR P1 P2
(SETQ CR SP)
(SETQ DR3 (POLAR (POLAR P1 AG1 H2) (+ AG1 AG2) (/ BD2 2.0)))
(SETQ DR3M (POLAR (POLAR P1 AG1 H2) (+ AG1 AG2) 0))
(SETQ LG (DISTANCE P2 DR3M))
(SETQ LP (GETVAR "LUPREC")) ;LP DIGITAL
(SETQ EXDG (- LG (FIX LG)))
(SETQ LG1 (FIX LG))
(SETQ LG1 (ITOA LG1))
(SETQ SN (STRLEN LG1))
(SETQ DN (SUBSTR LG1 SN SN))
(SETQ DN1 (ATOI DN))
(IF (< DN1 5)
(PROGN
(SETQ DNG 0)
(SETQ MT DN1) ;MLUS VALUE
)
)
(IF (>= DN1 5)
(PROGN
(SETQ DNG 5)
(SETQ MT (- DN1 5))
)
)
(SETQ EXMT (+ MT EXDG)) ;EXTEND MLUS VALUE
(SETQ MIDEXT (- LG EXMT))
(SETQ EXMT1 EXMT)
(SETQ EXMT 0)
(IF (= ANS1 "Y")
(COMMAND "LAYER" "SET" BLCNT "")
(COMMAND "LAYER" "SET" BLHID "")
)
(SETQ DR1 (POLAR P1 (+ AG1 AG2) (/ D 2.0)))
(SETQ DR2 (POLAR P1 (- AG1 AG2) (/ D 2.0)))
(SETQ DR3 (POLAR (POLAR P1 AG1 (- (* D 2.5) 0)) (+ AG1 AG2) (/ D 2.0)))
(SETQ DR4 (POLAR (POLAR P1 AG1 (- (* D 2.5) 0)) (- AG1 AG2) (/ D 2.0)))
(SETQ DR5 (POLAR P1 (+ AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DR6 (POLAR P1 (- AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DR7 (POLAR (POLAR P1 AG1 (- (* D 3) 1)) (+ AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DR8 (POLAR (POLAR P1 AG1 (- (* D 3) 1)) (- AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DR9 (POLAR (POLAR P1 AG1 (+ (* D 2.5) SP)) (+ AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DR10 (POLAR (POLAR P1 AG1 (+ (* D 2.5) SP)) (- AG1 AG2) (- (/ D 2.0) SP)))
(SETQ DRINT1 (POLAR DR7 (- AG1 (DTR 60)) 3))
(SETQ DRINT2 (POLAR DR8 (+ AG1 (DTR 60)) 3))
(SETQ INT1 (INTERS DR7 DRINT1 DR8 DRINT2 NIL))
;(SETQ LONG1 (DISTANCE DR15-1 DR27))
;(SETQ LONG1 (FIX LONG1))
;(SETQ LONG1 (RTOS LONG1 2 0))
;(PROMPT"\nCHANGE LONG ?<")(PROMPT LONG1) (PROMPT ">")
;(SETQ LONG2 (GETSTRING))
;(IF (= LONG2 "")
; (SETQ LONG2 LONG1)
;)
(COMMAND "LINE" DR1 DR3 "")
(COMMAND "LINE" DR2 DR4 "")
(COMMAND "LINE" DR3 DR4 "")
(COMMAND "LINE" DR5 DR7 "")
(COMMAND "LINE" DR6 DR8 "")
(COMMAND "LINE" DR9 DR10 "")
(COMMAND "LINE" DR3 DR9 "")
(COMMAND "LINE" DR4 DR10 "")
(COMMAND "LINE" DR7 DR8 "")
(COMMAND "LINE" DR7 INT1 "")
(COMMAND "LINE" DR8 INT1 "")
;(IF (>= (DISTANCE DR15-1 DR27) (* D 3))
; (PROGN
; (COMMAND "LINE" DR25 DR23 INT1 "")
; (COMMAND "LINE" DR26 DR24 INT2 "")
; (COMMAND "LINE" DR21 DR22 "")
; )
;)
;(IF (<= (DISTANCE DR15-1 DR27) (* D 3))
; (PROGN
; (COMMAND "LINE" DR15-1 INT1 "")
; (COMMAND "LINE" DR16-1 INT2 "")
; )
;)
;(COMMAND "LINE" SINT INT1 "")
;(COMMAND "LINE" SINT INT2 "")
;(COMMAND "LINE" INT1 INT2 "")
;(COMMAND "LINE" DR27 DR29 "")
;(COMMAND "LINE" DR28 DR30 "")
;(COMMAND "LINE" DR27 DR28 "")
;(COMMAND "LINE" DR29 DR30 "")
;(COMMAND "LINE" DR17 DR18 "")
;(COMMAND "LAYER" "SET" BLCEN "")
;(COMMAND "LINE" (POLAR P1 AG1 -1) (POLAR P1 AG1 (+ 1 LSE (* D 2.5))) "")
;HERE IS TEXT
;(SETQ NUM (GETSTRING T "\nHOW MANY BLT-SKT ?"))
;(IF (OR (= NUM "") (= NUM "1"))
; (SETQ BLDIMT " ")
; (SETQ BLDIMT (STRCAT "(" NUM "X" ")"))
;)
;(IF (<= D 8)
; (SETQ TT2 (GETPOINT"\nWHERE IS TEXT POINT:"))
; (SETQ TT2 (POLAR (POLAR P1 AG1 (+ H1 3 EXMT)) (- AG1 AG2) -1))
;)
;(IF (< D 10)
; (SETQ TT5 (POLAR (POLAR P1 AG1 (- LSE 11.5)) (+ AG1 AG2) 2.6))
; (SETQ TT5 (POLAR (POLAR P1 AG1 (- LSE 11.5)) (+ AG1 AG2) 4.0))
;)
;;(SETQ LONG1 (- (DISTANCE DR15-1 DR27) EXMT1))
;;(SETQ LONG1 (DISTANCE DR15-1 DR27))
;;(SETQ LONG1 (FIX LONG1))
;;(SETQ LONG1 (RTOS LONG1 2 0))
;
;(SETQ LP (GETVAR "LUPREC")) ;LP DIGITAL
;(SETQ D1 (RTOS D 2 LP))
;(SETQ D11 (FIX (ATOF D1)))
;(SETQ RET (- D D11))
;(IF (OR (= RET 0) (= RET 0.0) (= RET 0.00))
; (PROGN
; (SETQ SR (- (STRLEN D1) LP 1))
; (SETQ D1 (SUBSTR D1 1 SR))
; )
;)
;(SETQ DIST1 (STRCAT "M" D1 "X" LONG2 "L" BLDIMT))
;
;(COMMAND "LAYER" "SET" BLTXT "")
;(COMMAND "TEXT" TT2 TTH (RTD AG1) DIST1)
(COMMAND "LAYER" "SET" NY "")
)