home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM17.LSP < prev    next >
Encoding:
Text File  |  1980-01-04  |  3.9 KB  |  120 lines
  1. ;************************************************
  2. ;*  The function for drawing hotal spline.      *
  3. ;************************************************
  4. (DEFUN HSPLINE ()
  5. (SETVAR "CMDECHO" 0)
  6. (SETVAR "BLIPMODE" 0)
  7.  (MENUCMD "S=IN2")
  8.  (initget 1 "l L r R")
  9.  (setq ed (getkword "\n ╤╙╔∞╖╜╧≥ : ╫≤ (L) / ╙╥ (R) "))
  10. (strcase ed)
  11.   (MENUCMD "P1=SP10")
  12.   (MENUCMD "P1=*")
  13.         (PRINC "\n╠ß╩╛: ╕├╧ε╩Σ╚δ▒╪╨δ╡π╚í╧α╙ª╡─▓╦╡Ñ:")
  14.           (setq dr (getSTRING "\n╟δ╩Σ╚δ╗¿╝ⁿ╡─╣½│╞│▀┤τ: "))
  15.         (SETQ NZL1 (SUBSTR DR 1 1))
  16.         (SETQ NZL1 (ATOI NZL1))
  17.         (SETQ DR (SUBSTR DR 3))
  18.         (SETQ DR (ATOF DR))
  19. (MENUCMD "S=IN1")
  20.   (setq l (getstring "\n╩Σ╚δ│ñ╢╚=:(═¿┐╫) "))
  21.   (if (or (= l "")(= l "t"))(setq l "T"))
  22.   (if (/= l "T")(setq l (atof l)))
  23.   (if (= l "T")(setq l (- m xb) l (/ l s)))
  24.   (if (= l "t")(setq l (- m xb) l (/ l s)))
  25.   (setq schl 0 xchl 0)
  26. (MENUCMD "S=IN2")
  27.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  28. (MENUCMD "S=IN1")
  29.   (if (null yn)(setq yn "n" schl 0 xchl 0))
  30.   (if (or (= yn "y") (= yn "Y"))(progn
  31.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  32.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  33.                                  )
  34.   )
  35.   (setq angl 0 angr 0)
  36.    (setq angl (getreal "\n╫≤ ╡╣ ╜╟=:(15) "))
  37.   (if (null angl)(setq angl 15))
  38.   (if (and (/= angl 0) (/= angl 15))(progn
  39.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  40.   (if (null dgl)(setq dgl 0))
  41. ))
  42.   (if (= angl 0)(progn
  43.   (setq dgl (getreal "\n╫≤ ╡╣ ╘▓ ┴┐=:(0) "))
  44.   (if (null dgl)(setq dgl 0))
  45.   (if (/= dgl 0)(setq dgl (- 0 dgl)))
  46. ))
  47.   (setq angr (getreal "\n╙╥ ╡╣ ╜╟=:(15) "))
  48.   (if (null angr)(setq angr 15))
  49.   (if (and (/= angr 0) (/= angr 15))(progn
  50.   (setq dgr (getreal "\n╙╥ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  51.   (if (null dgr)(setq dgr 0))
  52. ))
  53.   (if (= angr 0)(progn
  54.   (setq dgr (getreal "\n╙╥ ╡╣ ╘▓ ┴┐=:(0) "))
  55.   (if (null dgr)(setq dgr 0))
  56.   (if (/= dgr 0)(setq dgr (- 0 dgr)))
  57. ))
  58. (MENUCMD "S=SP2")
  59.  (initget (+ 1 2 4))
  60. (setq yn (getint "\n╤í ╘± ┼Σ ║╧ ╛½ ╢╚(1:╛½├▄╝╢ 2:╥╗░π╝╢ 3:╜╧┤╓╝╢): "))
  61. (MENUCMD "S=SP3")
  62.  (initget (+ 1 2 4))
  63. (setq sc (getint "\n╤í ╘± ┼Σ ║╧ └α ╨═(1:╣╠╢¿┼Σ║╧ 2:╗¼╢»┼Σ║╧ 3:╜╧╦╔┼Σ║╧): "))
  64. (if (= yn 1)(setq chx (nth sc '(nil "JG" "JH1" "JH2"))))
  65. (if (= yn 2)(setq chx (nth sc '(nil "G" "H1" "H2"))))
  66. (if (= yn 3)(setq chx (nth sc '(nil "ZG" "ZH1" "ZH2"))))
  67. (MENUCMD "S=SP4")
  68. (initget 1 "o O i I")
  69. (setq m1 (getkword "\n═Γ ╛╢ ╢¿ ╨─(O) ╗≥ ─┌ ╛╢ ╢¿ ╨─(I): "))
  70.   (if (= m1 "o")(setq m1 "O"))
  71.   (if (= m1 "i")(setq m1 "I"))
  72. (setq dl1 dr dr1 dr l1 l dgl1 dgl dgr1 dgr)
  73. (setq dr (* (/ dr 2) s) dl dr dgl 0 dgr 0 l (* l s))
  74. (dbsa1 xb 1)
  75. (if (<= dr1 50)(setq kd (- dr1 4)))
  76. (if (and (<= dr1 108) (> dr1 50))(setq kd (- dr1 6)))
  77. (if (> dr1 108)(setq kd(- dr1 15)))
  78. (setq kd (* (/ kd 2) s))
  79. (if (or (= ed "l")(= ed "L"))
  80.  (setq tof (list (- xb l) (+ yb kd)) bof (list (- xb l) (- yb kd)) toe (list xb (+ yb kd)) boe (list xb (- yb kd)))
  81. (setq tof (list xb (+ yb kd)) bof (list xb (- yb kd)) toe (list (+ xb l) (+ yb kd)) boe (list (+ xb l) (- yb kd)))
  82.  )
  83. (command "line" tof toe "")
  84. (command "line" bof boe "")
  85. (command "layer" "s" "" "L" "hidden" "" "")
  86. (FN)
  87. (NK1)
  88. (attdef2)
  89. (attdef1 "nk1" nk fpt)
  90. (attdef1 "nzl1" nzl1 fpt)
  91. (attdef1 "gpsz1" "S" fpt)
  92. (attdef1 "ktype1" "S" fpt)
  93. (attdef1 "chx1" chx fpt)
  94. (attdef1 "bgch1" m1 fpt)
  95.  (if (or (= ed "l")(= ed "L"))
  96. (attdef1 "dir1" "F" fpt)
  97. (attdef1 "dir1" "H" fpt)
  98.     )
  99.  (if (or (= ed "l")(= ed "L"))
  100.   (setq w1 (list (- xb l) (- yb dr)) w2 (list xb (+ yb dr)))
  101.   (setq w1 (list xb (- yb dr)) w2 (list (+ xb l) (+ yb dr)))
  102.  )
  103.   (if (= nol no)
  104.  (command "block" no "Y" fpt "w" w1 w2 "")
  105.  (command "block" no fpt "w" w1 w2 "")
  106.   )
  107. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  108. (XB1)
  109. (MENUCMD "S=SCREEN")
  110. (MENUCMD "S=IN2")
  111. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡─┌▒φ├µ: "))
  112. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  113.  (PROGN(MENUCMD "I=nn")
  114.        (MENUCMD "I=*")
  115.  )
  116.  (MENUCMD "S=SCREEN")
  117. )
  118. )
  119. (HSPLINE)
  120.