
;; ************************************************************************
;;;                I N  T H E   N A M E   O F   G O D
(defun icslisp ()
 (princ (strcat "\n       * * *   W E L C O M E   T O  < ICS >  P "
                                  "R O G R A M   * * * "))
 (princ (strcat "\nInsert Concrete Section , Version  3.11"
                 ", (c) 1993 by R. Negarandeh . "))

;
;  setting system var.
;
(defun setting (ps ds)
 (setq cmd (getvar "cmdecho"  ))
 (setq bli (getvar "blipmode" ))
 (setq cla (getvar "clayer"   ))
 (setq uci (getvar "ucsicon"  ))
 (setq reg (getvar "regenmode"))
 (setq dtd (getvar "dimtad"   ))
 (setq dsz (getvar "dimtsz"   ))
 (setq dti (getvar "dimtih"   ))
 (setq dto (getvar "dimtoh"   ))
 (setq lun (getvar "lunits"   ))
 (setq lup (getvar "luprec"   ))
 (setq dsc (getvar "dimscale" ))
 (setq dlf (getvar "dimlfac"  ))
 (setq dtt (getvar "dimtxt"   ))
 (setq daz (getvar "dimasz"   ))
 (setq deo (getvar "dimexo"   ))
 (setq dee (getvar "dimexe"   ))
 (setq ddi (getvar "dimdli"   ))
 (setq tsl (getvar "textstyle"))
 (setq fact (/ ds ps))
 (setvar "cmdecho" 0 )
 (setvar "blipmode" 0 )
 (setvar "ucsicon" 0 )
 (setvar "regenmode" 0 )
 (setvar "dimtad" 1 )
 (setvar "dimtsz" 0 )
 (setvar "dimtih" 0 )
 (setvar "dimtoh" 0 )
 (setvar "lunits" 2 )
 (setvar "luprec" 0 )
 (setq fact (/ ds ps))
 (setvar "dimscale" ps )
 (setvar "dimlfac" fact)
 (setvar "dimtxt"  2.00)
 (setvar "dimasz"  1.50)
 (setvar "dimexo"  2.00)
 (setvar "dimexe"  2.00)
 (setvar "dimdli" (* 1.7 (getvar "dimtxt")))
 (setq sizet (* 2.0 ps))
 (if (= nil (setq stl (tblsearch "style" "title" )))
          (command "style" "title" "italict" "" "" "10" "" "" "")
     (progn
          (if (/=  (cdr (assoc 3  stl )) "italict")
             (command "style" "title" "italict" "" "" "10" "" "" "")
          )
     )
 )
 (if (= nil (setq stl (tblsearch "style" "dim" )))
          (command "style" "dim" "simplex" "" "" "10" "" "" "")
     (progn
          (if (/=  (cdr (assoc 3  stl )) "simplex")
             (command "style" "dim" "simplex" "" "" "10" "" "" "")
          )
     )
 )

 (if (= (tblsearch "layer" "main") nil)
         (command "layer" "n" "main" "c" "3" "main" "")
 )
 (if (= (tblsearch "layer" "sec") nil)
         (command "layer" "n" "sec" "c" "2" "sec" "")
 )
 (if (= (tblsearch "layer" "arm") nil)
         (command "layer" "n" "arm" "c" "6" "arm" "")
 )
 (if (= (tblsearch "layer" "dim") nil)
         (command "layer" "n" "dim" "c" "1" "dim" "")
 )
)


(defun ics_er (s)                   ; If an error occurs
                                      ; while this command is active...
    (if (/= s "Function cancelled")
     (princ)
      (progn
       (princ "\nFunction cancelled by <Ctrl-C> ")
       (princ "\n     Good Luck .     ")
       (setvar "cmdecho" 1)
       (setvar "blipmode" 1)
       (setvar "regenmode" 1)
       (prin1 )
      )
    )
    (if ics_oe                        ; If an old error routine exists
      (setq *error* ics_oe)           ; then, reset it
    )
    (princ)
)
  (if *error*                         ; Set our new error handler
    (setq ics_oe *error* *error* ics_er)
    (setq *error* ics_er)
  )



(defun mflesh ()
         (setq basep (list 0 0 0))
         (setq centp (list -1.2547 0 0))
         (setq frstp (list -1 -0.2679 0))
         (setq bangl 316.4468877)
         (setq radpt 0.369651863)
         (setq nsold 10)
         (setq aangl (/ (- 360 bangl) nsold))
         (setq ssblock (ssadd))
         (setq n 0)
           (while (> (* 2 nsold) n)
             (setq pt1 (polar centp  (dtr (+ bangl (* n aangl))) radpt ))
             (setq pt2 (polar centp  (dtr (+ bangl (* (+ n 1) aangl))) radpt ))
             (command "layer" "s" "sec" "" )
             (command "solid" pt1 basep pt2 "" "")
             (ssadd (entlast) ssblock)
             (setq n (+ n 1))
           )
         (command "block" "fl1"  basep ssblock "")
)




 (if
     (= ps1 nil )(setq ps1 1)
 )
 (setq ps2 (rtos ps1 2 0))
 (princ (strcat "\nEnter plotting scale [1=?] <1=" ps2))
 (setq ps (getreal ">:"))
 (if
     (= ps nil) (setq ps ps1 )
 )
 (setq ps1 ps)
 (if
     (= ds1 nil )(setq ds1 1)
 )
 (setq ds2 (rtos ds1 2 0))
 (princ (strcat "\nEnter drawing scale [1/?] <1/" ds2))
 (setq ds (getreal ">:"))
 (if
     (= ds nil) (setq ds ds1 )
 )
 (setq ds1 ds)
 (setq ds2 (rtos ds 2 0))

 (setting ps ds )

 (if (= prmt nil )(setq prmt "A"))
 (if (= bb  nil )(setq bb  0))
 (if (= hh  nil )(setq hh  0))
 (if (= cc  nil )(setq cc  0))
 (if (= nnt nil )(setq nnt 0))
 (if (= nnb nil )(setq nnb 0))
 (if (= ddt nil )(setq ddt 0))
 (if (= ddb nil )(setq ddb 0))
 (if (= dds nil )(setq dds 0))
 (if (= dss nil )(setq dss 0))
 (if (= post nil )(setq post "1"))
 (if (= posb nil )(setq posb "2"))
 (if (= poss nil )(setq poss "3"))
 (setq p1    (getpoint "\nInsertion point :"    ))
 (princ (strcat "\nName of section <" prmt))
 (setq prmt1 (getstring ">: "))
 (if
     (= prmt1 "") (setq prmt1 prmt )
 )
 (setq prmt prmt1)
 (setq bbt (rtos bb 2 0))
 (princ (strcat "\nWidth of section <" bbt))
 (setq b (getreal "mm>:"))
 (if
     (= b nil) (setq b bb )
 )
 (setq bb b )
 (setq b (/ b fact ))
 (setq hht (rtos hh 2 0))
 (princ (strcat "\nHighth of section <" hht))
 (setq h (getreal "mm>:"))
 (if
     (= h nil) (setq h hh )
 )
 (setq hh h )
 (setq h (/ h fact ))
 (setq cct (rtos cc 2 0))
 (princ (strcat "\nCover of steel <" cct))
 (setq c (getreal "mm>:"))
 (if
     (= c nil) (setq c cc )
 )
 (setq cc c )
 (setq c (/ c fact ))
 (setq nntt (rtos nnt 2 0))
 (princ (strcat "\nNo. of top  arm. <" nntt))
 (setq nt (getint ">:"))
 (if
     (= nt nil) (setq nt nnt)
 )
 (setq nnt nt )
 (setq nntt (itoa nt ))
 (setq nnbt (rtos nnb 2 0))
 (princ (strcat "\nNo. of bot. arm. <" nnbt))
 (setq nb (getint ">:"))
 (if
     (= nb nil) (setq nb nnb)
 )
 (setq nnb nb )
 (setq nnbt (itoa nb ))
 (setq ddtt (rtos ddt 2 0))
 (princ (strcat "\nDiameter of top  arm. <" ddtt))
 (setq dt (getint "mm>:"))
 (if
     (= dt nil) (setq dt ddt)
 )
 (setq ddt dt )
 (setq ddtt (itoa dt ))
 (setq dt (/ dt fact ))
 (setq ddbt (rtos ddb 2 0))
 (princ (strcat "\nDiameter of bot. arm. <" ddbt))
 (setq db (getint "mm>:"))
 (if
     (= db nil) (setq db ddb)
 )
 (setq ddb db )
 (setq ddbt (itoa db ))
 (setq db (/ db fact ))
 (setq ddst (rtos dds 2 0))
 (princ (strcat "\nDiameter of shear arm. <" ddst))
 (setq ds (getint "mm>:"))
 (if
     (= ds nil) (setq ds dds)
 )
 (setq dds ds )
 (setq ddst (itoa ds ))
 (setq ds (/ ds fact ))
 (setq dsst (rtos dss 2 0))
 (princ (strcat "\nDistance between shear arm. <" dsst))
 (setq ss (getint "mm>:"))
 (if
     (= ss nil) (setq ss dss)
 )
 (setq dss ss )
 (setq dsst (itoa ss ))
 (princ (strcat "\nPos. of top arm.<" post))
 (setq post1 (getstring ">: "))
 (if
     (= post1 "") (setq post1 post )
 )
 (setq post post1)
 (princ (strcat "\nPos. of bot. arm.<" posb))
 (setq posb1 (getstring ">: "))
 (if
     (= posb1 "") (setq posb1 posb )
 )
 (setq posb posb1)
 (princ (strcat "\nPos. of shear arm.<" poss))
 (setq poss1 (getstring ">: "))
 (if
     (= poss1 "") (setq poss1 poss )
 )
 (setq poss poss1)



 (defun dtr (a)
   (* pi (/ a 180.0))
 )


 (if (= (tblsearch "block" "fl1") nil) (mflesh))


 (setq xins (car p1) yins (cadr p1) )
 (setq xul  (- xins (+ (* 16 sizet) (* 11 ps)) ))
 (setq yul  (- yins (* 31.4 ps) ))
 (setq xtr  (+ xins (+ b (+ (* 20 sizet) (* 11 ps)))))
 (setq ytr  (+ yins (+ h (+ (* 3 sizet) (* 5 ps)))))
 (setq ul (list xul yul 0))
 (setq tr (list xtr ytr 0))
 (command "zoom" "w" ul tr)


 (setq p2 (polar p1 (dtr 0) b ))
 (setq p3 (polar p2 (dtr 90) h ))
 (setq p4 (polar p3 (dtr 180) b ))

 (setq b1 (- b (* 2.0 c)))
 (setq h1 (- h (* 2.0 c)))

 (setq p11 (polar p1 (dtr 45) (* (sqrt 2.0) c)))
 (setq p21 (polar p11 (dtr 0) b1 ))
 (setq p31 (polar p21 (dtr 90) h1 ))
 (setq p41 (polar p31 (dtr 180) b1 ))
 (setq p1-1 (polar p11 (dtr 90.) db ))
 (setq p1-2 (polar p11 (dtr 0.0) db ))
 (setq p2-1 (polar p21 (dtr 180) db ))
 (setq p2-2 (polar p21 (dtr 90.) db ))
 (setq p3-1 (polar p31 (dtr 270) dt ))
 (setq p3-2 (polar p31 (dtr 180) dt ))
 (setq p4-1 (polar p41 (dtr 0.0) dt ))
 (setq p4-2 (polar p41 (dtr 270) dt ))
 (command "layer" "s" "main" "")
 (command "layer" "s" "main" "")
 (command "line" p1 p2 p3 p4 "c" )
 (command "layer" "s" "arm" "" )
 (command "line" p1-2 p2-1 "")
 (command "arc" "" p2-2 )
 (command "line" ""  p3-1 "")
 (command "arc" "" p3-2 )
 (command "line" ""  p4-1 "")
 (command "arc" "" p4-2 )
 (command "line" ""  p1-1 "")
 (command "arc" "" p1-2 )

 (setq pm1 (polar p11 (dtr 0  ) (/ b1 2.0)))
 (setq pm2 (polar p21 (dtr 90 ) (/ h1 2.0)))
 (setq pm3 (polar p31 (dtr 180) (/ b1 2.0)))
 (setq pm4 (polar p41 (dtr 270) (/ h1 2.0)))

 (setq rad dt)
 (setq db1 (list 0 (/ db  2.0)))
 (setq dt1 (list 0 (/ dt -2.0)))

 (setq cen1 (polar p1-2 (dtr 90.) (/ db 2.0)))
 (setq cen2 (polar p2-1 (dtr 90.) (/ db 2.0)))
 (setq cen3 (polar p3-2 (dtr 270) (/ dt 2.0)))
 (setq cen4 (polar p4-1 (dtr 270) (/ dt 2.0)))
 (setq arb  (/ (distance cen1 cen2) (- nb 1)))
 (setq arbt (rtos (* arb fact) 2 0))
 (setq art  (/ (distance cen3 cen4) (- nt 1)))
 (setq artt (rtos (* art fact) 2 0))
 (setq db2 (list (car cen1) (+ (cadr cen1) (/ db  2.0))))
 (setq dt2 (list (car cen4) (- (cadr cen4) (/ dt  2.0))))
 (setq sslast (ssadd))
 (command "donut" "0" db cen1 "")
 (setq sslast (ssadd (entlast)))
 (command "circle" cen1 db)
 (command "array" "l" sslast "" "r" "" nb arb)
    (setq obj "bot")
    (setq objb (ssget "x" (list (cons 0 "CIRCLE") (cons 8 "ARM"))))
    (ifobj objb )
 (setq sslast (ssadd))
 (command "donut" "0" dt cen4 "")
 (setq sslast (ssadd (entlast)))
 (command "circle" cen4 dt)
 (command "array" "l" sslast "" "r" "" nt art)
    (setq obj "top")
    (setq objt (ssget "x" (list (cons 0 "CIRCLE") (cons 8 "ARM"))))
    (ifobj objt )

 (command "layer" "s" "dim" "" )
 (setq dimi1 (polar p4  (dtr  90) (* 5.0 ps )))
 (setq dimp1 p4 )
 (setq dimp2 (polar dimp1 (dtr  00) c  ))
 (setq dimp3 (polar dimp2 (dtr  00) b1 ))
 (setq dimp4 (polar dimp3 (dtr  00) c  ))
 (setq dimi5 (polar p1  (dtr 180) (* 5.0 ps )))
 (setq dimp5 p1 )
 (setq dimp6 (polar dimp5 (dtr  90) c  ))
 (setq dimp7 (polar dimp6 (dtr  90) h1 ))
 (setq dimp8 (polar dimp7 (dtr  90) c  ))
 (setq dimi11(polar p4  (dtr 90 ) (* 10. ps )))
 (setq dimi13(polar p4  (dtr 180) (* 10. ps )))
 (setq te    (polar dimi5 (dtr 240) (* 2.0 sizet)))
    (command "dim" "style" "dim" "al" dimp1 dimp2 dimi1 " "
                                             "al" dimp2 dimp3 dimi1 ""
                                             "al" dimp3 dimp4 dimi1 ""
                   "al" dimp5 dimp6 dimi5 "" "te" "l" te
                                             "al" dimp6 dimp7 dimi5 ""
                                             "al" dimp7 dimp8 dimi5 ""
                   "al" p4 p3 dimi11 ""
                   "al" p1 p4 dimi13 ""
             "e"
    )

  (command "layer" "s" "main" "" )
  (setq ttlp  (polar pm1 (dtr 270) (* 25.0 ps)))
  (setq ttlrad (* 6.40 ps))
  (command "circle" ttlp ttlrad)
  (setq sstrim   (ssget "l"))
  (setq ttlsttp  (polar ttlp (dtr 180) (* 40.0 ps)))
  (setq ttlendp  (polar ttlp (dtr 0.0) (* 40.0 ps)))
  (setq ttlprmt  (polar ttlp (dtr  95) (* 1.00 ps)))
  (setq copypnt  (list 0 (/ ttlrad -5.0)))
  (command "layer" "s" "arm" "" )
  (command "line" ttlsttp ttlendp "")
  (command "copy" "l" "" copypnt "")
  (command "chprop" "l" "" "La" "sec" "" )
  (setq trimpnt  (list (car ttlp) (- (cadr ttlp) (/ ttlrad 5.0)) 0.0))
  (command "trim" sstrim "" trimpnt "")
  (command "layer" "s" "dim" "" )
  (setq ttltxt1 (polar ttlprmt (dtr 180) (* 39. ps)))
  (setq ttltxt2 (polar ttlendp (dtr 270) (* 4.30 ps)))
  (setq ttltxt3 (polar ttlp (dtr 270) (* 4.50 ps)))
  (command "style" "title" "italict" "" "" "" "" "" "")
  (command "text" "j" "c" ttlprmt (* 4.0 ps) "" prmt )
  (setvar "textstyle" "title")
  (command "text" ttltxt1 (* 4.0 ps) "" "SECTION")
  (command "text" "j" "c" ttltxt3 (* 4.0 ps) "" "-")
  (command "text" "j" "r" ttltxt2 (* 2.5 ps) "" (strcat "Scale: 1/" ds2))


 (unsetting)
 (if ics_oe (setq *error* ics_oe))   ; Reset old error function if error
 (print)
 (princ "\n     Good luck .     ")
 (prin1)

)

