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