home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 4.ddi / LSP2 / HM39.LSP < prev   
Encoding:
Text File  |  1990-03-14  |  2.8 KB  |  81 lines
  1. ;┐╫░σ└α┴π╝■═╝╖∙╤í╘±│╠╨≥:
  2. (DEFUN TFXZ ()
  3. (setvar "blipmode" 0)
  4.  (SETVAR "CMDECHO" 0)
  5.  (MENUCMD "S=TUHA")
  6.  (SETQ TH (GETSTRING "\n╟δ╩Σ╚δ═╝║┼:(A4)"))
  7.  (COND ((= TH "")(SETQ TH "A4")))
  8. ; (SETQ PTB (GETPOINT "\n╟δ╩Σ╚δ═╝╨╬╫≤╧┬╜╟╡π: "))
  9.  (SETQ PTB (LIST 30 30))
  10. ; (SETQ PTT (GETPOINT "\n╟δ╩Σ╚δ═╝╨╬╙╥╔╧╜╟╡π: "))
  11. ; (SETQ L (- (CAR PTT) (CAR PTB)))
  12. ; (SETQ H (- (CADR PTT) (CADR PTB)))
  13. ; (SETQ L (+ L 30) H (+ H 30 35))
  14. ; (COND ((AND (<= L 1180) (<= H 841))
  15.  (COND ((= TH "A0")
  16.   (SETQ L1 1189 H1 841 C 10)
  17.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 60)))
  18.  ))
  19. ; (COND ((AND (<= L 841) (<= H 594))
  20.  (COND ((= TH "A1")
  21.   (SETQ L1 841 H1 594 C 10)
  22.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 60)))
  23.  ))
  24. ; (COND ((AND (<= L 594) (<= H 420))
  25.  (COND ((= TH "A2")
  26.   (SETQ L1 594 H1 420 C 10)
  27.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 60)))
  28.  ))
  29. ; (COND ((AND (<= L 420) (<= H 297))
  30.  (COND ((= TH "A3")
  31.   (SETQ L1 420 H1 297 C 5)
  32.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 55)))
  33.  ))
  34. ; (COND ((AND (<= L 297) (<= H 210))
  35.  (COND ((= TH "A4")
  36. ;  (SETQ L1 297 H1 210 C 5)
  37.   (SETQ L1 210 H1 297 C 5)
  38.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 55)))
  39.  ))
  40. ; (COND ((AND (<= L 210) (<= H 148))
  41.  (COND ((= TH "A5")
  42.   (SETQ L1 210 H1 148 C 5)
  43.   (SETQ PTB1 (LIST (- (CAR PTB) 40) (- (CADR PTB) 55)))
  44.  ))
  45.  (SETQ PTT1 (LIST (+ (CAR PTB1) L1) (+ (CADR PTB1) H1)))
  46.  (SETQ PTB2 (LIST (+ (CAR PTB1) 25) (+ (CADR PTB1) C)))
  47.  (SETQ PTT2 (LIST (- (CAR PTT1) C) (- (CADR PTT1) C)))
  48.  (SETQ PTB3 (LIST (CAR PTT2) (CADR PTB2)))
  49.  (SETQ PTT3 (LIST (CAR PTB2) (CADR PTT2)))
  50.  (COMMAND "PLINE" PTB2 "W" 0.35 "" PTB3 PTT2 PTT3 "C")
  51.  (SETQ PTB3 (LIST (CAR PTT1) (CADR PTB1)))
  52.  (SETQ PTT3 (LIST (CAR PTB1) (CADR PTT1)))
  53.  (COMMAND "LINE" PTB1 PTB3 PTT1 PTT3 "C")
  54.  (SETQ PTI (LIST (- (CAR PTT2) 180) (CADR PTB2)))
  55.  (COMMAND "INSERT" "DWG/HYB" PTI "" "" "")
  56.  (SETQ PTI (LIST (- (CAR PTT2) 55) (- (CADR PTT2) 24)))
  57.  (COMMAND "INSERT" "DWG/WZJ" PTI "" "" "")
  58.  (SETQ PTI (LIST (- (CAR PTT2) 55) (- (CADR PTT2) 13)))
  59.  (COMMAND "INSERT" "DWG/OTH" PTI 8 "" "")
  60.  (SETQ PTI (LIST (- (CAR PTT2) 20) (- (CADR PTT2) 13)))
  61.  (COMMAND "INSERT" "DWG/GD4" PTI 4 "" "")
  62.  (COMMAND "ZOOM" "E")
  63.  (SCALE2)
  64.  (SETQ PTI (LIST (- (CAR PTT2) 12) (+ (CADR PTB2) 14)))
  65.  (SETQ S1 (FIX (- S 1)))
  66.  (SETQ BL (NTH S1 '("1:1" "1:2" "1:3" "1:4" "1:5" "1:6" "1:7" "1:8" "1:9")))
  67.  (COMMAND "TEXT" PTI 4 0 BL)
  68.  (MENUCMD "S=IN1")
  69.  (SETQ BL (GETSTRING "\n╟δ╩Σ╚δ┴π╝■═╝║┼: "))
  70.  (SETQ PTI (LIST (- (CAR PTT2) 30) (+ (CADR PTB2) 1)))
  71.  (COMMAND "TEXT" PTI 4 0 BL)
  72.  (SETQ BL (GETSTRING "\n╟δ╩Σ╚δ┴π╝■▓─┴╧┤·║┼: "))
  73.  (SETQ PTI (LIST (- (CAR PTT2) 30) (+ (CADR PTB2) 31)))
  74.  (COMMAND "TEXT" PTI 4 0 BL)
  75.  (SETQ BL (GETSTRING "\n╟δ╩Σ╚δ┴π╝■╩²┴┐: "))
  76.  (SETQ PTI (LIST (- (CAR PTT2) 30) (+ (CADR PTB2) 25)))
  77.  (COMMAND "TEXT" PTI 4 0 BL)
  78.  (MENUCMD "S=BAN")
  79. )
  80. (TFXZ)
  81.