(defun ifobj (ssobj)
     (setq size (* 2.0 ps))
     (setvar "textsize" sizet)
     (setq sizet (getvar "textsize"))
     (setq ysize (* size 1.00))
     (setq nsl (sslength ssobj) )
     (setq ns nsl)
     (setq sslines (ssadd))
     (command "layer" "s" "sec" "" )
     (while (> ns  0)
               (setq sobj (ssname ssobj (- ns 1)))
               (setq cenobj (cdr (assoc 10 (entget sobj))))
                (command "erase" sobj "")
;               (command "chprop" sobj "" "La" "sec" "" )
                (if (= obj "bot") (setq f1 0.80 f2 0.20) (setq f1 0.20 f2 0.80)
                )

          (setq stp (list (car pm1) (+ (* f1 (cadr pm1)) (* f2 (cadr pm3)))))
          (command "line" stp cenobj "")
          (setq ll (ssget "l"))
          (if (and (= ns 1) (= obj "top"))
            (progn
              (setq cpt (polar stp (+ (angle stp cenobj)(dtr 90))(/ dt 2.0)))
              (command "copy" "l" "" stp cpt )
              (command "chprop" "l" "" "la" "arm" "" )
              (setq baspt (cdr (assoc 11 (entget (entlast)))))
              (setq distnc (distance stp cenobj))
              (setq newlgt (/ 70 fact))
              (command "scale" "l" "" baspt "r" distnc newlgt)
              (setq cpt (polar stp (+ (angle stp cenobj)(dtr 270)) dt ))
              (command "copy" "l" "" stp cpt )
            )
          )
          (if (= obj "bot")
             (setq sr1 (distance stp cenobj) sr2 (- sr1 db))
             (setq sr1 (distance stp cenobj) sr2 (- sr1 dt))
          )
          (command "scale" ll "" stp "r" sr1 sr2)
          (setq endp (cdr (assoc 11 (entget (ssname ll 0)))))
   (command "insert" "fl1"  endp size ysize (/ (* (angle stp endp) 180.) pi))
          (setq ns (- ns 1))
     )
      (setq endline (polar stp 0 (+ (+ (/ (- (car p2) (car p1)) 2 )
                                      (* 6.0 sizet)) (* 5.0 ps)) ))
      (command "line" stp endline "")
      (setq poscen (list (+ (car endline) (* 3.0 ps)) (cadr endline) 0))
      (command "circle" poscen (* 3.0 ps))
      (command "layer" "s" "dim" "" )
      (if (= obj "bot") (setq postxt posb) (setq postxt post))
      (setvar "textstyle" "dim" )
      (command "text" "j" "m" poscen (* 2.5 ps) "" postxt)
      (setvar "textsize" sizet)

   (if (= obj "bot")
            (progn
      (setvar "clayer" "dim" )
        (setq txt1 (strcat nnbt "O" ddbt "@" arbt ))
        (setq txt2 " T")
        (setq endtext (polar endline (dtr 150.) (* 0.60 sizet)))
                (command "text" "j" "r" endtext "" "" txt1 )
          (setq stpt (cdr (assoc 10 (entget (entlast)))))
                (command "text" stpt (* (getvar "textsize") 1.08) "" txt2 )
        (setvar "textsize" sizet)
            )
            (progn
      (setq stpts (list (car pm2) (+ (* 0.5 (cadr pm1)) (* 0.5 (cadr pm3)))))
      (setq stps  (list (/ (+ (car p21) (car stp)) 2.0) (cadr stpts)))
      (setq stps1 (list (car p21)
                        (/ (+ (* (cadr p1 ) 3)(* (cadr p4 ) 2)) 5.0)
                  )
      )
      (setq endlines (polar stps (dtr 0) (+ (+ (- (car p2) (car stps))
                                   (* 8.0 sizet)) (* 5.0 ps)) ))
      (setvar "clayer" "sec" )
      (command "line" stps1 stps endlines "")
      (command "insert" "fl1"  stps1 size ysize (/ (* (angle stps stps1) 180.)
pi))       (setq poscen (list (+ (car endlines) (* 3.0 ps)) (cadr endlines) 0))
      (command "circle" poscen (* 3.0 ps))
      (setvar "clayer" "dim" )
      (command "text" "j" "m" poscen (* 2.5 ps) "" poss)
      (setvar "textsize" sizet)
      (setq endtext (polar endlines (dtr 120.) (* 0.40 sizet)))
      (setq endtxt2 (polar endlines (dtr 240.) (* 1.50 sizet)))
          (setq txts (strcat "%%c" ddst " C/C" dsst ))
          (setq txts2 (strcat "L=" (rtos (* 2.0 (+ 100 (* (+ b1 h1) fact))))
          "mm"))
          (command "text" "j" "r" endtext "" "" txts )
          (command "text" "j" "r" endtxt2 "" "" txts2)
        (setq txt1 (strcat nntt "O" ddtt "@" artt ))
        (setq txt2 " T" )
        (setq endtext (polar endline (dtr 120 ) (* 0.60 sizet)))
                (command "text" "j" "r" endtext "" "" txt1 )
          (setq stpt (cdr (assoc 10 (entget (entlast)))))
                (command "text" stpt (* (getvar "textsize") 1.08) "" txt2 )
            )
   )
   (command "layer" "s" "arm" "" )
)

(defun unsetting ()
  (setvar "cmdecho"   cmd )
  (setvar "clayer"    cla )
  (setvar "blipmode"  bli )
  (setvar "ucsicon"   uci )
  (setvar "regenmode" reg )
  (setvar "dimtad"    dtd )
  (setvar "dimtsz"    dsz )
  (setvar "dimtih"    dti )
  (setvar "dimtoh"    dto )
  (setvar "lunits"    lun )
  (setvar "luprec"    lup )
  (setvar "dimscale"  dsc )
  (setvar "dimlfac"   dlf )
  (setvar "dimtxt"    dtt )
  (setvar "dimasz"    daz )
  (setvar "dimexo"    deo )
  (setvar "dimexe"    dee )
  (setvar "dimdli"    ddi )
  (setvar "textstyle" tsl )
)
(setq icsid 1)
(defun c:ICS () (icslisp))

(princ (strcat "\n <InsertConcreteSection> loaded.  Start command with ICS ."
        "    "))
(princ )
; ************************************************************************

