home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / ZXY.LSP < prev   
Encoding:
Text File  |  1992-01-10  |  5.5 KB  |  170 lines
  1. (vmon)
  2.  
  3. (defun C:BLIP(/ oer ss ssl n sn en n1 p1 p2 sn1 en1 pt)
  4.    (setvar "OSMODE" 0)
  5.    (setvar "CMDECHO" 0)
  6.    (setq oer *error* *error* numerr)
  7.    (setq ss (ssget))
  8.    (if ss (progn
  9.    (setq ssl (sslength ss) n 0)
  10.    (command "layer" "m" "defpoints" "")
  11.    (repeat (1- ssl)
  12.       (setq sn (ssname ss n) en (entget sn) n (1+ n))
  13.       (if (and (= "LINE" (cdr (assoc 0 en))) (= "PAXIS" (cdr (assoc 8 en))))
  14.           (progn
  15.           (setq n1 n)
  16.           (setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)))
  17.           (repeat (- ssl n1)
  18.           (setq sn1 (ssname ss n1) en1 (entget sn1) n1 (1+ n1))
  19.           (cond ((and (= "LINE" (cdr (assoc 0 en1))) (= "PAXIS" (cdr (assoc 8 en1))))
  20.               (setq p3 (cdr (assoc 10 en1)) p4 (cdr (assoc 11 en1)))
  21.               (setq pt (inters p1 p2 p3 p4))
  22.               (if (/= pt nil)
  23.               (command "point" pt)
  24.               )
  25.               )
  26.           ((and (= "ARC" (cdr (assoc 0 en1))) (= "PAXIS" (cdr (assoc 8 en1))))
  27.             (setq cen (cdr (assoc 10 en1)) r (cdr (assoc 40 en1)))
  28.             (setq sa (cdr (assoc 50 en1)) ea (cdr (assoc 51 en1)))
  29.             (if (< (setq ma (- ea sa)) 0) (setq ea (+ sa (+ (* 2 pi) ma))))
  30.             (setq ang (angle p1 p2) pi2 (/ pi 2.0))
  31.             (setq int (inters p1 p2 cen (polar cen (+ ang pi2) 50) nil))
  32.             (if (equal int cen 0.1) (progn
  33.             (setq p3 (polar cen ang r) p4 (polar cen (+ ang pi) r))
  34.             (setq int1 (inters p1 p2 p3 (polar p3 (+ (/ pi 2.0) ang) 50) nil))
  35.             (setq int2 (inters p1 p2 p4 (polar p4 (+ (/ pi 2.0) ang) 50) nil))
  36.             (if (equal int1 p3 0.1)
  37.                 (command "circle" p3 300)
  38.             )
  39.             (if (equal int2 p4 0.1)
  40.                 (command "circle" p4 300)
  41.             ))
  42. ;           (progn ;else
  43. ;           (setq ang (angle p1 p2) sa (angle cen p2))
  44. ;           (setq ma (- ang sa))
  45. ;           (if (< ma 0) (setq ma (+ (* 2 pi) ma)))
  46. ;           (setq dist (distance cen p2))
  47. ;           (setq dist1 (* dist (sin ma)))
  48. ;           (setq chord (sqrt (- (* r r) (* dist1 dist1))))
  49. ;           (setq wkpt (polar cen (+ ang (/ pi 2.0)) dist1))
  50. ;           (setq p3 (polar wkpt ang chord) p4 (polar wkpt (+ ang pi) chord))
  51. ;           (setq sa1 (angle cen p3) ea1 (angle cen p4))
  52. ;           (if (and (>= sa1 sa) (<= sa1 ea))
  53. ;               (command "circle" p3 300)
  54. ;           )
  55. ;           (if (and (>= ea1 sa) (<= ea1 ea))
  56. ;               (command "circle" p4 300)
  57. ;
  58. ;           )
  59.            ) ;if
  60.           )
  61.           ); endcond
  62.           )
  63.           )
  64.        )
  65.     )
  66.     ))
  67.    (command "layer" "s" "0" "")
  68.    (setvar "CMDECHO" 1)
  69.    (setq *error* oer)
  70.    (princ)
  71. )
  72.  
  73. (defun C:RENUM(/ ss ssl n en en1 en2 sn sn1 at number nnmuber oer)
  74.    (setvar "CMDECHO" 0)
  75.    (setvar "BLIPMODE" 0)
  76.    (setq oer *error* *error* numerr)
  77.    (setq ss (ssget) ssl (sslength ss) n 0)
  78.    (command "layer" "m" "pdim" "")
  79.    (repeat ssl
  80.       (setq en (entget (setq sn (ssname ss n))))
  81.       (if (and (= "INSERT" (cdr (assoc 0 en))) (or (= "AXI" (cdr (assoc 2 en))) (= "AXI0" (cdr (assoc 2 en)))))
  82.       (progn
  83.       (setq insp (cdr (assoc 10 en)))
  84.       (setq en1 (entget (setq sn1 (entnext sn))))
  85.       (setq en2 (entget (entnext sn1)))
  86.       (princ "\n╩Σ╚δ╨▐╕─║≤╡─╓ß║┼ <")
  87.       (princ (setq number (cdr (assoc 1 en1))))
  88.       (setq nnumber (strcase (getstring ">:")))
  89.       (if (= nnumber "") (setq nnumber number))
  90.       (command "erase" sn "")
  91.       (if (> (strlen nnumber) 1)
  92.           (command "insert" "axi" insp blx "" 0 nnumber)
  93.           (command "insert" "axi0" insp blx "" 0 nnumber)
  94.       )
  95.       )
  96.       ) ;endif
  97.       (setq n (1+ n))
  98.     )
  99.     (command "layer" "s" "0" "")
  100.     (setvar "CMDECHO" 1)
  101.     (setvar "BLIPMODE" 1)
  102.     (setq *error* oer)
  103.     (princ)
  104. )
  105.  
  106. (defun C:INSNUM(/ sp ep number ins ang at oer)
  107.    (setvar "CMDECHO" 0)
  108.    (setq oer *error* *error* numerr)
  109.    (setq sp (getpoint "\n╓ß╧▀╞≡╡π:"))
  110.    (setq ep (getpoint sp "\n╓ß╧▀╓╒╡π:"))
  111.    (setq number (strcase (getstring "\n╩Σ╚δ╓ß╧▀║┼:")))
  112.    (setq ins (polar ep (setq ang (angle sp ep)) (* bl 4)))
  113.    (cond ((eq ang 0) (setq at 4))
  114.          ((eq ang (/ pi 2)) (setq at 8))
  115.          ((eq ang pi) (setq at 1))
  116.          ((eq ang (/ (* 3 pi) 2)) (setq at 2))
  117.          (t (setq at 2))
  118.    )
  119.    (command "layer" "m" "pdim" "")
  120.    (if (> (strlen number) 1)
  121.        (command "line" sp ep "" "insert" "axi" ins blx "" 0 number)
  122.        (command "line" sp ep "" "insert" "axi0" ins blx "" 0 number)
  123.    )
  124.    (command "layer" "s" "0" "")
  125.    (setvar "CMDECHO" 1)
  126.    (setq *error* oer)
  127.    (princ)
  128. )
  129.  
  130. (defun C:INSAXIS(/ oer sp ep)
  131.    (setvar "cmdecho" 0)
  132.    (setvar "blipmode" 0)
  133.    (command "color" "bylayer")
  134.    (setq oer *error* *error* numerr)
  135.    (command "layer" "m" "paxis" "c" "1" "paxis" "lt" "axis" "paxis" "")
  136.    (setq sp (getpoint "\n╞≡╡π:"))
  137.    (setq ep (getpoint sp "\n╓╒╡π:"))
  138.    (command "line" sp ep "")
  139.    (command "layer" "s" "0" "")
  140.    (setvar "blipmode" 1)
  141.    (setvar "cmdecho" 1)
  142.    (setq *error* oer)
  143.    (princ)
  144. )
  145.  
  146. (defun C:GRP(/ oer x ds)
  147.    (setvar "cmdecho" 0)
  148.    (setq oer *error* *error* numerr)
  149.    (princ "\n╩Σ╚δ═°╡π╛α└δ <")
  150.    (princ 600)
  151.    (setq x (getreal ">:"))
  152.    (if (= x nil) (setq ds 600) (setq ds x))
  153.    (command "grid" ds)
  154.    (command "snap" ds)
  155.    (setvar "cmdecho" 1)
  156.    (setq *error* oer)
  157.    (princ)
  158. )
  159.  
  160. (defun numerr(s)
  161.    (if (/= s "Function cancelled")
  162.        (princ (strcat "\nError: " s))
  163.    )
  164.    (command "layer" "s" "0" "")
  165.    (setvar "CMDECHO" 1)
  166.    (setvar "BLIPMODE" 1)
  167.    (setq *error* oer)
  168.    (princ)
  169. )
  170.