;bmad_to_autocad.lsp
;originally: 
;I-----------ERL-ring.LSP----------I
;I   Created by Valeri Medjidzade  I
;I         vm30@cornell.edu        I
;I           OCTOBER, 2009         I
;I----------------o----------------I
;
;
(defun err (s)
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (restoreVars)
  (setq *error* olderr)
  (princ)
)
;------------------
(defun saveVars (varList / val)
  (foreach var varList
    (if (setq val (getvar var))    ;if it's a valid sysem variable then 
                                   ;get its value and add it to the list
      (setq varList2 (cons (cons var val) varList2))
    )
  )
  (reverse varList2)
)
;------------------
(defun restoreVars ( / )
  (foreach mode varList2
    (setvar (car mode) (cdr mode))
  )
  (setq varList2 nil)
)
;------------------
(setq olderr *error*
      *error* err)
(saveVars (list "orthomode" "osmode" "blipmode" "cmdecho"))
;------------------
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
;-----------------------
;-----------------------------
;-----------------------------
(defun replacein ( nameb / nn aa blen bb)
 (setq nn 1 aa 1 blblname "" blen (strlen nameb))
 (while aa
   (setq bb (substr nameb nn 1))
   (if (or (equal bb "/") (equal bb "\\")) (setq bb "!"))
   (setq blblname (strcat blblname bb) nn (1+ nn))
   (if (> nn blen) (setq aa nil))
 )
 blblname
)
;-------------------------------
(defun replaceout ( nameb / )
 (setq nn 1 aa 1 blblname "" blen (strlen nameb))
 (while aa
   (setq bb (substr nameb nn 1))
   (if (equal bb "!") (setq bb "/"))
   (setq blblname (strcat blblname bb) nn (1+ nn))
   (if (> nn blen) (setq aa nil))
 )
)
;-------------------------------
(defun extrinfo ( / )
 (setq aa 1 nn (1+ nn) sn nn) 
 (while aa
   (setq bb (substr lin1 nn 1))
   (if (equal "," bb) (setq wrdname (substr lin1 sn (- nn sn)) aa nil) (setq nn (1+ nn)))
 )
 (remspacr wrdname)
)
;-------------------------------
(defun extfinalinfo ( / )
 (setq nn (1+ nn) sn nn) 
 (while (< nn (1+ strlength))
   (setq bb (substr lin1 nn 1))
   (if (= nn strlength) (setq wrdname (substr lin1 sn (- (1+ nn) sn)) nn (1+ nn)) (setq nn (1+ nn)))
 )
 (remspacr wrdname)
)
;-------------------------------
(defun remspacr (strng / )
  (setq nnn 1 strnglngth (strlen strng) nstrng "")
  (while (< nnn (1+ strnglngth))
    (setq bbb (substr strng nnn 1))
    (if (equal " " bbb) (setq nnn (1+ nnn)) (setq nstrng (strcat nstrng bbb) nnn (1+ nnn)))
  )
)
;-------------------------------
(defun layset ( / )
  (if (tblsearch "layer" layname) 
          (command "-layer" "s" layname "") 
          (command "-layer" "n" layname "" 
                   "-layer" "s" layname "")
  )
  (if (equal nil (tblsearch "layer" laytxt)) 
          (command "-layer" "n" laytxt "") 
  )
)
;-------------------------------
(defun lat-name ( loc angle txtname)
 (command "text" "j" "mr" loc "0.05" angle txtname
          "chprop" (entlast) "" "la" laytxt "")
)
;--------------------------------
(defun asin (arg / )
   (atan (/ arg (sqrt (- 1 (* arg arg)))))
)
;---------------------------------------
(defun centline-pt ( / pts)
  (setq pts (polar pte 0pi lengval))
  (command "color" "9"
           "circle" pte prad)
  (ssadd (entlast) ss)
  (command "circle" pts prad)
  (ssadd (entlast) ss)
  (command "line" pte pts "")
  (ssadd (entlast) ss)
)
;--------------------------------
;(defun chamb-line-straight ( / pt11 pt22 pts)
;  (setq pt11 (polar pte pi2 x2lim)
;        pts (polar pte 0pi lengval)
;        pt22 (polar pts (- pi2) x1lim)
;  )
;  (command "color" "7"
;           "rectang" pt11 pt22)
;  (setq ss (ssadd))
;  (ssadd (entlast) ss)
;  (command "color" "9"
;           "circle" pte prad)
;  (ssadd (entlast) ss)
;  (command "circle" pts prad)
;  (ssadd (entlast) ss)
;  (command "line" pte pts "")
;  (ssadd (entlast) ss)
;)
;---------------------------------------
;--------------------------------
; ELEMENTS BUILDING FUNCTIONS
;--------------------------------
(defun bsbend ( / ) ;radius hangle hanglen hhord katet hwid apangl dangl apangr dangr ptc 
; pten pt0n pt0 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17 pt18 ss pta ptb e1)
  (command "color" "1")
  (setq hwid (* 2.5 a))
  (if (> lengval 0.001)
    (progn
      (if (/= bendang 0.0)
        (progn
          (setq radius (/ lengval (abs bendang)) 
                hangle (* 0.5 (abs bendang))
                hbendang (* 0.5 bendang)
                hanglen (/ (- lengval a) radius 2.0)
                blrotang (+ thetaang (/ (* 180.0 hbendang) 0pi))
                lsangl (+ 0pi hanglen)
                rsangl (- hanglen)
          )
          (setq hhord (* radius (sin hangle)) katet (* radius (cos hangle)))
          (setq apangl (+ pi2 hanglen (- e1val)) dangl (+ apangl 0pi)
                apangr (+ pi2 (- hanglen) e2val) dangr (+ apangr 0pi)
                r1 (+ radius hwid) 
                r2 (- radius hwid)
          )
          (if (> (abs e1val) 1.0E-08)
              (setq alfl (- 0pi (abs e1val)) 
                 rhol (abs e1val)
                 epsill (asin (/ (* (sin alfl) radius) r1))
                 betal (- 0pi alfl epsill)
                 htopl (/ (* radius (sin betal)) (sin epsill))
                 deltl (- 0pi (asin (/ (* (sin rhol) radius) r2)))
                 gamal (- 0pi deltl rhol)
                 hbotl (/ (* radius (sin gamal)) (sin deltl))
              )
              (setq htopl hwid hbotl hwid)
          )
          (if (> (abs e2val) 1.0E-08)
              (setq alfr (- 0pi (abs e2val)) 
                 rhor (abs e2val)
                 epsilr (asin (/ (* (sin alfr) radius) r1))
                 betar (- 0pi alfr epsilr)
                 htopr (/ (* radius (sin betar)) (sin epsilr))
                 deltr (- 0pi (asin (/ (* (sin rhor) radius) r2)))
                 gamar (- 0pi deltr rhor)
                 hbotr (/ (* radius (sin gamar)) (sin deltr))
              )
              (setq htopr hwid hbotr hwid)
          )
          (setq pt0 (polar pte 0pi (* 2 hhord))
                pt2 (polar (polar pte 0pi hhord) pi2 (- radius katet)) 
                ptc (polar pt2 (- pi2) radius)
                pt3 (polar pt2 pi2 hwid)
                pt4 (polar pt2 (- pi2) hwid)
                pten (polar ptc (- pi2 hanglen) radius)
                pt0n (polar ptc (+ pi2 hanglen) radius)
                pt5 (polar pt0n apangl htopl)
                pt6 (polar pt0n dangl hbotl)
                pt7 (polar pten apangr htopr)
                pt8 (polar pten dangr hbotr)
                pt9 (polar pten dangr (* 2 a (/ hbotr hwid)))
                pt10 (polar pt9 rsangl a)
                pt11 (polar pten apangr (* 2 a (/ htopr hwid)))
                pt12 (polar pt11 rsangl a)
                pt13 (polar pt0n dangl (* 2 a (/ hbotl hwid)))
                pt14 (polar pt13 lsangl a)
                pt15 (polar pt0n apangl (* 2 a (/ htopl hwid)))
                pt16 (polar pt15 lsangl a)
          )
          (command "pline" pt6 pt5 "a" "s" pt3 pt7 "l" pt8 "a" "ce" ptc pt6 "")
          (setq ss (ssadd))
          (ssadd (entlast) ss)
          (command "pline" pt9 pt10 pt12 pt11 ""
                   "fillet" "r" (* a 0.4)
                   "fillet" "p" (entlast)
          )
          (ssadd (entlast) ss)
          (command "pline" pt13 pt14 pt16 pt15 ""
                   "fillet" "r" (* a 0.4)
                   "fillet" "p" (entlast)
          )
          (ssadd (entlast) ss)          
          (command "color" "9"
                   "circle" pte prad)
          (ssadd (entlast) ss)
          (command "circle" pt0 prad)
          (ssadd (entlast) ss)
          (command "arc" pte pt2 pt0)
          (ssadd (entlast) ss)
          (if (< bendang 0.0) 
              (command "mirror" ss "" pte pt0 "y")
          )
          (command "color" "1")
          (lat-name pttxt -90 nametxt)
          (command "-block" blockname pte ss (entlast) ""
                   "-insert" blockname pte "" "" blrotang
                   "color" "bylayer"
          )
        )
        (progn
          (setq apangl (+ pi2 (- e1val)) dangl (+ apangl 0pi)
                apangr (+ pi2 e2val) dangr (+ apangr 0pi)
                swidl (/ hwid (cos e1val)) swidr (/ hwid (cos e2val))
          )
          (setq pt0 (polar pte 0pi lengval)
                pt2 (polar pte 0pi (* 0.5 lengval)) 
                pt3 (polar pt2 pi2 hwid)
                pt4 (polar pt2 (- pi2) hwid)
                pten (polar pte 0pi (* 0.5 a))
                pt0n (polar pt0 0 (* 0.5 a))
                pt5 (polar pt0n apangl swidl)
                pt6 (polar pt0n dangl swidl)
                pt7 (polar pten apangr swidr)
                pt8 (polar pten dangr swidr)
                pt9 (polar pten dangr (* 2 a))
                pt10 (polar pt9 0 a)
                pt11 (polar pten apangr (* 2 a))
                pt12 (polar pt11 0 a)
                pt13 (polar pt0n apangl (* 2 a))
                pt14 (polar pt13 0pi a)
                pt15 (polar pt0n dangl (* 2 a))
                pt16 (polar pt15 0pi a)
          )
          (command "pline" pt6 pt5 pt7 pt8 pt6 "")
          (setq ss (ssadd))
          (ssadd (entlast) ss)
          (command "pline" pt9 pt10 pt12 pt11 ""
                   "fillet" "r" (* a 0.4)
                   "fillet" "p" (entlast)
          )
          (ssadd (entlast) ss)
          (command "pline" pt13 pt114 pt16 pt15 ""
                   "fillet" "r" (* a 0.4)
                   "fillet" "p" (entlast)
          )
          (ssadd (entlast) ss)          
          (command "color" "9"
                   "circle" pte prad)
          (ssadd (entlast) ss)
          (command "circle" pt0 prad)
          (ssadd (entlast) ss)
          (command "line" pte pt0 "")
          (ssadd (entlast) ss)
          (command "color" "1")
          (lat-name pttxt -90 nametxt)
          (command "-block" blockname pte ss (entlast) ""
                   "-insert" blockname pte "" "" thetaang
                   "color" "bylayer"
          )
        )
      )
    )
    (progn
      (setq pta (polar pte pi2 hwid) ptb (polar pte (- pi2) hwid))
      (command "line" pta ptb "")
      (setq ss (ssadd))
      (ssadd (entlast) ss)
      (command "color" "9"
               "circle" pte prad)
      (ssadd (entlast) ss)
      (command "color" "1")
      (lat-name pttxt -90 nametxt)
      (command "-block" blockname pte e1 (entlast) ""
               "-insert" blockname pte "" "" thetaang
               "color" "bylayer"
      )
    )     
  )
)
;--------------------------------
(defun bmarker ( / bsize pt1 pt2 ss)
  (setq bsize (* 2 a)
        pt1 (polar pte (* 0.25 0pi) bsize)
        pt2 (polar pte (- (* 0.25 0pi)) bsize)
  )
  (command "color" "7"
           "line" pt1 (polar pt1 (* 1.25 0pi) (* 2 bsize)) "")
  (setq ss (ssadd))
  (ssadd (entlast) ss)
  (command "line" pt2 (polar pt2 (* 0.75 0pi) (* 2 bsize)) "")
  (ssadd (entlast) ss)
  (command "color" "9"
           "circle" pte prad)
  (ssadd (entlast) ss)
  (command "color" "7")
  (lat-name pttxt -90 nametxt)
  (command "-block" blockname pte ss (entlast) ""
          "-insert" blockname pte "" "" thetaang
          "color" "bylayer"
  )
)
;--------------------------------
(defun bdrift ( / pt1 pt2 pts ss)
  (setq pt1 (polar pte pi2 x2lim)
        pts (polar pte 0pi lengval)
        pt2 (polar pts (- pi2) x1lim)
  )
  (command "color" "7"
           "rectang" pt1 pt2)
  (setq ss (ssadd))
  (ssadd (entlast) ss)
  (centline-pt)
  (command "color" "7")
  (lat-name pttxt -90 nametxt)
  (command "-block" blockname pte ss (entlast) ""
          "-insert" blockname pte "" "" thetaang
          "color" "bylayer"
  )
)
;----------------------------------
(defun bpipe ( / pt1 pt2 pts ss)
  (setq pt1 (polar pte pi2 x2lim)
        pts (polar pte 0pi lengval)
        pt2 (polar pts (- pi2) x1lim)
  )
  (command "color" "7"
           "rectang" pt1 pt2)
  (setq ss (ssadd))
  (ssadd (entlast) ss)
  (centline-pt)
  (command "color" "7")
  (lat-name pttxt -90 nametxt)
  (command "-block" blockname pte ss (entlast) ""
          "-insert" blockname pte "" "" thetaang
          "color" "bylayer"
  )
)
;--------------------------------
(defun binstrument ( / pt1 pt2 pts ss)
  (setq pt1 (polar pte pi2 0.125)
        pts (polar pte 0pi lengval)
        pt2 (polar pts (- pi2) 0.125)
  )
  (command "color" "31"
           "rectang" pt1 pt2)
  (setq ss (ssadd))
  (ssadd (entlast) ss)
  (centline-pt)
  (command "color" "31")
  (lat-name pttxt -90 nametxt)
  (command "-block" blockname pte ss (entlast) ""
          "-insert" blockname pte "" "" thetaang
          "color" "bylayer"
  )
)
;--------------------------------

