home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 2.ddi / LPM / LT1.LSP next >
Encoding:
Text File  |  1991-09-22  |  8.5 KB  |  288 lines
  1. (DEFUN QLT(T1);1989-10-15;1991-9-21
  2.     (SETVAR "CMDECHO" 0)
  3.     (SETVAR "OSMODE" 0)
  4.     (GRAPHSCR)
  5.     (IF (= T1 1)
  6.         (IF (NOT (EQUAL (GETVAR "CLAYER") "PLT"))
  7.             (COMMAND "LAYER" "M" "PLT" ""))
  8.         (IF (NOT (EQUAL (GETVAR "CLAYER") "LTJ"))
  9.             (COMMAND "LAYER" "M" "LTJ" ""))
  10.     )
  11.     (INITGET 1)
  12. (SETQ A (GETPOINT "Please input first point:"))
  13.     (INITGET 1)
  14. (SETQ B (GETPOINT A "Please input other point:"))
  15.     (INITGET 6)
  16. (SETQ M (GETINT "Please input number of risers<9>: "))
  17.     (IF (= M nil) (SETQ M 9))
  18.     (IF (= T1 1)
  19.         (PROGN
  20.         (INITGET 6)
  21.         (SETQ LH (GETREAL "Please input height<1000>: "))
  22.         (IF (= LH nil) (SETQ LH 1000))
  23.         )
  24.     )
  25. )
  26. (DEFUN C:LT1();1989-10-15;1991-9-21
  27.     (QLT 1)
  28. (SETQ F (ANGLE A B))
  29. (SETQ D (DISTANCE A B))
  30. (SETQ AH (* D (SIN F)))
  31. (SETQ AL1 (* D (COS F)))
  32. (SETQ L (/ AL1 M))
  33. (PRIN1 L)
  34. (SETQ H (/ AH M))
  35. (PRIN1 H)
  36. (SETQ N 1)
  37. (while (<= n m)
  38. (setq nn (- n 1))
  39. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  40. (setq a2 (list (+ (car a) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  41. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  42. (setq a4 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (cadr a2)))
  43. (setq a5 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (+ (cadr a2) lh)))
  44. (command "line" a1 a2 a3 "")
  45. (command "line" a4 a5 "")
  46. (if (= n 1) (setq a6 a5))
  47. (if (= n 1) (progn
  48.     (command "dim")
  49.     (command "dimse1" "off" "dimse2" "off")
  50. (command "exit")
  51. (command "dim1" "ali" a1 a2 (list (- (car a1) 400) (cadr a1)) "")
  52. (command "dim1" "ali" a2 a3 (list (car a2) (+ (cadr a2) 400)) "")
  53.         )
  54. )
  55. (command "line" a5 a6 "")
  56. (setq a6 a5)
  57. (setq n (+ n 1))
  58. )
  59. )
  60. (DEFUN C:LT2( );1989-10-15;
  61.     (QLT 1)
  62. (SETQ N 1)
  63. (setq f (angle a b))
  64. (setq d (distance a b))
  65. (setq ah (* d (sin f)))
  66. (setq al1 (* d (cos f)))
  67. (setq h (/ ah m))
  68. (setq l (/ al1 m))
  69. (while (<= n m)
  70. (setq nn (- n 1))
  71. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  72. (setq a2 (list (+ (- (car a) 70) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  73. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  74. (setq a4 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (cadr a2)))
  75. (setq a5 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (+ (cadr a2) lh)))
  76. (command "line" a1 a2 a3 "")
  77. (command "line" a4 a5 "")
  78. (if (= n 1) (setq a6 a5))
  79. (if (= n 1) (progn
  80.     (command "dim" "dimse1" "off" "dimse2" "off")
  81.     (command "exit")
  82. (command "dim1" "ali" (list (car a2) (cadr a1)) a2 (list (- (car a2) 300) (cadr a2)) "")
  83. (command "dim1" "ali" a2 a3 (list (car a2) (+ (cadr a2) 300)) "")
  84.     )
  85. )
  86. (command "line" a5 a6 "")
  87. (setq a6 a5)
  88. (setq n (+ n 1))
  89. )
  90. )
  91. (DEFUN C:LT3( );1989-10-15;
  92.     (QLT 1)
  93. (SETQ N 1)
  94. (setq f (angle a b))
  95. (setq d (distance a b))
  96. (setq ah (* d (sin f)))
  97. (setq al1 (* d (cos f)))
  98. (setq h (/ ah m))
  99. (setq l (/ al1 m))
  100. (while (<= n m)
  101. (setq nn (- n 1))
  102. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  103. (setq a2 (list (+ (car a) (* nn l)) (+ (- (cadr a) 60) (* (+ nn 1) h))))
  104. (setq a3 (list (+ (- (car a) 60) (* nn l)) (+ (- (cadr a) 60) (* (+ nn 1) h))))
  105. (setq a4 (list (+ (- (car a) 60) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  106. (setq a5 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  107. (setq a6 (list (+ (car a4) (/ (- (car a5) (car a4)) 2)) (cadr a4)))
  108. (setq a7 (list (+ (car a4) (/ (- (car a5) (car a4)) 2)) (+ (cadr a4) lh)))
  109. (command "line" a1 a2 a3 a4 a5 "")
  110. (command "line" a6 a7 "")
  111. (if (= n 1) (setq a8 a7))
  112. (if (= n 1) (progn
  113.     (command "dim" "dimse1" "off" "dimse2" "off")
  114.     (command "exit")
  115. (command "dim1" "ali" (list (car a4) (cadr a1)) a4 (list (- (car a4) 300) (car a4)) "")
  116.     (command "dim1" "ali" a4 a5 (list (car a4) (+ (cadr a4) 300)) "")
  117.     )
  118. )
  119. (command "line" a7 a8 "")
  120. (setq a8 a7)
  121. (setq n (+ n 1))
  122. )
  123. )
  124. (DEFUN C:LT4( );1989-10-15;
  125.     (QLT 1)
  126. (SETQ F (ANGLE A B))
  127. (SETQ D (DISTANCE A B))
  128. (SETQ AH (* D (SIN F)))
  129. (SETQ AL1 (* D (COS F)))
  130. (SETQ L (/ AL1 M))
  131. (PRIN1 L)
  132. (SETQ H (/ AH M))
  133. (PRIN1 H)
  134. (SETQ N 1)
  135. (while (<= n m)
  136. (setq nn (- n 1))
  137. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  138. (setq a2 (list (+ (car a) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  139. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  140. (setq a4 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (cadr a2)))
  141. (setq a5 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (+ (cadr a2) lh)))
  142. (command "trace" 20 a1 a2 a3 "")
  143. (command "line" a4 a5 "")
  144. (if (= n 1) (setq a6 a5))
  145. (if (= n 1) (progn
  146.     (command "dim")
  147.     (command "dimse1" "off" "dimse2" "off")
  148. (command "exit")
  149. (command "dim1" "ali" a1 a2 (list (- (car a1) 400) (cadr a1)) "")
  150. (command "dim1" "ali" a2 a3 (list (car a2) (+ (cadr a2) 400)) "")
  151.         )
  152. )
  153. (command "line" a5 a6 "")
  154. (setq a6 a5)
  155. (setq n (+ n 1))
  156. )
  157. )
  158. (DEFUN C:LT5( );1989-10-15;
  159.     (QLT 1)
  160. (SETQ N 1)
  161. (setq f (angle a b))
  162. (setq d (distance a b))
  163. (setq ah (* d (sin f)))
  164. (setq al1 (* d (cos f)))
  165. (setq h (/ ah m))
  166. (setq l (/ al1 m))
  167. (while (<= n m)
  168. (setq nn (- n 1))
  169. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  170. (setq a2 (list (+ (- (car a) 70) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  171. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  172. (setq a4 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (cadr a2)))
  173. (setq a5 (list (+ (car a2) (/ (- (car a3) (car a2)) 2)) (+ (cadr a2) lh)))
  174. (command "trace" 20 a1 a2 a3 "")
  175. (command "line" a4 a5 "")
  176. (if (= n 1) (setq a6 a5))
  177. (if (= n 1) (progn
  178.     (command "dim" "dimse1" "off" "dimse2" "off")
  179.     (command "exit")
  180. (command "dim1" "ali" (list (car a2) (cadr a1)) a2 (list (- (car a2) 300) (cadr a2)) "")
  181. (command "dim1" "ali" a2 a3 (list (car a2) (+ (cadr a2) 300)) "")
  182.     )
  183. )
  184. (command "line" a5 a6 "")
  185. (setq a6 a5)
  186. (setq n (+ n 1))
  187. )
  188. )
  189. (DEFUN C:LT6( );1989-10-15;
  190.     (QLT 1)
  191. (SETQ N 1)
  192. (setq f (angle a b))
  193. (setq d (distance a b))
  194. (setq ah (* d (sin f)))
  195. (setq al1 (* d (cos f)))
  196. (setq h (/ ah m))
  197. (setq l (/ al1 m))
  198. (while (<= n m)
  199. (setq nn (- n 1))
  200. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  201. (setq a2 (list (+ (car a) (* nn l)) (+ (- (cadr a) 60) (* (+ nn 1) h))))
  202. (setq a3 (list (+ (- (car a) 60) (* nn l)) (+ (- (cadr a) 60) (* (+ nn 1) h))))
  203. (setq a4 (list (+ (- (car a) 60) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  204. (setq a5 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  205. (setq a6 (list (+ (car a4) (/ (- (car a5) (car a4)) 2)) (cadr a4)))
  206. (setq a7 (list (+ (car a4) (/ (- (car a5) (car a4)) 2)) (+ (cadr a4) lh)))
  207. (command "trace" 20 a1 a2 a3 a4 a5 "")
  208. (command "line" a6 a7 "")
  209. (if (= n 1) (setq a8 a7))
  210. (if (= n 1) (progn
  211.     (command "dim" "dimse1" "off" "dimse2" "off")
  212.     (command "exit")
  213. (command "dim1" "ali" (list (car a4) (cadr a1)) a4 (list (- (car a4) 300) (car a4)) "")
  214.     (command "dim1" "ali" a4 a5 (list (car a4) (+ (cadr a4) 300)) "")
  215.     )
  216. )
  217. (command "line" a7 a8 "")
  218. (setq a8 a7)
  219. (setq n (+ n 1))
  220. )
  221. )
  222. (DEFUN C:TJPO1( );1989-10-15;
  223.     (QLT 0)
  224. (SETQ F (ANGLE A B))
  225. (SETQ D (DISTANCE A B))
  226. (SETQ AH (* D (SIN F)))
  227. (SETQ AL1 (* D (COS F)))
  228. (SETQ L (/ AL1 M))
  229. (SETQ H (/ AH M))
  230. (SETQ N 1)
  231. (while (<= n m)
  232. (setq nn (- n 1))
  233. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  234. (setq a2 (list (+ (car a) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  235. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  236. (command "line" a1 a2 a3 "")
  237. (setq n (+ n 1))
  238. )
  239. )
  240. (DEFUN C:TJPO2( );1989-10-15;
  241.     (QLT 0)
  242. (SETQ F (ANGLE A B))
  243. (SETQ D (DISTANCE A B))
  244. (SETQ AH (* D (SIN F)))
  245. (SETQ AL1 (* D (COS F)))
  246. (SETQ L (/ AL1 M))
  247. (SETQ H (/ AH M))
  248. (SETQ N 1)
  249. (while (<= n m)
  250. (setq nn (- n 1))
  251. (setq a1 (list (+ (car a) (* nn l)) (+ (cadr a) (* nn h))))
  252. (setq a2 (list (+ (car a) (* nn l)) (+ (cadr a) (* (+ nn 1) h))))
  253. (setq a3 (list (+ (car a) (* (+ nn 1) l)) (+ (cadr a) (* (+ nn 1) h))))
  254. (command "trace" 20 a1 a2 a3 "")
  255. (setq n (+ n 1))
  256. )
  257. )
  258.  
  259.  
  260. (defun C:YSG();1989-2-24;1991-9-21
  261.     (SETVAR "CMDECHO" 0)
  262.     (SETVAR "OSMODE" 0)
  263.     (GRAPHSCR)
  264.     (IF (NOT (EQUAL (GETVAR "CLAYER") "LYT"))
  265.         (COMMAND "LAYER" "M" "LYT" ""))
  266.     (INITGET 1)
  267. (setq a (getpoint "Please input first point:"))
  268.     (INITGET 6)
  269. (setq b1 (getdist a "Please input DIST or second point<3000>: "))
  270. (if (= b1 nil) (setq b1 3000))
  271. (setq b (polar a (* pi -0.5) b1))
  272. (setq fab (angle a b))
  273. (setq fa1 (- fab 1.57079633))
  274. (setq dx (* 75 (cos fa1)))
  275. (setq dy (* 75 (sin fa1)))
  276. (setq a1 (list (+ (car a) dx) (+ (cadr a) dy)))
  277. (setq b1 (list (+ (car b) dx) (+ (cadr b) dy)))
  278. (setq fa1 (+ fab 1.57079633))
  279. (setq dx (* 75 (cos fa1)))
  280. (setq dy (* 75 (sin fa1)))
  281. (setq a2 (list (+ (car a) dx) (+ (cadr a) dy)))
  282. (setq b2 (list (+ (car b) dx) (+ (cadr b) dy)))
  283. (command "insert" (strcat "j2k" (chr 92) "ysg") a 1 1 0)
  284. (command "line" a1 b1 "")
  285. (command "line" a2 b2 "")
  286. (command "line" b1 b2 "")
  287. )
  288.