home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / MA1 / ACAD.LSP < prev    next >
Encoding:
Text File  |  1991-04-11  |  3.0 KB  |  110 lines
  1.  (SETQ NOL 0)
  2. (DEFUN CHECK (FUNCNAME FUNCNAME1)
  3. (CLEAN)
  4.  (SETQ FUNCNAME1 (STRCAT "\\HOUSEM\\LSP\\" FUNCNAME1))
  5.  (LOAD FUNCNAME1)
  6. )
  7. (DEFUN CHECK2 (FUNCNAME FUNCNAME1)
  8.  (CLEAN)
  9.  (SETQ FUNCNAME1 (STRCAT "\\HOUSEM\\LSP2\\" FUNCNAME1))
  10.  (LOAD FUNCNAME1)
  11. )
  12. (defun scale1 ()
  13. (SETVAR "CMDECHO" 0)
  14.   (MENUCMD "S=SC1")
  15.    (initget (+ 2 4))
  16.    (setq sc (getint "\n╟δ╩Σ╚δ▒╚└²╤í╘±: "))
  17.    (if (null sc)(setq sc 1))
  18.    (SETQ SCA SC)
  19.    (setq s (/ 0.05 sc))
  20.     (MENUCMD "S=SCREEN")
  21. )
  22. (defun scale2 ()
  23. (SETVAR "CMDECHO" 0)
  24.   (MENUCMD "S=SC1")
  25.    (initget (+ 2 4))
  26.    (setq sc (getREAL "\n╟δ╩Σ╚δ▒╚└²╤í╘±: "))
  27.    (if (null sc)(setq sc 1))
  28.    (setq s (/ 1 sc))
  29.     (MENUCMD "S=SCREEN")
  30. )
  31. (defun attdef1 (str1 str2 fpt)
  32. (SETVAR "CMDECHO" 0)
  33.   (command "attdef" "i" "" str1 "" str2 fpt 0.001 0)
  34. )
  35. (defun attdef2 ()
  36. (SETVAR "CMDECHO" 0)
  37.   (attdef1 "dl1" dl1 fpt)
  38.   (attdef1 "dr1" dr1 fpt)
  39.   (attdef1 "l1" l1 fpt)
  40.   (attdef1 "schl1" schl fpt)
  41.   (attdef1 "xchl1" xchl fpt)
  42.   (attdef1 "angl1" angl fpt)
  43.   (attdef1 "dgl1" dgl1 fpt)
  44.   (attdef1 "angr1" angr fpt)
  45.   (attdef1 "dgr1" dgr1 fpt)
  46. )
  47. (defun dbsa1 (xb sl)
  48. (SETVAR "CMDECHO" 0)
  49.   (setq tg 0)
  50.   (if (/= angl 0)(setq tg (/ (cos (* (/ 3.14 180) angl)) (sin (* (/ 3.14 180) angl)))))
  51.   (if (= sl 0)(setq atl (* tg dgl))(setq atl (- 0 (* tg dgl))))
  52.   (if (/= angr 0)(setq tg (/ (cos (* (/ 3.14 180) angr)) (sin (* (/ 3.14 180) angr)))))
  53.   (if (= sl 0)(setq atr (* tg dgr))(setq atr (- 0 (* tg dgr))))
  54.   (setq topl (list (+ xb dgl) (+ yb dl)))
  55.   (setq botl (list (+ xb dgl) (- yb dl)))
  56.   (setq tof (list xb (- (+ yb dl) atl)))
  57.   (setq bof (list xb (+ (- yb dl) atl)))
  58.   (setq topr (list (- (+ xb l) dgr) (+ yb dr)))
  59.   (setq botr (list (- (+ xb l) dgr) (- yb dr)))
  60.   (setq toe (list (+ xb l) (- (+ yb dr) atr)))
  61.   (setq boe (list (+ xb l) (+ (- yb dr) atr)))
  62.   (if (or (= ed "l")(= ed "L"))
  63.     (progn
  64.   (setq topr (list (- xb dgr) (+ yb dr)))
  65.   (setq botr (list (- xb dgr) (- yb dr)))
  66.   (setq toe (list xb (- (+ yb dr) atr)))
  67.   (setq boe (list xb (+ (- yb dr) atr)))
  68.   (setq topl (list (+ (- xb l) dgl) (+ yb dl)))
  69.   (setq botl (list (+ (- xb l) dgl) (- yb dl)))
  70.   (setq tof (list (- xb l) (- (+ yb dl) atl)))
  71.   (setq bof (list (- xb l) (+ (- yb dl) atl)))
  72.   (command "layer" "n" "f2" "s" "f2" "color" "m" "" "")
  73.      )
  74.    )
  75.   (command "line" tof bof botl topl tof topl topr toe boe botr topr botr botl "")
  76. )
  77. (defun C:HOTAL ()
  78.   (command "layer" "n" "f2" "s" "f2" "color" "m" "" "")
  79.   (if (/= dir1 "H")(setq m xb xb xf))
  80. )
  81. (defun point1 ()
  82.   (initget 1)
  83.    (setq pt1 (getpoint "\n▒Ω╫ó╡π: "))
  84. )
  85. (DEFUN FN ()
  86.   (if (or (= ed "l")(= ed "L"))
  87.     (SETQ FPT (LIST (- XB L) YB) NO (1+ NO))
  88.      (SETQ FPT (LIST XB YB) NO (+ NO 1))
  89.   )
  90.  (COND ((= NO 0) (SETQ XF XB)))
  91. )
  92. (DEFUN NK1 ()
  93.  (SETQ NK (+ NK 1))
  94. )
  95. (DEFUN NZ1 ()
  96.  (SETQ NZL (+ NZL 1))
  97. )
  98. (DEFUN XB1 ()
  99.    (IF (OR (= ED "L")(= ed "l"))
  100.       (SETQ XB (- XB L))
  101.       (SETQ XB (+ XB L))
  102.      )
  103. )
  104. (DEFUN CL ()
  105.  (SETQ XF (CAR B1))
  106. )
  107. (defun CLEAN ()
  108.    (setq atomlist (member 'C:CLEAN atomlist))
  109. )
  110.