(defun blcavity ( / n ss e1 e2 e3 e4 hlc vl  r1  r2  a2 pt0 pt1 pt2 pt3 pt4 pt5 pt6 pta ptb)
 (command "color" "3")
 (if (> lengval 0.001)
   (progn
     (setq hlc (/ lengval 2 ncel) vl (* 0.25 a) r1 (* 0.3 hlc) r2 (* 0.7 hlc) a2 (/ a 2.0))
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pt0 pi2 a2) 
           pt2 (polar pt0 pi2 (+ a2 r1))
           pt3 (polar (polar pt0 0 r1) pi2 (+ a2 r1 vl))
           pt4 (polar (polar pt0 0 hlc) pi2 (+ a2 r1 vl r2)) 
           pt5 (polar pt0 0 hlc) 
           pt6 (polar pt0 0 (* 2 hlc))
     )
     (command "pline" pt0 pt1 "a" "ce" pt2 "a" "90" "l" pt3 "a" pt4 "")
     (setq e1 (entlast))
     (command "mirror" e1 "" pt0 pt5 "")
     (setq e2 (entlast))
     (command "mirror" e1 "" pt4 pt5 "")
     (setq e3 (entlast))
     (command "mirror" e2 "" pt4 pt5 "")
     (setq e4 (entlast))
     (command "pedit" e1 "j" e2 e3 e4 "" "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (setq n 1)
     (setvar "copymode" 1)
     (while (< n ncel)
       (command "copy" (entlast) "" pt0 pt6)
       (ssadd (entlast) ss)
       (setq n (1+ n))
     )
     (centline-pt)
     (command "color" "3")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
      (setq pta (polar pte pi2 (* 2 a)) ptb (polar pte (- pi2) (* 2 a)))
      (command "line" pta ptb "")
      (setq ss (ssadd))
      (ssadd (entlast) ss)
      (command "color" "9"
               "circle" pte prad)
      (ssadd (entlast) ss)
      (command "color" "3")
      (lat-name pttxt -90 nametxt)
      (command "-block" blockname pte e1 (entlast) ""
               "-insert" blockname pte "" "" thetaang
               "color" "bylayer"
     )
   )
 )
)
;-------------------------------
(defun bquadrupole ( / ss e1 e2 pten ptc pt0n pt0 pt1 pt2 pt4 pt5 pt6 pt7 pt8 pta ptb)
 (command "color" "4")
 (if (> lengval 0.001)
   (progn
     (setq pten (polar pte 0pi (* 0.25 a))
           pt0 (polar pte 0pi lengval)
           pt0n (polar pt0 0 (* 0.25 a))
           pt1 (polar pt0n (- pi2) (* 2.78 a)) 
           pt2 (polar pten pi2 (* 2.78 a)) 
           ptc (polar pte 0pi (* 0.5 lengval))
           pt4 (polar ptc pi2 (* 2.78 a)) 
           pt5 (polar pten pi2 (* 0.12 a)) 
           pt6 (polar pten pi2 (* 1.05 a)) 
           pt7 (polar pten pi2 (* 1.24 a))   
           pt8 (polar pt7 0 (* 0.93 a)) 
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "pline" pt5 "a" "ce" pt6 "a" "90" "l" pt8 "a" "ce" pt7 "a" "90" "")
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" ptc pt4 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt0 pte "")
     (setq e2 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e2 "" ptc pt4 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "4")          
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
      (setq pta (polar pte pi2 (* 2.78 a)) ptb (polar pte (- pi2) (* 2.78 a)))
      (command "line" pta ptb "")
      (setq ss (ssadd))
      (ssadd (entlast) ss)
      (command "color" "9"
               "circle" pte prad)
      (ssadd (entlast) ss)
      (command "color" "4")
      (lat-name pttxt -90 nametxt)
      (command "-block" blockname pte e1 (entlast) ""
               "-insert" blockname pte "" "" thetaang
               "color" "bylayer"
     )
   )
 )
)
;----------------------------------------
(defun bsextupole ( / ss e1 e2 e3 e4 pten pt0n pt0 pt1 pt2 pt4 pt5 pt6 pt7 pt9 pt9 pt10 pt11 pt12 pta ptb)
 (command "color" "2")
 (if (> lengval 0.0)
   (progn
     (setq pten (polar pte 0pi (* 0.15 a))
           pt0 (polar pte 0pi lengval)
           pt0n (polar pt0 0 (* 0.15 a))
           pt1 (polar pt0n (- pi2) (* 2.6 a))   
           pt2 (polar pten pi2 (* 2.6 a)) 
           pt4 (polar pten pi2 (* 0.86 a))
           pt5 (polar pt4 0 (* 0.08 a))
           pt6 (polar pt5 pi2 (* 0.57 a))
           pt7 (polar pt4 pi2 (* 1.14 a))
           pt8 (polar pten 0 (* 0.65 a))
           pt9 (polar pt8 pi2 (* 0.09 a))
           pt10 (polar pten pi2 (* 0.09 a))
           pt11 (polar pte 0pi (* 0.5 lengval))
           pt12 (polar pt11 pi2 (* 0.86 a))
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "pline" pt4 pt5 "a" "ce" pt6 "a" "180" "l" pt7 "")
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "pline" pt8 pt9 "a" "ce" pt10 "a" "90" "")
     (setq e2 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt11 pt12 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt0 pte "")
     (setq e3 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e3 "" pt11 pt12 "")
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt11 pt12 "")
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt0 pte "")
     (setq e4 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e4 "" pt11 pt12 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "2") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
      (setq pta (polar pte pi2 (* 2.6 a)) ptb (polar pte (- pi2) (* 2.6 a)))
      (command "line" pta ptb "")
      (setq ss (ssadd))
      (ssadd (entlast) ss)
      (command "color" "9"
               "circle" pte prad)
      (ssadd (entlast) ss)
      (command "color" "2")
      (lat-name pttxt -90 nametxt)
      (command "-block" blockname pte e1 (entlast) ""
               "-insert" blockname pte "" "" thetaang
               "color" "bylayer"
     )
   )
 )
)
;--------------------------------------------
(defun boctupole ( / ss e1 e2 e3 e4 pten pt0n pt0 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt9 pt9 pt10 pt11 pta ptb)
 (command "color" "6")
 (if (> lengval 0.0)
   (progn
     (setq pten (polar pte 0pi (* 0.125 a))
           pt0 (polar pte 0pi lengval)
           pt0n (polar pt0 0 (* 0.125 a))
           pt1 (polar pt0n (- pi2) (* 1.43 a))      
           pt2 (polar pten pi2 (* 1.43 a))
           pt3 (polar pte 0pi (* 0.5 lengval))
           pt4 (polar pten pi2 (* 0.15 a))
           pt5 (polar (polar pten pi2 (* 0.45 a)) 0 (* 0.3 a))
           pt6 (polar pten pi2 (* 0.75 a))
           pt7 (polar pten pi2 (* 0.97 a))
           pt8 (polar pt7 0 (* 0.17 a))
           pt9 (polar pt8 pi2 (* 0.26 a))
           pt10 (polar pten pi2 (* 1.23 a))
           pt11 (polar pt3 pi2 (* 1.43 a))
     )
     (command "color" "6"
              "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "arc" pt4 pt5 pt6)
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "pline" pt7 pt8 "a" "a" "180" pt9 "l" pt10 "")
     (setq e2 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt3 pt11 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt0 pte "")
     (setq e3 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e3 "" pt3 pt11 "")
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt3 pt11 "")
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt0 pte "")
     (ssadd (entlast) ss)
     (setq e4 (entlast))
     (command "mirror" e4 "" pt3 pt11 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "6") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 1.43 a)) ptb (polar pte (- pi2) (* 1.43 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "6")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bsolenoid ( / ss e1 pt0 pt1 pt2 pt3 pt4 pt5 pt6 pta ptb)
 (command "color" "7")
 (if (> lengval 0.0)
   (progn
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pt0 (- pi2) (* 2.0 a))      
           pt2 (polar pte pi2 (* 2.0 a))
           pt3 (polar pt0 pi2 (* 2.0 a))
           pt4 (polar pte pi2 (* 0.5 a))
           pt5 (polar pt0 pi2 (* 0.5 a))
           pt6 (polar pt0 0 1.0)
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "pline" pt3 pt4 pt5 pt2 "")
     (ssadd (entlast) ss)
     (setq e1 (entlast))
     (command "mirror" e1 "" pt0 pt6 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 2.0 a)) ptb (polar pte (- pi2) (* 2.0 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
;-----------------------------
(defun bhkicker ( / ss e1 e2 e3 pts pta ptb pt0 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8)
 (command "color" "1")
 (if (> lengval 0.0)
   (progn
     (setq pt0 (polar pte 0pi (- lengval (* 0.15 a)))
           pts (polar pte 0pi (* 0.15 a))
           pt1 (polar pt0 (- pi2) (* 1.5 a))      
           pt2 (polar pts pi2 (* 1.5 a))
           pt3 (polar pts pi2 (* 1.05 a))
           pt4 (polar (polar pt3 pi2 (* 0.15 a)) 0 (* 0.15 a))
           pt5 (polar pt4 pi2 (* 0.3 a))
           pt6 (polar pt2 pi2 (* 0.15 a))
           pt7 (polar pte 0pi (* 0.5 lengval))
           pt8 (polar pt7 pi2 (* 1.65 a))
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "pline" pt3 "a" "a" "90" pt4 "l" pt5 "a" pt6 "l" pt8 "")
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt7 pt8 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pte pt0 "")
     (setq e2 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt7 pt8 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "1") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 1.5 a)) ptb (polar pte (- pi2) (* 1.5 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "1")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e3 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;-----------------------------
(defun bvkicker ( / ss e1 pta ptb pt0 pt1 pt2 pt3 pt4)
 (command "color" "1")
 (if (> lengval (* 0.4 a))
   (progn
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pte pi2 (* 0.6 a))      
           pt2 (polar pt0 (- pi2) (* 0.6 a))
           pt3 (polar pt1 0pi (* 0.15 a))
           pt4 (polar (polar pt0 0 (* 0.15 a)) pi2 (* 1.5 a))
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "rectang" pt3 pt4)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" pte pt0 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "1") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 1.5 a)) ptb (polar pte (- pi2) (* 1.5 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "1")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bkicker ( / ss e1 e2 e3 pta ptb pt0 pt1 pt2 pt3 pt3a pt4 pt4a pt5 pt6 pt7 pt8)
 (command "color" "1")
 (if (> lengval (* 0.4 a))
   (progn
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pte pi2 (* 0.6 a))      
           pt2 (polar pt0 (- pi2) (* 0.6 a))
           pt3 (polar pt1 0pi (* 0.15 a))
           pt4 (polar (polar pt0 0 (* 0.15 a)) pi2 (* 1.5 a))
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "rectang" pt3 pt4)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" pte pt0 "")
     (ssadd (entlast) ss)

     (setq pt3a (polar pt3 pi2 (* 0.45 a))
           pt4a (polar (polar pt3a pi2 (* 0.15 a)) 0 (* 0.15 a))
           pt5 (polar pt4a pi2 (* 0.3 a))
           pt6 (polar pt3a pi2 (* 0.6 a))
           pt7 (polar pte 0pi (* 0.5 lengval))
           pt8 (polar pt7 pi2 (* 1.65 a))
     )
     (command "pline" pt3a "a" "a" "90" pt4a "l" pt5 "a" pt6 "l" pt8 "")
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pt7 pt8 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pte pt0 "")
     (setq e2 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e2 "" pt7 pt8 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "1") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 1.5 a)) ptb (polar pte (- pi2) (* 1.5 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "1")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e3 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
;--------------------------------
(defun bvacuumgauge ( / ss e1 pta ptb pt0 pt1 pt2 pt3 pt4 ptc)
 (command "color" "7")
 (if (> lengval 0.006)
   (progn
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pt0 (- pi2) a)      
           pt2 (polar pte pi2 a)
           ptc (polar pte 0pi (* 0.5 lengval))
           pt3 (polar ptc 0pi 0.005)
           pt4 (polar pt3 0 0.013)
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "circle" ptc "d" 0.07)
     (ssadd (entlast) ss)
     (command "circle" ptc "d" 0.056)
     (ssadd (entlast) ss)
     (command "circle" ptc "d" 0.03)
     (ssadd (entlast) ss)
     (command "circle" pt3 "d" 0.01)
     (ssadd (entlast) ss)
     (command "circle" pt4 "d" 0.006)
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 a) ptb (polar pte (- pi2) a))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bbpm ( / ss e1 pta ptb pt0 pt1 pt2 pt3 pt4 ptc pt5 pt6 pt7 pt8)
 (command "color" "7")
 (if (> lengval 0.005)
   (progn
     (setq pt0 (polar pte 0pi lengval)
           pt1 (polar pt0 (- pi2) a)      
           pt2 (polar pte pi2 a)
           ptc (polar pte 0pi (* 0.5 lengval))
           pt3 (polar ptc pi2 0.014)
           pt4 (polar ptc pi2 a)
           pt5 (polar pt4 0 0.03)
           pt6 (polar (polar pt4 0pi 0.03) pi2 0.007)
           pt7 (polar pt6 0 0.035)
           pt8 (polar (polar pt7 0pi 0.01) pi2 0.018)
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "circle" ptc "d" 0.06)
     (ssadd (entlast) ss)
     (command "circle" pt3 "d" 0.01)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" pte pt0 "")
     (ssadd (entlast) ss)
     (command "rectang" pt5 pt6)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" pte pt0 "")
     (ssadd (entlast) ss)
     (command "rectang" pt7 pt8)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" pte pt0 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 a) ptb (polar pte (- pi2) a))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bslidingjoint ( / ss e1 b pta ptb pt0 pt1 pt2 pt3 pt4 ptc pt5 pt6 pt7 pt8)
 (command "color" "7")
 (if (> lengval (* 0.3 a))
   (progn
     (setq b (/ (- lengval (* 0.2 a)) 10)
           pt0 (polar pte 0pi lengval)
           pt1 (polar pte pi2 a)      
           pt2 (polar pt1 0pi (* 0.1 a))
           ptc (polar pte 0pi (* 0.5 lengval))
           pt3 (polar pt2 (- pi2) (* 2.0 a))
           pt4 (polar (polar pt2 (- pi2) (* 0.2 a)) 0pi b)
           pt5 (polar pt2 0pi (* 2 b))
           pt6 (polar pt4 0pi (* 2 b))
           pt7 (polar pt5 0pi (* 2 b))
           pt8 (polar pt6 0pi (* 2 b))
     )
     (command "rectang" pt1 pt3)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" ptc pt8 "")
     (ssadd (entlast) ss)
     (command "pline" pt2 pt4 pt5 pt6 pt7 pt8 "")
     (setq e1 (entlast))
     (ssadd (entlast) ss)
     (command "mirror" e1 "" ptc pt8 "")
     (ssadd (entlast) ss)
     (command "mirror" e1 "" pte pt0 "")
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" ptc pt8 "")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 a) ptb (polar pte (- pi2) a))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bgatevalve ( / ss e1 r1 pta ptb pt0 pt1 pt2 pt3 pt4 ptc pt5)
 (command "color" "7")
 (if (> lengval (* 0.4 a))
   (progn
     (setq r1 (/ (- lengval (* 0.2 a)) 2)
           pt0 (polar pte 0pi lengval)
           ptc (polar pte 0pi (* 0.5 lengval))
           pt1 (polar ptc pi2 (* 2.0 a))      
           pt2 (polar pt1 0 r1)
           pt3 (polar pt2 (- pi2) (* 1.2 a))
           pt4 (polar pte (- pi2) (* 0.8 a))
           pt5 (polar (polar ptc 0pi r1) (- pi2) (* 2.0 a))
     )
     (command "rectang" pt2 pt5)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "rectang" pt3 pt4)
     (ssadd (entlast) ss)
     (command "mirror" (entlast) "" ptc pt1 "")
     (ssadd (entlast) ss)
     (command "circle" ptc r1)
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7") 
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 2.0 a)) ptb (polar pte (- pi2) (* 2.0 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;-------------------------------
(defun bcollimator ( / ss e1 pta ptb pt0 pt1 pt2 pt3 pt4)
 (command "color" "6")
 (if (> lengval 0.0)
   (progn
     (setq colwid 0.3                            ;COLLIMATOR RADIUS: colwid = 0.3 m
           pt0 (polar pte 0pi lengval)
           pt1 (polar pte pi2 0.005)      
           pt2 (polar pt0 (- pi2) 0.005)     
           pt3 (polar pte pi2 colwid)      
           pt4 (polar pt0 (- pi2) colwid)    
     )
     (command "rectang" pt3 pt4)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "rectang" pt1 pt2)
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "6")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 a) ptb (polar pte (- pi2) a))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "6")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bpumpport ( / ss e1 r1 pta ptb ptc pt0 pt1 pt2)
 (command "color" "7")
 (if (> lengval 0.0)
   (progn
     (setq r1 (* 0.8 a)
           pt0 (polar pte 0pi lengval)
           ptc (polar pte 0pi (* 0.5 lengval))
           pt1 (polar pte pi2 (* 0.5 a))      
           pt2 (polar pt0 (- pi2) (* 0.5 a))
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "circle" ptc r1)
     (ssadd (entlast) ss)
     (command "circle" ptc "d" a)
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 a) ptb (polar pte (- pi2) a))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "7")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
(defun bwiggler ( / ss n txtang ptxt1 raystring raytext poleleng swdth pwdth ptc pt0 pt1 pt2 pt3 pt4 pt5 pt6)
 (command "color" "5")
 (if (> lengval 0.0)
   (progn
     (if (= numbpoles 0) (setq poleleng lengval) (setq poleleng (/ lengval numbpoles)))
     (setq swdth (* 0.25 poleleng)
           pwdth (* 0.5 poleleng)
           pt0 (polar pte 0pi lengval)
           ptc (polar pte 0pi (* 0.5 lengval))
           pt1 (polar pte pi2 (* 2.0 a))      
           pt2 (polar pt0 (- pi2) (* 2.0 a))
           pt3 (polar (polar pt0 0 (+ swdth pwdth)) pi2 (* 1.2 a))
           pt4 (polar (polar pt0 0 swdth) (- pi2) (* 1.2 a))
           pt5 (polar pt0 0 poleleng)
     )
     (command "rectang" pt1 pt2)
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "rectang" pt3 pt4)
     (ssadd (entlast) ss)
     (setq n 1)
     (setvar "copymode" 1)
     (while (< n numbpoles)
       (command "copy" (entlast) "" pt0 pt5)
       (ssadd (entlast) ss)
       (setq n (1+ n))
     )
     (setq pt6 (polar ptc 0 xraylngth)
           raystring (rtos xraylngth 2 1)
           raytext (strcat "L = " raystring " m")
     )
     (if (and (< (abs thetaang) 270.0) (> (abs thetaang) 90.0))
         (setq ptxt1 (polar pt6 (- pi2) (* 3.0 a))
               txtang "180"
         )
         (setq ptxt1 (polar pt6 pi2 (* 3.0 a))
               txtang "0"
         ) 
     )
     (command "pline" ptc "w" (* 1.0 a) "" pt6 "w" 0.0 "" "")
     (ssadd (entlast) ss)
     (command "text" "j" "c" ptxt1 "0.1" txtang raytext)
     (ssadd (entlast) ss)  
     (command "circle" pt6 "4.5")
     (ssadd (entlast) ss)
     (centline-pt)
     (command "color" "5")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte ss (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
   (progn
     (setq pta (polar pte pi2 (* 2 a)) ptb (polar pte (- pi2) (* 2 a)))
     (command "line" pta ptb "")
     (setq ss (ssadd))
     (ssadd (entlast) ss)
     (command "color" "9"
              "circle" pte prad)
     (ssadd (entlast) ss)
     (command "color" "5")
     (lat-name pttxt -90 nametxt)
     (command "-block" blockname pte e1 (entlast) ""
              "-insert" blockname pte "" "" thetaang
              "color" "bylayer"
     )
   )
 )
)
;--------------------------------
;--------------------------------
;--------------------------------
(defun lat-elem ( / )
 (setq nn 1 aa 1 strlength (strlen lin1))
 (while aa
   (setq bb (substr lin1 nn 1))
   (if (equal "," bb) (setq wrdname (substr lin1 1 (1- nn)) aa nil) (setq nn (1+ nn)))
 )
 (remspacr wrdname)
 (setq layname (replacein nstrng))
 (extrinfo)
 (setq elename nstrng blkname (replacein nstrng))
 (extrinfo)
 (setq indexx nstrng)
 (extrinfo)
 (setq xcoor (atof nstrng))
 (extrinfo)
 (setq ycoor (atof nstrng))
 (extrinfo)
 (setq zcoor (atof nstrng))
 (extrinfo)
 (setq thetaang (/ (* 180.0 (atof nstrng)) 0pi))
 (extrinfo)
 (setq phiang (atof nstrng))
 (extrinfo)
 (setq psiang (atof nstrng))
 (extrinfo)
 (setq elemkey nstrng)
 (extrinfo)
 (setq lengval (atof nstrng))
 (extrinfo)
 (setq x1lim (atof nstrng))
 (cond
    ((equal elemkey "SBEND") 
        (progn
          (extrinfo)
          (setq x2lim (atof nstrng))         
          (extrinfo)
          (setq bendang (atof nstrng))
          (extrinfo)
          (setq e1val (atof nstrng))
          (extfinalinfo)
          (setq e2val (atof nstrng))
         ))
    ((equal elemkey "WIGGLER") 
        (progn
          (extrinfo)
          (setq x2lim (atof nstrng))             
          (extrinfo)
          (setq numbpoles (atoi nstrng))
          (extfinalinfo)
          (setq xraylngth (atof nstrng))
         ))
    ((equal elemkey "LCAVITY") 
        (progn
          (extrinfo)
          (setq x2lim (atof nstrng))             
          (extfinalinfo)
          (setq ncel (atoi nstrng))
         ))
    (T (progn
          (extfinalinfo)
          (setq x2lim (atof nstrng))
        ))
 )
 (setq pte (list zcoor xcoor)
       pttxt (polar (polar pte 0pi (* 0.5 lengval)) pi2 (* 5 a))
       nametxt (strcat elename ":" indexx)
       blockname (strcat blkname "-" indexx)
       laytxt (strcat layname "_name")
 )
 (if (< x1lim 0.0127) (setq x1lim 0.0127))
 (if (< x2lim 0.0127) (setq x2lim 0.0127))
 (layset)
)
;-----------------------------------
;-----------------------------------
; PROGRAM STARTS HERE
;-----------------------------------
;-----------------------------------
(setq flname (getfiled "Select an map_table file" "c:/My Custom/" "map_table" 16))
(setq fl1 (open flname "r"))
(setq lin1 (read-line fl1))
(setq a 0.08 prad 0.003)
(setq 0pi 3.14159265358 2pi (* 2.0 pi) pi2 (* pi 0.5))
;-----------------------------------
(command "-layer" "s" "0" ""
         "erase" "all" ""
         "-purge" "b" "*" "n"
         "-purge" "la" "*" "n"
)
;---------------------------------
 (setq nn 1 aa 1)
 (while aa
   (setq bb (substr lin1 nn 1))
   (if (equal "," bb) (setq wrdname (substr lin1 1 (1- nn)) aa nil) (setq nn (1+ nn)))
 )
 (remspacr wrdname)
 (setq layname (replacein nstrng))
 (extrinfo)
 (setq elename nstrng blkname (replacein nstrng))
 (extrinfo)
 (setq indexx nstrng)
 (extrinfo)
 (setq xcoor (atof nstrng))
 (extrinfo)
 (setq ycoor (atof nstrng))
 (extrinfo)
 (setq zcoor (atof nstrng))
 (setq pte0 (list zcoor (+ xcoor 100.0)))
 (command "-view" "top"
          "zoom" "c" pte0 "550"
 )
;------------------------------------
(while lin1
  (lat-elem)
  (cond
    ((equal elemkey "SBEND") (bsbend))
    ((equal elemkey "MARKER") (bmarker)) 
    ((equal elemkey "DRIFT") (bdrift)) 
    ((equal elemkey "LCAVITY") (blcavity))
    ((equal elemkey "QUADRUPOLE") (bquadrupole))
    ((equal elemkey "SEXTUPOLE") (bsextupole))  
    ((equal elemkey "OCTUPOLE") (boctupole)) 
    ((equal elemkey "SOLENOID") (bsolenoid))
    ((equal elemkey "HKICKER") (bhkicker))
    ((equal elemkey "VKICKER") (bvkicker))
    ((equal elemkey "KICKER") (bkicker))
    ((equal elemkey "VACUUMGUAGE") (bvacuumgauge))
    ((equal elemkey "BPM") (bbpm))
    ((equal elemkey "SLIDINGJOINT") (bslidingjoint))
    ((equal elemkey "WIGGLER") (bwiggler))
    ((equal elemkey "GATEVALVE") (bgatevalve))
    ((equal elemkey "COLLIMATOR") (bcollimator))
    ((equal elemkey "PUMPPORT") (bpumpport))
    ((equal elemkey "PIPE") (bpipe))
    ((equal elemkey "INSTRUMENT") (binstrument))
  )
  (setq lin1 (read-line fl1))
)
(close fl1)
;-----------------------------------
;-----------------------------------
;-----------------------------------
(restoreVars)
(setq *error* olderr)
(princ)