home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / OTHOAX.LSP < prev    next >
Encoding:
Text File  |  1992-01-10  |  22.6 KB  |  607 lines
  1. (vmon)
  2.  
  3. (defun axerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command)
  8.    (if (> (atoi oldc) 0) (command "color" (atoi oldc)) (command "color" oldc))
  9.    (command "layer" "s" "0")
  10.    (setvar "blipmode" 1)
  11.    (setvar "cmdecho" 1)
  12.    (setvar "highlight" 1)
  13.    (setvar "regenmode" 1)
  14.    (setq *error* oer)
  15.    (princ)
  16. )
  17.  
  18. (defun instr(st s0 s00 / l n loop x n0 l0)
  19.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  20.    (while (and (<= n l) loop)
  21.       (setq x (substr s0 n0 1))
  22.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  23.    )
  24.    (eval l0)
  25. )
  26.  
  27.  
  28. (defun a_f(af / l0 sp ep)
  29.    (setq l0 (instr 1 af "-") nl nil)
  30.    (setq sp (substr af 1 (- l0 1)) ep (substr af (+ l0 1)))
  31.    (if (= (atoi sp) 0) (progn
  32.    (while (<= (ascii sp) (ascii ep))
  33.    (setq nl (cons sp nl))
  34.    (setq sp (chr (if (or (= (ascii sp) 72) (= (ascii sp) 78)) (+ (ascii sp) 2) (+ (ascii sp) 1))))
  35.    ))
  36.    (progn
  37.    (while (<= (atoi sp) (atoi ep))
  38.    (setq nl (cons sp nl))
  39.    (setq sp (itoa (1+ (atoi sp))))
  40.    )
  41.    ))
  42. )
  43.  
  44. (defun kjs(axn / l0 l1 ax nl)
  45.    (setq axn (strcase axn) axnl nil)
  46.    (if (and (= (instr 1 axn ",") 0) (> (strlen axn) 0))
  47.    (progn
  48.    (if (> (instr 1 axn "-") 0)
  49.        (progn
  50.        (a_f axn)
  51.        (setq axnl nl))
  52.        (setq axnl axn)
  53.    )
  54.    )
  55.    (progn
  56.    (setq l0 0 l1 (instr 1 axn ","))
  57.    (while (> (instr (+ l0 1) axn ",") 0)
  58.      (setq ax (substr axn (+ l0 1) (- l1 l0 1)))
  59.      (if (> (instr 1 ax "-") 0) (progn
  60.      (a_f ax)
  61.      (setq axnl (append nl axnl))
  62.      )
  63.      (setq axnl (cons ax axnl))
  64.      )
  65.      (setq l0 l1 l1 (instr (+ l0 1) axn ","))
  66.    )
  67.    (setq ax (substr axn (+ l0 1)))
  68.    (if (> (instr 1 ax "-") 0) (progn
  69.    (a_f ax)
  70.    (setq axnl (append nl axnl))
  71.    )
  72.    (setq axnl (cons ax axnl))
  73.    )
  74.    ))
  75.    (setq axnl (reverse axnl))
  76. )
  77.  
  78. (defun ddd(af / l0 sp ep)
  79.    (setq l0 (instr 1 af "*") nl nil)
  80.    (setq sp (substr af 1 (- l0 1)) ep (substr af (+ l0 1)))
  81.    (repeat (atoi sp)
  82.       (setq nl (cons (* (atof ep) 1000.0) nl))
  83.    )
  84. )
  85.  
  86. (defun eee(axd / l0 l1 ax nl)
  87.    (setq axdl nil)
  88.    (if (and (= (instr 1 axd ",") 0) (> (strlen axd) 0))
  89.    (progn
  90.    (if (> (instr 1 axd "*") 0)
  91.        (progn
  92.        (ddd axd)
  93.        (setq axdl nl))
  94.        (setq axdl (cons (* (atof axd) 1000.0) axdl))
  95.    )
  96.    )
  97.    (progn
  98.    (setq l0 0 l1 (instr 1 axd ","))
  99.    (while (> (instr (+ l0 1) axd ",") 0)
  100.      (setq ax (substr axd (+ l0 1) (- l1 l0 1)))
  101.      (if (> (instr 1 ax "*") 0) (progn
  102.      (ddd ax)
  103.      (setq axdl (append nl axdl))
  104.      )
  105.      (setq axdl (cons (* (atof ax) 1000.0) axdl))
  106.      )
  107.      (setq l0 l1 l1 (instr (+ l0 1) axd ","))
  108.    )
  109.    (setq ax (substr axd (+ l0 1)))
  110.    (if (> (instr 1 ax "*") 0) (progn
  111.    (ddd ax)
  112.    (setq axdl (append nl axdl))
  113.    )
  114.    (setq axdl (cons (* (atof ax) 1000.0) axdl))
  115.    )
  116.    ))
  117.    (setq axdl (reverse axdl))
  118. )
  119.  
  120. (defun combin(cb cc / l l0 dy)
  121.    (setq l (length cb) l0 0 dy 0 axndl nil)
  122.    (if (= l (+ (length cc) 1)) (progn
  123.    (repeat l
  124.       (setq axndl (cons (cons (nth l0 cb) dy) axndl))
  125.       (if (< l0 (length cc)) (setq dy (+ dy (nth l0 cc))))
  126.       (setq l0 (1+ l0))
  127.    )
  128.    (setq axndl (reverse axndl) fgerr nil)
  129.    )
  130.    (progn
  131.    (princ "*╓ß║┼╙δ╓ß╛α╕÷╩²▓╗╞Ñ┼Σ*")
  132.    (setq fgerr t))
  133.    )
  134. )
  135.  
  136. (defun chkerr(a / l)
  137.    (setq l (instr 1 a ","))
  138.    (if (or (= l 0) (= l 1) (= l (strlen a)))
  139.        (progn
  140.        (princ "*╩Σ╚δ┤φ╬≤*")
  141.        (setq fgerr t))
  142.        (setq fgerr nil))
  143. )
  144.  
  145. (setq sd 250)
  146.  
  147. (defun C:OTHOAX(/ east south west north edist sdist wdist ndist js1 js2 kj1 kj2 fgerr x axdl axnl axndl kw xoff yoff xmax ymax ltoff rtoff upoff dnoff sn d45 sn45 d225 ll ur ll5 ur5 ll6 ur6 ll2 ur2 ll3 ur3 ll8 ur8
  148.    x00 y00 x02 y02 x03 y03 x10 y10 x12 y12 x13 y13 x05 y05 x15 y15 x06 y06 x16 y16 x08 y08 x18 y18 oldc oer i l0 wdt sdt)
  149.    (setvar "blipmode" 0)
  150.    (setvar "cmdecho" 0)
  151.    (setvar "regenmode" 0)
  152.    (setq oldc (getvar "cecolor"))
  153.    (command "color" "bylayer")
  154.    (setq oer *error* *error* axerr)
  155.    (setq east nil south nil west nil north nil)
  156.    (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  157.    (princ "\n╫≤▒▀╓ß╛α <")
  158.    (princ "4*2.4")
  159.    (setq wdist (getstring ">:"))
  160.    (if (= wdist "") (setq wdist "4*2.4"))
  161.    (eee wdist)
  162.    (setq js1 (+ (length axdl) 1) fgerr t)
  163.    (setq i 1)
  164.    (while (<= i js1) (if (or (= (+ 64 i) 73) (= (+ 64 i) 79)) (setq js1 (+ js1 1))) (setq i (1+ i)))
  165.    (while fgerr
  166.    (princ "\n╫≤▒▀╓ß║┼ <")
  167.    (princ (strcat (setq west (strcat "A-" (chr (+ 64 js1)))) ">:"))
  168.    (setq x (getstring) west (if (/= x "") x west))
  169.    (kjs west)
  170.    (combin axnl axdl)
  171.    )
  172.    (setq west axndl wdt wdist wdist axdl)
  173.    (princ "\n╧┬▒▀╓ß╛α <")
  174.    (princ "6*3.6")
  175.    (setq sdist (getstring ">:"))
  176.    (if (= sdist "") (setq sdist "6*3.6"))
  177.    (eee sdist)
  178.    (setq kj1 (+ (length axdl) 1) fgerr t)
  179.    (while fgerr
  180.    (princ "\n╧┬▒▀╓ß║┼ <")
  181.    (princ (strcat (setq south (strcat "1-" (itoa kj1))) ">:"))
  182.    (setq x (getstring) south (if (/= x "") x south))
  183.    (kjs south)
  184.    (combin axnl axdl)
  185.    )
  186.    (setq south axndl sdt sdist sdist axdl)
  187.    (initget "Yes No")
  188.    (setq x (getkword "\n╢╘│╞ <Y>") kw (if (/= x "") x "Yes"))
  189.    (if (= kw "No") (progn
  190.    (setq fgerr t)
  191.    (while fgerr
  192.    (princ "\n╢╘│╞╓ß╬╗╥╞ <0,0>:")
  193.    (setq x (getstring))
  194.    (if (= x "") (setq x "0,0"))
  195.    (chkerr x)
  196.    )
  197.    (setq xoff (* 1000.0 (atof (substr x 1 (- (setq l0 (instr 1 x ",")) 1)))))
  198.    (setq yoff (* 1000.0 (atof (substr x (+ l0 1)))))
  199.    (princ "\n╙╥▒▀╓ß╛α <")
  200.    (princ wdt)
  201.    (setq edist (getstring ">:"))
  202.    (if (= edist "") (setq edist wdt))
  203.    (eee edist)
  204.    (setq js2 (+ (length axdl) 1) fgerr t)
  205.    (setq i 1)
  206.    (while (<= i js2) (if (or (= (+ 64 i) 73) (= (+ 64 i) 79)) (setq js2 (+ js2 1))) (setq i (1+ i)))
  207.    (while fgerr
  208.    (princ "\n╙╥▒▀╓ß║┼ <")
  209.    (princ (strcat (setq east (strcat "A-" (chr (+ 64 js2)))) ">:"))
  210.    (setq x (getstring) east (if (/= x "") x east))
  211.    (kjs east)
  212.    (combin axnl axdl)
  213.    )
  214.    (setq east axndl edist axdl)
  215.    (princ "\n╔╧▒▀╓ß╛α <")
  216.    (princ sdt)
  217.    (setq ndist (getstring ">:"))
  218.    (if (= ndist "") (setq ndist sdt))
  219.    (eee ndist)
  220.    (setq kj2 (+ (length axdl) 1) fgerr t)
  221.    (while fgerr
  222.    (princ "\n╔╧▒▀╓ß║┼ <")
  223.    (princ (strcat (setq north (strcat "1-" (itoa kj2))) ">:"))
  224.    (setq x (getstring) north (if (/= x "") x north))
  225.    (kjs north)
  226.    (combin axnl axdl)
  227.    )
  228.    (setq north axndl ndist axdl)
  229.    )
  230.    (setq xoff 0 yoff 0 east west north south edist wdist ndist sdist)
  231.    ) ;endif
  232.    (setq xmax (max (apply '+ sdist) (apply '+ ndist)))
  233.    (setq ymax (max (apply '+ wdist) (apply '+ edist)))
  234.    (princ "\n═Γ╟╜║± <")
  235.    (princ sd)
  236.    (setq x (getint ">:"))
  237.    (setq sd (if (eq x nil) sd x))
  238.    (princ "\n╓ß╧▀▓σ╚δ╡π:")
  239.    (command "insert" "border" "x" (+ (* 2 (+ d1 d7)) xmax) "y" (+ (* 2 (+ d1 d7)) ymax) "r" 0 pause)
  240.    (setq sn (entlast))
  241.    (setq ll (polar (cdr (assoc 10 (entget sn))) (setq d45 (dtr 45)) (/ (+ d1 d7) (setq sn45 (sin (dtr 45))))) d225 (dtr 225))
  242.    (entdel sn)
  243.    (setq ur (list (+ (car ll) xmax) (+ (cadr ll) ymax) (last ll)))
  244.    (othoax0)
  245.    (command "layer" "s" "0" "")
  246.    (if (> (atoi oldc) 0) (command "color" (atoi oldc)) (command "color" oldc))
  247.    (setvar "blipmode" 1)
  248.    (setvar "cmdecho" 1)
  249.    (setvar "highlight" 1)
  250.    (setvar "regenmode" 1)
  251.    (setq *error* oer)
  252.    (princ)
  253. )
  254.  
  255. (defun othoax0()
  256.    (cond ((> xoff 0) (setq xmax (max (apply '+ sdist) (+ xoff (apply '+ ndist))) dnoff 0 upoff xoff))
  257.          ((< xoff 0) (setq xmax (max (+ (abs xoff) (apply '+ sdist)) (apply '+ ndist)) dnoff (abs xoff) upoff 0))
  258.          (t (setq xmax (max (apply '+ sdist) (apply '+ ndist)) dnoff 0 upoff 0))
  259.    )
  260.    (cond ((> yoff 0) (setq ymax (max (apply '+ wdist) (+ yoff (apply '+ edist))) ltoff 0 rtoff yoff))
  261.          ((< yoff 0) (setq ymax (max (+ (abs yoff) (apply '+ wdist)) (apply '+ edist)) ltoff (abs yoff) rtoff 0))
  262.          (t (setq ymax (max (apply '+ wdist) (apply '+ edist)) ltoff 0 rtoff 0))
  263.    )
  264.    (setq ll0 (polar ll d225 (/ d1 sn45)))
  265.    (setq ur0 (polar ur d45 (/ d1 sn45)))
  266.    (setq ll5 (polar ll0 d225 (/ d5 sn45)))
  267.    (setq ur5 (polar ur0 d45 (/ d5 sn45)))
  268.    (setq ll6 (polar ll0 d225 (/ d6 sn45)))
  269.    (setq ur6 (polar ur0 d45 (/ d6 sn45)))
  270.    (setq ll2 (polar ll0 d225 (/ d2 sn45)))
  271.    (setq ur2 (polar ur0 d45 (/ d2 sn45)))
  272.    (setq ll3 (polar ll0 d225 (/ d3 sn45)))
  273.    (setq ur3 (polar ur0 d45 (/ d3 sn45)))
  274.    (setq ll8 (polar ll0 d225 (/ d8 sn45)))
  275.    (setq ur8 (polar ur0 d45 (/ d8 sn45)))
  276.    (command "layer" "m" "pdim" "c" 3 "" "")
  277.    (setq x00 (car ll0) y00 (cadr ll0) x02 (car ll2) y02 (cadr ll2))
  278.    (setq x03 (car ll3) y03 (cadr ll3))
  279.    (setq x10 (car ur0) y10 (cadr ur0) x12 (car ur2) y12 (cadr ur2))
  280.    (setq x13 (car ur3) y13 (cadr ur3))
  281.    (drw "W" west)
  282.    (drw "S" south)
  283.    (drw "E" east)
  284.    (drw "N" north)
  285.    (command "dim" "dimse1" "on" "dimse2" "on" "style" "standard")
  286.    (setq x05 (car ll5) y05 (cadr ll5) x15 (car ur5) y15 (cadr ur5))
  287.    (setq x06 (car ll6) y06 (cadr ll6) x16 (car ur6) y16 (cadr ur6))
  288.    (setq x08 (car ll8) y08 (cadr ll8) x18 (car ur8) y18 (cadr ur8))
  289.    (drwdim "W" west)
  290.    (drwdim "S" south)
  291.    (drwdim "E" east)
  292.    (drwdim "N" north)
  293.    (command "dimse1" "off" "dimse2" "off" "style" "hz" "exit")
  294.    (command "layer" "m" "paxis" "c" 1 "" "lt" "axis" "" "")
  295.    (drwaxis "W" west)
  296.    (drwaxis "S" south)
  297.    (drwaxis "E" east)
  298.    (drwaxis "N" north)
  299. )
  300.  
  301. (defun dtr(a)
  302.    (* (/ a 180.0) pi)
  303. )
  304.  
  305. (defun drw(fg cb / l n dx dy x ax sp ep ap)
  306.    (setq l (length cb))
  307.    (cond ((= fg "W") (setq n 0 dx (+ ltoff d1 y00))
  308.                      (repeat l
  309.                      (setq x (nth n cb) ax (car x) dy (+ dx (cdr x)))
  310.                      (setq sp (list x00 dy) ep (list x02 dy) ap (list x03 dy))
  311.                      (setq n (1+ n))
  312.                      (dr sp ep ap ax)
  313.                      ))
  314.        ((= fg "S") (setq n 0 dx (+ dnoff x00 d1))
  315.                    (repeat l
  316.                    (setq x (nth n cb) ax (car x) dy (+ dx (cdr x)))
  317.                    (setq sp (list dy y00) ep (list dy y02) ap (list dy y03))
  318.                    (setq n (+ n 1))
  319.                    (dr sp ep ap ax)
  320.                    ))
  321.        ((= fg "E") (setq n 0 dx (+ rtoff d1 y00))
  322.                    (repeat l
  323.                    (setq x (nth n cb) ax (car x) dy (+ dx (cdr x)))
  324.                    (setq sp (list x10 dy) ep (list x12 dy) ap (list x13 dy))
  325.                    (setq n (1+ n))
  326.                    (dr sp ep ap ax)
  327.                    ))
  328.         ((= fg "N") (setq n 0 dx (+ upoff d1 x00))
  329.                    (repeat l
  330.                    (setq x (nth n cb) ax (car x) dy (+ dx (cdr x)))
  331.                    (setq sp (list dy y10) ep (list dy y12) ap (list dy y13))
  332.                    (setq n (1+ n))
  333.                    (dr sp ep ap ax)
  334.                    ))
  335.          )
  336. )
  337.  
  338. (defun dr(stp edp axp axx /)
  339.    (if (> (strlen axx) 1)
  340.        (command "line" stp edp "" "insert" "axi" axp blx "" 0 axx)
  341.        (command "line" stp edp "" "insert" "axi0" axp blx "" 0 axx)
  342.    )
  343. )
  344.  
  345. (defun drwdim(fg cb / l n dy x x1 sp ep)
  346.    (setq l (length cb))
  347.    (cond ((= fg "W") (setq n 0 dy (+ ltoff d1 y00))
  348.                      (repeat (- l 1)
  349.                      (setq x (nth n cb) n (1+ n) x1 (nth n cb))
  350.                      (setq sp (list x05 (+ dy (cdr x))) ep (list x05 (+ dy (cdr x1))))
  351.                      (drdim sp ep 90)
  352.                      )
  353.                      (command "exit" "line" (list x00 (- dy sd)) (list x08 (- dy sd)) "")
  354.                      (command "line" (list x00 (+ dy (setq x (cdr (nth (- l 1) cb))) sd)) (list x08 (+ dy x sd)) "" "dim")
  355.                      (setq sp (list x06 (- dy sd)) ep (list x06 (+ dy x sd)))
  356.                      (setq n 1)
  357.                      (drdim sp ep 90)
  358.                      )
  359.          ((= fg "S") (setq n 0 dy (+ dnoff x00 d1))
  360.                      (repeat (- l 1)
  361.                      (setq x (nth n cb) n (1+ n) x1 (nth n cb))
  362.                      (setq sp (list (+ dy (cdr x)) y05) ep (list (+ dy (cdr x1)) y05))
  363.                      (drdim sp ep 0)
  364.                      )
  365.                      (command "exit" "line" (list (- dy sd) y00) (list (- dy sd) y08) "")
  366.                      (command "line" (list (+ dy sd (setq x (cdr (nth (- l 1) cb)))) y00) (list (+ dy sd x) y08) "" "dim")
  367.                      (setq sp (list (- dy sd) y06) ep (list (+ dy sd x) y06))
  368.                      (setq n 1)
  369.                      (drdim sp ep 0)
  370.                      )
  371.          ((= fg "E") (setq n 0 dy (+ rtoff d1 y00))
  372.                      (repeat (- l 1)
  373.                      (setq x (nth n cb) n (1+ n) x1 (nth n cb))
  374.                      (setq sp (list x15 (+ dy (cdr x))) ep (list x15 (+ dy (cdr x1))))
  375.                      (drdim sp ep 90)
  376.                      )
  377.                      (command "exit" "line" (list x10 (- dy sd)) (list x18 (- dy sd)) "")
  378.                      (command "line" (list x10 (+ dy sd (setq x (cdr (nth (- l 1) cb))))) (list x18 (+ dy x sd)) "" "dim")
  379.                      (setq sp (list x16 (- dy sd)) ep (list x16 (+ dy x sd)))
  380.                      (setq n 1)
  381.  
  382.                      (drdim sp ep 90)
  383.                      )
  384.          ((= fg "N") (setq n 0 dy (+ upoff x00 d1))
  385.                      (repeat (- l 1)
  386.                      (setq x (nth n cb) n (1+ n) x1 (nth n cb))
  387.                      (setq sp (list (+ dy (cdr x)) y15) ep (list (+ dy (cdr x1)) y15))
  388.                      (drdim sp ep 0)
  389.                      )
  390.                      (command "exit" "line" (list (- dy sd) y10) (list (- dy sd) y18) "")
  391.                      (command "line" (list (+ dy sd (setq x (cdr (nth (- l 1) cb)))) y10) (list (+ dy sd x) y18) "" "dim")
  392.                      (setq sp (list (- dy sd) y16) ep (list (+ dy sd x) y16))
  393.                      (setq n 1)
  394.                      (drdim sp ep 0)
  395.                      )
  396.    )
  397. )
  398.  
  399. (defun drdim(spp epp ra /)
  400.    (if (= n 1) (progn
  401.    (command "rotate" ra sp ep sp "")
  402.    )
  403.    (command "continue" ep "")
  404.    )
  405. )
  406.  
  407. (defun drwaxis(fg cb / l n dy x sp ep ax)
  408.    (setq l (length cb))
  409.    (cond ((= fg "W") (setq n 0 dy (+ ltoff d1 y00))
  410.                      (repeat l
  411.                      (setq x (nth n cb))
  412.                      (setq sp (list x00 (+ dy (cdr x))) ep (list x10 (+ dy (cdr x))))
  413.                      (draxis sp ep)
  414.                      (setq n (1+ n))
  415.                      ))
  416.           ((= fg "S") (setq n 0 dy (+ dnoff x00 d1))
  417.                       (repeat l
  418.                       (setq x (nth n cb))
  419.                       (setq sp (list (+ dy (cdr x)) y00) ep (list (+ dy (cdr x)) y10))
  420.                       (draxis sp ep)
  421.                        (setq n (1+ n))
  422.                       ))
  423.            ((= fg "E") (setq n 0 dy (+ rtoff d1 y00))
  424.                        (repeat l
  425.                        (setq ax (car (setq x (nth n cb))))
  426.                        (if (not (assoc ax west)) (progn
  427.                        (setq sp (list x10 (+ dy (cdr x))) ep (list x00 (+ dy (cdr x))))
  428.                        (draxis sp ep)
  429.                        ))
  430.                        (setq n (1+ n))
  431.                        ))
  432.            ((= fg "N") (setq n 0 dy (+ upoff d1 x00))
  433.                        (repeat l
  434.                        (setq ax (car (setq x (nth n cb))))
  435.                        (if (not (assoc ax south)) (progn
  436.                        (setq sp (list (+ dy (cdr x)) y10) ep (list (+ dy (cdr x)) y00))
  437.                        (draxis sp ep)
  438.                        ))
  439.                        (setq n (1+ n))
  440.                        ))
  441.        )
  442. )
  443.  
  444. (defun draxis(spp epp /)
  445.    (command "line" spp epp "")
  446. )
  447.  
  448. (defun C:INSTAX(/ midl mdist md1 axdl axnl axndl i j fgerr x x1 insp ang ang0 lp iang sn en sp ep ap ax dt ename mid kw l n dy oer oldc)
  449.    (setvar "highlight" 0)
  450.    (setvar "blipmode" 0)
  451.    (setvar "cmdecho" 0)
  452.    (setvar "regenmode" 0)
  453.    (setq midl nil oer *error* *error* axerr oldc (getvar "cecolor"))
  454.    (command "color" "bylayer")
  455.    (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  456.    (princ "\n╓ß╧▀╝Σ╛α <")
  457.    (princ "6*3.6")
  458.    (setq mdist (getstring ">:"))
  459.    (if (= mdist "") (setq mdist "6*3.6"))
  460.    (eee mdist)
  461.    (setq md1 (+ (length axdl) 1) fgerr t)
  462.    (setq i 1)
  463.    (while (<= i md1) (if (or (= (+ 64 i) 73) (= (+ 64 i) 79)) (setq md1 (+ md1 1))) (setq i (1+ i)))
  464.    (while fgerr
  465.    (princ "\n╩Σ╚δ╓ß║┼ <")
  466.    (princ (strcat (setq midl (strcat "A-" (chr (+ 64 md1)))) ">:"))
  467.    (setq x (getstring) midl (if (/= x "") x midl))
  468.    (kjs midl)
  469.    (combin axnl axdl)
  470.    )
  471.    (setq midl axndl mdist axdl)
  472.    (princ "\n═Γ╟╜║± <")
  473.    (princ sd)
  474.    (setq x (getint ">:"))
  475.    (setq sd (if (eq x nil) sd x))
  476.     (graphscr)
  477.     (initget 1)
  478.    (setq insp (getpoint "\n╓ß╧▀▓σ╚δ╡π:"))
  479.    (princ "\n╙δ╤í╧▀╞╜╨╨P/╙δ╤í╧▀┤╣╓▒C/╓ß╧▀╜╟╢╚ <45>:")
  480.    (initget "P C")
  481.    (setq ang (getangle insp))
  482.    (cond ((= ang nil) (setq ang (/ pi 4)))
  483.          ((= ang "P") (setq lp t)
  484.                       (while lp
  485.                       (setq sn (car (entsel "\n╤í╘±╓▒╧▀:")))
  486.                       (setq ename (cdr (assoc 0 (setq en (entget sn)))))
  487.                       (if (= ename "LINE") (progn
  488.                           (setq sp (cdr (assoc 10 en)) ep (cdr (assoc 11 en)))
  489.                           (setq ang (angle sp ep) dt (distance sp ep))
  490.                           (setq mid (polar sp ang (/ dt 2)))
  491.                           (grdraw sp mid 2)(grdraw mid (polar mid (+ ang (dtr 150)) (- d7 d2)) 2)
  492.                           (initget "Y N")
  493.                           (setq kw (getkword "\n╙δ╞≡╡π╧▀═¼╧≥ <N>:"))
  494.                           (if (or (= kw nil) (= kw "N")) (setq ang (+ ang pi)))
  495.                           (setq lp nil)
  496.                       ))
  497.                       ))
  498.          ((= ang "C") (setq lp t)
  499.                       (while lp
  500.                       (setq sn (car (entsel "\n╤í╘±╓▒╧▀:")))
  501.                       (setq ename (cdr (assoc 0 (setq en (entget sn)))))
  502.                       (if (= ename "LINE") (progn
  503.                           (setq sp (cdr (assoc 10 en)) ep (cdr (assoc 11 en)))
  504.                           (setq ang (angle sp ep) dt (distance sp ep))
  505.                           (setq mid (polar sp ang (/ dt 2)))
  506.                           (grdraw sp mid 2)(grdraw mid (polar mid (+ ang (dtr 150)) (- d7 d2)) 2)
  507.                           (initget "Y N")
  508.                           (setq kw (getkword "\n┤╙╞≡╡π╧▀╧≥╧┬ <N>:"))
  509.                           (if (or (= kw nil) (= kw "N")) (setq ang (+ ang (/ pi 2)))  (setq ang (- ang (/ pi 2))))
  510.                           (setq lp nil)
  511.                       ))
  512.                       ))
  513.           )
  514.     (if (and (> ang 0) (<= ang pi)) (setq ang0 -1.57079) (setq ang0 1.57079))
  515.     (command "layer" "m" "pdim" "c" "3" "" "")
  516.     (setq l (length midl) n 0)
  517.     (command "line" (setq sp (polar insp (- ang ang0) sd)) (polar sp ang d8) "")
  518.     (repeat l
  519.        (setq x (nth n midl) ax (car x) dy (cdr x))
  520.        (setq sp (polar insp (+ ang ang0) dy) ep (polar sp ang d2) ap (polar sp ang d3))
  521.        (dr sp ep ap ax)
  522.        (setq n (1+ n))
  523.     )
  524.     (command "line" (setq sp (polar sp (+ ang ang0) sd)) (polar sp ang d8) "")
  525.     (setq n 0 iang (/ (* 180 (+ ang ang0)) pi))
  526.     (command "dim" "dimse1" "on" "dimse2" "on" "style" "standard")
  527.     (repeat (- l 1)
  528.        (setq x (nth n midl) n (1+ n) x1 (nth n midl))
  529.        (setq sp (polar insp (+ ang ang0) (cdr x)) sp (polar sp ang d5))
  530.        (setq ep (polar insp (+ ang ang0) (cdr x1)) ep (polar ep ang d5))
  531.        (drdim sp ep iang)
  532.      )
  533.     (setq sp (polar insp (+ ang ang0) (cdr (nth 0 midl))) sp (polar sp ang d6) sp (polar sp (- ang ang0) sd))
  534.     (setq ep (polar insp (+ ang ang0) (cdr (nth (- l 1) midl))) ep (polar ep ang d6) ep (polar ep (+ ang ang0) sd))
  535.     (setq n 1)
  536.     (drdim sp ep iang)
  537.     (command "dimse1" "off" "dimse2" "off" "style" "hz" "exit")
  538.     (if (> (atoi oldc) 0) (command "color" (atoi oldc)) (command "color" oldc))
  539.     (command "layer" "s" 0 "")
  540.     (setvar "blipmode" 1)
  541.     (setvar "cmdecho" 1)
  542.     (setvar "highlight" 1)
  543.     (setvar "regenmode" 1)
  544.     (setq *error* oer)
  545.     (princ)
  546. )
  547.  
  548. (defun C:AUTOAX(/ oer ss ssl n pl ql west south east north wdist sdist edist ndist sn en ename sp ep ang n ll ur d45 sn45 d225 js1 i axdl axnl axndl ymax ymin xmax xmin kj1 xoff yoff ltoff rtoff upoff dnoff ll5 ur5 ll6 ur6 ll2 ur2
  549. ll3 ur3 ll8 ur8 x00 y00 x02 y02 x03 y03 x10 y10 x12 y12 x13 y13 x05 y05 x15 y15 x06 y06 x16 y16 x08 y08 x18 y18 ssa)
  550.    (setvar "cmdecho" 0)
  551.    (setvar "blipmode" 0)
  552.    (setvar "regenmode" 0)
  553.    (setq oldc (getvar "cecolor"))
  554.    (command "color" "bylayer")
  555.    (setq oer *error* *error* axerr)
  556.    (setq ss (ssget))
  557.    (if ss (progn
  558.    (setq ssl (sslength ss) n 0 pl nil ql nil west nil south nil wdist nil sdist nil ssa nil ssa (ssadd))
  559.    (repeat ssl
  560.       (setq sn (ssname ss n) en (entget sn))
  561.       (setq ename (cdr (assoc 0 en)))
  562.       (if (= ename "LINE") (progn
  563.       (setq sp (cdr (assoc 10 en)) ep (cdr (assoc 11 en)))
  564.       (setq ang (angle sp ep)) (ssadd sn ssa)
  565.       (if (and (or (= ang 0) (= ang pi)) (not (member (cadr sp) pl))) (setq pl (cons (cadr sp) pl)))
  566.       (if (and (or (= ang (* 0.5 pi)) (= ang (* 1.5 pi))) (not (member (car sp) ql))) (setq ql (cons (car sp) ql)))
  567.       ))
  568.       (setq n (1+ n))
  569.     )
  570.     (setq ll (list (setq xmin (apply 'min ql)) (setq ymin (apply 'min pl)) 0.0))
  571.     (setq ur (list (apply 'max ql) (apply 'max pl) 0.0))
  572.     (setq d45 (dtr 45) sn45 (sin (dtr 45)) d225 (dtr 225))
  573.     (setq js1 (length pl) i 1)
  574.     (while (<= i js1) (if (or (= (+ 64 i) 73) (= (+ 64 i) 79)) (setq js1 (+ js1 1))) (setq i (1+ i)))
  575.     (setq west (strcat "A-" (chr (+ 64 js1))))
  576.     (kjs west)(setq axdl nil)
  577.     (repeat (length pl)
  578.        (setq axdl (cons (- (setq ymax (apply 'max pl)) ymin) axdl))
  579.        (setq pl (subst '0 ymax pl))
  580.     )
  581.     (setq axdl (cdr axdl))
  582.     (setq n (1- (length axdl))) (repeat (1- (length axdl)) (setq axdl (subst (- (nth n axdl) (nth (1- n) axdl)) (nth n axdl) axdl) n (1- n)))
  583.     (combin axnl axdl)
  584.     (setq west axndl wdist axdl)
  585.     (setq kj1 (length ql))
  586.     (setq south (strcat "1-" (itoa kj1)))
  587.     (kjs south)(setq axdl nil)
  588.     (repeat (length ql)
  589.        (setq axdl (cons (- (setq xmax (apply 'max ql)) xmin) axdl))
  590.        (setq ql (subst '0 xmax ql))
  591.     )
  592.     (setq axdl (cdr axdl))
  593.     (setq n (1- (length axdl))) (repeat (1- (length axdl)) (setq axdl (subst (- (nth n axdl) (nth (1- n) axdl)) (nth n axdl) axdl) n (1- n)))
  594.     (combin axnl axdl)
  595.     (setq south axndl sdist axdl)
  596.     (setq east west edist wdist north south ndist sdist xoff 0 yoff 0)
  597.     (command "erase" ssa "") (othoax0)
  598.     ))
  599.     (if (> (atoi oldc) 0) (command "color" (atoi oldc)) (command "color" oldc))
  600.     (command "layer" "s" "0" "")
  601.     (setvar "cmdecho" 1)
  602.     (setvar "regenmode" 1)
  603.     (setvar "blipmode" 1)
  604.     (setq *error* oer)
  605.     (princ)
  606. )
  607.