 ;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(princ "\nSaad.lsp, Copyright (c) 1994 to 1995, Eng. Saad A. Althuweini  ")
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ

(defun saaderr (#msg)
   (if (/= #msg "Function cancelled")   
      (princ (strcat "\nError: " #msg "\nLisp Command Terminated")) 
   )
   (setq *error* #err#) 
   (setvar "CMDECHO" #cmd#)
   (setvar "BLIPMODE" #blp#)
   (setvar "OSMODE" #osn#)
   (princ)
)
;ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ
(defun sta_rt ()
   (setq #cmd# (getvar "CMDECHO")
         #blp# (getvar "BLIPMODE")
         #osn# (getvar "OSMODE")
         #err# *error*
        *error* saaderr 
   )
   (setvar "CMDECHO" 0)
   (setvar "BLIPMODE" 0)
   (setvar "OSMODE" 0)
)
;ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ
(defun fin_sh ()
   (setvar "CMDECHO" #cmd#)
   (setvar "BLIPMODE" #blp#)
   (setvar "OSMODE" #osn#)
   (setq *error* #err#)
   (princ)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN MKCRCL (LAY LYC P1 RAD)
  (SETQ LAY (IF LAY LAY (GETVAR "CLAYER")))
  (MAKLYR LAY LYC NIL)
  (ENTMAKE (LIST (CONS 0 "CIRCLE")
                 (CONS 8 LAY)
                 (CONS 10 P1)
                 (CONS 40 RAD)
           )
  )
 )
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN MKLINE (LAY LYC P1 P2)
 (SETQ LAY (IF LAY LAY (GETVAR "CLAYER")))
 (MAKLYR LAY LYC NIL)
 (ENTMAKE (LIST (CONS 0 "LINE")
                (CONS 8 LAY)
                (CONS 10 P1)
                (CONS 11 P2)
          )
 )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN MKLINS (LAY LYC LISTA / CO)
 (SETQ CO -1)
 (REPEAT (- (LENGTH LISTA) 1) (PROGN
   (SETQ CO (1+ CO))
   (MKLINE LAY LYC (NTH CO LISTA)(NTH (1+ CO) LISTA))
 ))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN MKSOLD (LAY LYC P1 P2 P3 P4)
  (SETQ LAY (IF LAY LAY (GETVAR "CLAYER"))
         P4 (IF P4 P4 P3)
  )
  (MAKLYR LAY LYC NIL)
  (ENTMAKE (LIST (CONS 0 "SOLID")
                 (CONS 8 LAY)
                 (CONS 10 P1)
                 (CONS 11 P2)
                 (CONS 12 P3)
                 (CONS 13 P4)

           )
  )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN MKTXT (LAY LYC STRT ANG JST HGT TXT )
 (SETQ LAY (IF LAY LAY (GETVAR "CLAYER")))
 (COND
   ((= JST "M") (SETQ JST 4))
   ((= JST "R") (SETQ JST 2))
   ((= JST "L") (SETQ JST 0))
 )
 (MAKLYR LAY LYC NIL)
 (ENTMAKE (LIST (CONS 0 "TEXT")
                (CONS 8  LAY)
                (CONS 10 STRT)
                (CONS 11 STRT)
                (CONS 72 JST)
                (CONS 40 HGT)
                (CONS 50 ANG)
                (CONS 1 TXT)
          )
 )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun maklyr (lyr clr ltp)
  (if (not (tblsearch "layer" lyr)) (progn
    (command "LAYER" "N" lyr )
    (if clr (command "c" clr lyr ))
    (if ltp (command "lt" ltp lyr))
    (command "")
    (princ (strcat "\nLayer " lyr " Created"))
  ))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun dtr (ag) (* ag (/ PI 180.0)))
(defun rtd (ag) (* ag (/ 180.0 PI)))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun MOV (mov_pt mov_x mov_y)
  (setq mov_pt (polar mov_pt 0 mov_x)
        mov_pt (polar mov_pt (/ PI 2.0) mov_y)
  )
  mov_pt
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun P2S (p2s_pt)
  (strcat "(" (rtos (car p2s_pt )) "," (rtos (cadr p2s_pt )) ")" )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun G_PT (sty_pt g_prmp / gt_tmp)      
    (while (null gt_tmp) 
      (setq gt_tmp (getpoint (strcat "\n" g_prmp " <" 
                                    (if (null sty_pt) " " (P2S sty_pt))
                                    ">: "
      )            )        )             
      (if (null gt_tmp) (setq gt_tmp sty_pt))
) gt_tmp )      
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun G_DIST (sty_pt ref_tmp g_prmp / gt_tmp)      
  (while (null gt_tmp) 
    (setq gt_tmp (if ref_tmp
                   (getdist ref_tmp (strcat "\n" g_prmp " <" 
                                    (if (null sty_pt) " " (rtos sty_pt))
                                    ">: "))        
                   (getdist (strcat "\n" g_prmp " <" 
                                    (if (null sty_pt) " " (rtos sty_pt))
                                    ">: "))        
    )              )             
      (if (null gt_tmp) (setq gt_tmp sty_pt))
  )
 gt_tmp 
)      
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun G_INT (sty_pt g_prmp / gt_tmp)      
    (while (null gt_tmp) 
      (setq gt_tmp (getint (strcat "\n" g_prmp " <" 
                                    (if (null sty_pt) " " (itoa sty_pt))
                                    ">: "
      )            )        )             
      (if (null gt_tmp) (setq gt_tmp sty_pt))
    )
 gt_tmp 
)      
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun G_STR (sty_pt g_prmp / gt_tmp)      
    (while (null gt_tmp) 
      (setq gt_tmp (getstring (strcat "\n" g_prmp " <" 
                                    (if (null sty_pt) " " sty_pt)
                                    ">: "
      )            )        )             
      (if (or (= 0 (strlen gt_tmp)) (null gt_tmp)) (setq gt_tmp sty_pt))
    )
 gt_tmp 
)      
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun gtver (sent / las vlis) 
    (setq las (if (= 1 (cdr (assoc 70 (entget sent)))) 
                 (cdr (assoc 10 (entget (entnext sent))))
              )
         vlis '() sent (entnext sent)) 
    (while (cdr (assoc 10 (entget sent)))
          (setq vlis (append vlis (list (cdr (assoc 10 (entget sent)))))
                sent (entnext sent)
    )     )
    (if las (setq vlis (append vlis (list las)))) 
    vlis
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun betwn (a b c / frg)
      (setq frg 
             (- (+ (abs (distance a b)) (abs (distance b c))) 
                   (abs (distance a c))
      )      )
      (if (<= frg 0.05) b )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun fp (/ pp dd)
   (setq pp (getpoint   "\n>> From Point :")
         dd (getdist pp "\n>> Distance :")
   )
   (polar pp (getangle pp "\n>> Direction :") dd)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun frompt (/ pp dd)
   (setq pp (getpoint "\nFrom Point :")
         dd (getdist pp "\nDistance :")
   )
   (command "OSNAP" "NEA" )
   (setq pp (polar pp (getangle pp "\nDirection : Near to ") dd))
   (command "OSNAP" "NONE" )
   pp 
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun mid (/ mpt mp2) 
   (setq pt (setvar "lastpoint" (getpoint " First Point : "))
         p2 (getpoint " Second Point : ")
   ) 
   (polar pt (angle pt p2) (/ (distance pt p2) 2.0))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun rect (IPT ANG H B CLOZ / oldwid BB HH)     
   (setq BB (polar IPT ANG B)
          H (polar IPT (+ (dtr 90) ANG) H)
         HH (polar H ANG B)
   )
   (setq oldwid (getvar "PLINEWID"))
   (setvar "PLINEWID" 0)
   (IF (= CLOZ 1) (command "pline" IPT BB HH H "C") 
          (command "pline" IPT BB HH H "")
   )  
   (setvar "PLINEWID" oldwid)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun KLER (/ ipt pt2 B H edg objs sid ssl cou)
(setq ipt (getpoint "\n First corner : ")
      pt2 (getcorner ipt "\n Other Corner : ")
      B (- (car pt2) (car ipt))
      H (- (cadr pt2) (cadr ipt))
)
   
   (setq objs (ssget "W" ipt pt2))
   (command "ERASE" objs "" )

(rect IPT 0 H B 1)     
   (setq edg (entlast)
         objs (ssget "C" ipt pt2)                   
         objs (ssdel edg objs)
         sid  (polar ipt (angle ipt pt2) (/ (distance ipt pt2) 2.0))
         ssl (sslength objs)                
         cou -1                               
   )                                             
   (command "TRIM" edg "")                      
   (repeat ssl
          (setq cou (1+ cou))
          (command (list (ssname objs cou) sid ))
   )
   (command "" )
   (setq objs (ssget "W" ipt pt2)
         objs (ssdel edg objs)
   )
   (command "ERASE" OBJS "" )
   edg
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun sbreak (bpt spt)
 (if (ssget bpt) (command "break" "nea" bpt spt))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:RECT (/ IPT ANG B H)
  (sta_rt)
  (setq IPT (getpoint "\nInsertion point <Enter for Ref. Point> : "))
  (if (null IPT) (setq IPT (frompt)))
  (setq ANG (getangle IPT "\nInclination angle of rectangle <0>: "))
  (if (null ANG) (setq ANG 0.0))
  (setq B (getdist IPT "\nRectangle Base Width: ")
        H (getdist IPT "\nRectangle Height: ")
  )
  (rect IPT ANG H B 1)     
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN c:LEN (/ ENT spt nam t X Y a b R LIS L CO LENG TOT)
  (sta_rt)
  (SETQ ENT  (ENTSEL "Select Entity to be measured")
        spt  (cadr  ENT)
        ENT  (car ENT)
        nam (cdr (assoc 0  (ENTGET ENT)))
          t (CDR (ASSOC 1 (ENTGET ENT)))
          X (CDR (ASSOC 10 (ENTGET ENT)))
          Y (CDR (ASSOC 11 (ENTGET ENT)))
          a (CDR (ASSOC 50 (ENTGET ENT)))
          b (CDR (ASSOC 51 (ENTGET ENT)))
          R (CDR (ASSOC 40 (ENTGET ENT)))  ;Raduis or text Hight
  )
  (PRINC (strcat "\nLENGTH of " nam ))
  (cond 
   ((= nam "LINE") (progn ( princ " = ") (PRINC (ABS (DISTANCE Y X)))))
   ((= nam "ARC") (progn 
                (princ " = ")
                (PRINC (* r (if (> a b) (+ (* 2.0 PI) (- b a)) (- b a))))
                (princ "      Radius = ") (princ r)
   ))
   ((= nam "CIRCLE") (progn (princ " Perimeter = ") (princ (* 2.0 PI r))
                     (princ "      Radius = ") (princ r)
   ))
   ((= nam "TEXT") (progn (princ " = ") (princ (strlen t))
                        (prompt " Characters     Hight = ")
                        (princ r)
   ))
   ((= nam "POLYLINE") (progn 
       (setq 
             lis (gtver ent)
             l   (length lis)
             co 0
             leng 0.0
             tot 0
       )
      (while (< co (- l 1) ) (progn
          (if (betwn  (nth co lis) spt (nth (1+ co) lis) )
            (setq leng (abs (distance (nth co lis) (nth (1+ co) lis) ) ) )  
          )    
      
          (setq tot (+ tot (abs (distance (nth co lis) (nth (1+ co) lis))))
                co (1+ co)
          )
      ))    
      (princ " Segment = ") (princ leng) (princ "   Total Length = ") 
      (princ tot) (princ)
   ))
   ((= nam nam) (princ " ??!!! "))
  )
(fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:cL (/ i objs obj2 alst)
       (sta_rt)
       (setq objs  (ssget)
             obj2 (car (entsel "\nChange to Layer, Like what object :"))
           i 0
       )
    (while (< i (sslength objs)) (progn
      (setq alst
        (subst (assoc 8 (entget obj2)) 
              (assoc 8 (entget (ssname objs i))) 
              (entget (ssname objs i))
        )
        i (+ i 1)
      )
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt (strcat "Changed to Layer [ " (cdr (assoc 8 (entget obj2)))" Y"))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:SL (/ obj)
   (sta_rt)
   (setq obj (car (entsel "\nSet Layer, Of what object :")))
   (if obj (command "LAYER" "S" (cdr (assoc 8 (entget obj))) ""))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:Sty (/ obj)
(sta_rt)
 (setq obj (car (nentsel "\nSet Style, Of what TEXT :")))
 (if obj
  (IF (= (cdr (assoc 0 (entget obj))) "TEXT") (progn
   (setvar "textstyle" (cdr (assoc 7 (entget obj))))
   (prompt (strcat  "\nCurrent Style Set to [ " 
                    (cdr (assoc 7 (entget obj)))" Y")
           )
   )
   (prompt "\nNo TEXT Selected !") 
  )
 )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:IC ()
    (sta_rt)
    (if (= (getvar "ucsicon") 0) 
        (command  "UCSICON" "ON")
        (command  "UCSICON" "OFF")
    )
    (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:ons (/ lays obj cula)
 (sta_rt)
 (setq lays "")
 (while (setq obj (entsel "\nSelect object on Layer(s) to keep ON: "))
   
        (setq lays (strcat lays "," (cdr(assoc 8 (entget (car obj))))))
        (princ "\n\n\n")
        (princ lays)
 )
 (command"layer" "off" "*" "y" "on" lays "")
 (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:onl (/ obj )
   (sta_rt)
   (setq obj (entsel "\nSelect object in Layer to be ON ONLY :"))
   (if obj (progn
    (command "layer" "S" (cdr (assoc 8 (entget (car obj)))) "")
    (command "layer" "of" "*" "" "")
   ))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:off (/ lay )
   (sta_rt)
   (setq lay (entsel "\nSelect Objet in The Layer to be OFF:")
         lay (cdr (assoc 8 (entget (car lay ))))
   )
   (if (= (getvar "clayer") lay)
       (progn (command "layer" "off" lay "Y" "" )
              (princ "WARNING Current Layer Set to OFF")
       )
       (progn (command "layer" "off" lay "" )
              (prompt (strcat "\nLayer " lay " Set to Off"))
   )   )
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:frz (/ lay )
   (sta_rt)
   (setq lay (entsel "\nSelect Objet in The Layer to be FROZEN:")
         lay (cdr (assoc 8 (entget (car lay ))))
   )
   (if (= (getvar "clayer") lay)
       (prompt "\nCan't Freez CURRENT Layer")
       (command "layer" "F" lay "" )
   )
   (fin_sh)
   (if (/= (getvar "clayer") lay)
        (prompt (strcat "\n \n Layer " lay " Frozen"))
   )
   (princ)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:ONA () (sta_rt) (COMMAND "LAYER" "ON" "*" "" ) (fin_sh))
(DEFUN C:THA () (sta_rt) (COMMAND "LAYER" "TH" "*" "" ) (fin_sh))
(defun C:PB  () (setvar "PICKBOX" 4 ))
(defun C:SSG () (setq ss (ssget)))
(defun SSP () ss)
(defun c:nn ()(setvar "CMDECHO" 1)(command "DIST" "nea" pause "per")(princ))
(defun c:bi () 
   (command "BREAK" pause "F" "int" pause "int" pause )(princ))
(defun c:ba ()   
   (command "BREAK" pause "F" "INT" pause (getvar "LASTPOINT"))(princ)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
ΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:MT ( / edg objs sid ssl cou)
   (sta_rt)
   (prompt "\nSelect edge(s) for cutting...  ")
   (setq edg (ssget))                    
   (prompt "\n\nSelect object(s) to cut......  ")
   (setq objs (ssget)                   
         sid (getpoint "\nSelect side to cut:  ")
         ssl (sslength objs)                
         cou -1                               
   )                                             
   (command "TRIM" edg "")                      
   (repeat ssl
          (setq cou (1+ cou))
          (command (list (ssname objs cou) sid ))
   )
   (command "")
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:ME (/ bou ent pt len cou)
 (sta_rt)
 (setq cou -1)
 (prompt "Select boundary edge(s)...")
 (setq bou (ssget))(terpri)(terpri)
 (prompt "\n\nSelect object(s) to extend.....")
 (setq ent (ssget))(terpri)(terpri)
 (setq len (sslength ent))                        
 (setq pt (getpoint "\nPick side to extend: "))  
 (command "EXTEND" bou "")                        
 (repeat len
  (setq cou (1+ cou))
  (command (list (ssname ent cou) pt ))
  )
  (command "")
 (fin_sh)
 
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun ssx_fe (/ x data fltr ent)
  (setq ent (car (entsel "\nSelect object/<None>: ")))
  (if ent
    (progn
      (setq data (entget ent))
      (foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
        (if (assoc x data) (setq fltr (cons (assoc x data) fltr)))
      )    
      (reverse fltr)
    )
  ) 
)

(defun ssx_re (element alist)
  (append
    (reverse (cdr (member element (reverse alist))))
    (cdr (member element alist))   
  )
)
(defun ssx_er (s) 
  (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s))
  )
  (if olderr (setq *error* olderr))
  (princ)
)
(defun ssx (/ olderr)
  (gc)
  (setq olderr *error* 
        *error* ssx_er 
  )
  (setq fltr (ssx_fe)) 
  (ssx_gf fltr) 
)
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
  (while 
    (progn
      (cond (f1 (prompt "\nFilter: ") (prin1 f1)))
      (initget 
        "Block LAyer LType Pick Style Thickness")
      (setq t1 (getkword (strcat
        "\n>>Block name/"
        "LAyer/LType/Pick/Style/Thickness: "))) 
    )
    (setq t2
      (cond
        ((eq t1 "Block")      2)   ((eq t1 "LAyer")      8)   
        ((eq t1 "LType")      6)   ((eq t1 "Style")      7)   
        ((eq t1 "Thickness") 39)   (T t1)
      )
    )
    (setq t3
      (cond
        ((= t2  2)  (getstring "\n>>Block name to add/<RETURN to remove>: "))
        ((= t2  8) (getstring "\n>>Layer name to add/<RETURN to remove>: "))
        ((= t2  6) (getstring "\n>>Linetype name to add/<RETURN to remove>: "))
        ((= t2  7) 
          (getstring "\n>>Text style name to add/<RETURN to remove>: ")
        )
        ((= t2 39)  (getreal   "\n>>Thickness to add/<RETURN to remove>: "))
        (T          nil)
      )
    )
    (cond
      ((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
      ((and f1 (assoc t2 f1))         ; already in the list
        (if (and t3 (/= t3 ""))
          ;; Replace with a new value...             
          (setq f1 (subst (cons t2 t3) (assoc t2 f1) f1)) 
          ;; Remove it from filter list...
          (setq f1 (ssx_re (assoc t2 f1) f1)) 
        )  
      )
      ((and t3 (/= t3 ""))
        (setq f1 (cons (cons t2 t3) f1))
      )
      (T nil)
    )
  )
  (if f1 (setq f2 (ssget "x" f1)))
  (setq *error* olderr)
  (if (and f1 f2) 
    (progn
      (princ (strcat "\n" (itoa (sslength f2)) " found. "))
      (setq ss f2) 
    )
    (progn (princ "\n0 found.") (prin1))
  )
)
(defun c:ssx () (ssx)(princ))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:MO( / ent spt dist )
  (sta_rt)
  (setq #MDIS#  (G_DIST #MDIS# NIL "Offset distance ") 
        #MNUM#  (G_INT  #MNUM# "How many times ")
        ent    (entsel "\nSelect object to offset : ")
        spt    (getpoint  "\nSelect side : ")
        dist   #MDIS#
  )
  (repeat #MNUM#
     (command "offset" dist ent spt "") 
     (setq dist (+ dist #MDIS#))
  )
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:MOF( / ent spt dist )
  (sta_rt)
  (setq #MDIS# (G_DIST #MDIS# NIL "Offset distanc") 
        totdis (Getdist "\nTotal distance :")
        #MNUM# (fix (/ totdis #mdis#))
        ent    (entsel "\nSelect object to offset : ")
        spt    (getpoint  "\nSelect side : ")
        dist    #MDIS#
  )
  (repeat #MNUM#
     (command "offset" dist ent spt "") 
     (setq dist (+ dist #MDIS#))
  )
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:LBL ( / ipt edg objs ddl cou)
(sta_rt)
(setq ipt   (getpoint "\n Insertion Point : ")
      #rad# (g_dist #rad# ipt "\n Raduis ")
      #thk# (g_str #thk# "\n text ")
)
(command "circle" ipt #rad#)     
   (setq edg (entlast)
         objs (ssget "C" 
              (mov ipt (* -1 #rad#)(* -1 #rad#)) (mov ipt #rad# #rad#))
         objs (ssdel edg objs)
         ssl (sslength objs)                
         cou -1                               
   )                                             
   (command "TRIM" edg "")                      
   (repeat ssl
          (setq cou (1+ cou))
          (command (list (ssname objs cou) ipt ))
   )
   (command "" )
   (setq objs (ssget "W" 
              (mov ipt (* -1 #rad#)(* -1 #rad#)) (mov ipt #rad# #rad#))
         objs (ssdel edg objs)
   )
  (command "ERASE" OBJS "" )
         (MKTXT NIL NIL IPT 0 "M" 0.2 #thk#)
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TS (/ i objs obj2 );alst tcou)
 (sta_rt)
 (SETQ objs (SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
       obj2 (car (nentsel "\nChange Style, Like what TEXT :"))
          i 0
       tcou 0
 )
 (if (= (cdr (assoc 0 (entget obj2))) "TEXT") (progn
    (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
     (progn
     (setq alst (entget (ssname objs i)))
      (foreach #p# '(7 41 51)
       (setq alst 
          (subst (assoc #p# (entget obj2)) 
                 (assoc #p#  alst)
                 alst
      ))  )
      (setq tcou (1+ tcou))
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt 
    (strcat (itoa tcou)
           " Changed to Style [ " (cdr (assoc 7 (entget obj2))) " Y")
   )
  ))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:by ( / objs)
  (setq objs (ssget))
  (command "CHPROP" objs "" "c" "bylayer" "lt" "bylayer" "")
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:cln () (sta_rt) (entdel (kler)) (fin_sh))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN c:do (/ ENT ents spt nam t X Y  R)
  (sta_rt)
  (SETQ #dof# (g_dist #dof# nil "Half Width :")
        ENTS  (ENTSEL "Select Entity to DOUBLE OFFSET ")
        spt  (cadr  ENTS)
        ENT  (car ENTS)
        nam (cdr (assoc 0  (ENTGET ENT)))
          t (CDR (ASSOC 1 (ENTGET ENT)))
          X (CDR (ASSOC 10 (ENTGET ENT)))
          Y (CDR (ASSOC 11 (ENTGET ENT)))
          R (CDR (ASSOC 40 (ENTGET ENT)))  ;Raduis or text Hight
  )
  (cond 
   ((= nam "LINE")
     (command "OFFSET" #dof# ents (polar spt (+ 1.57 (angle x y)) 1)

              ents (polar spt (+ -1.57 (angle x y)) 1) ""
              "erase"  ent ""
     )
   )
   ((OR (= nam "CIRCLE") (= nam "ARC"))
     (command "OFFSET" #dof# ents (polar spt (angle spt x ) (* -1.0 r)) 

              ents (polar spt (angle spt x ) r) ""
              "erase"  ent ""
   ) )
   ((= nam "POLYLINE") 
    (progn 
       (setq 
             lis (gtver ent)
             l   (length lis)
             co 0
             leng 0.0
             tot 0
      )
      (while (< co (- l 1) ) 
         (progn
          (if (betwn  (nth co lis) spt (nth (1+ co) lis) )
            (setq x (nth co lis) y (nth (1+ co) lis))  
          )    
          (setq co (1+ co))
      )  )
      (command "OFFSET" #dof# ents (polar spt (+ (/ pi 2.0) (angle x y)) 0.1)
                ents (polar spt (+ (/ pi -2.0) (angle x y)) 0.1) ""
               "erase"  ent ""
      )
   ))
   ((= nam nam) (princ " ??!!! "))
  ) 
(fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TL (/ i objs obj2 alst tcou)
 (sta_rt)
 (SETQ objs (SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
       obj2 (car (nentsel "\nChange hight, Like what TEXT :"))
          i 0
       tcou 0
 )
 (if (= (cdr (assoc 0 (entget obj2))) "TEXT") (progn
     (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
      (setq alst
        (subst (assoc 1 (entget obj2)) 
               (assoc 1 (entget (ssname objs i))) 
               (entget (ssname objs i))
        )
        tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt 
    (strcat (itoa tcou)
    " Changed to Text [ " (cdr (assoc 1 (entget obj2))) " Y")
   )
  ))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TH (/ i objs obj2h alst tcou)
       (sta_rt)
      (SETQ  objs (SSGET )
             objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
             fctr 1.0 
                i 0 
             tcou 0 
             obj2 (car (entsel "\nChange hight, Like what TEXT <None>:"))
      )
 (COND 
   ((null obj2)(progn 
                (SETQ obj2h (getreal "\nNew Text Hight <Enter for factor>:"))
                (if (null obj2h)
                    (setq fctr (getreal "\nText Hight Factor <1>:")
                          fctr (if fctr fctr 1.0)   
                    )
                )
               )
   )
   
   ((= (cdr (assoc 0 (entget obj2))) "TEXT") 
                       (SETQ obj2h (cdr(assoc 40 (entget obj2)))))
   ((/= (cdr (assoc 0 (entget obj2))) "TEXT") 
                       (princ "\n No TEXT selected,  No changes !"))
 )
  
  (if  (or obj2h (/= fctr 1.0)) (progn
    
    (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
      (setq obj3h (if obj2h 
                      obj2h 
                      (* fctr (cdr(assoc 40 (entget(ssname objs i) ))))
                  )
            alst (subst (CONS 40  obj3h)
                        (assoc 40 (entget (ssname objs i))) 
                        (entget (ssname objs i))
                 )
            tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
      (princ "\n\n\n")
      (if obj2h 
       (prompt (strcat (itoa tcou) " Changed to Hight [ " (rtos obj2h) " Y"))
       (prompt (strcat (itoa tcou) " Changed by [ " (rtos fctr) " Y factor"))
      )
   ))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun sadva1 () 
(sta_rt)
(command "dim"   
         "dimsho"  "on"    "dimsoxd" "off"    "dimtad"  "on"
         "dimlfac" "1"     "dimtix"  "on"     "dimtofl" "on"
         "dimtoh"  "off"   "dimtol"  "off"    "dimtih" "off"
         "dimzin" "3"      "dimblk" "dot"     "dimasz" "0.1"
         "dimaso" "off"    "dimtsz" "0"       "dimdli" "0"
         "dimexo" "0"      "dimexe" "0.2"     "dimse1" "off"
         "dimse2" "off"  "exit"
)
(fin_sh)
)
(defun sadvar () (sadva1))
;--------------------------------------------------------------------------
(defun sadva2 () 
  (sadva1) (sta_rt)
  (command "dim" "dimtsz" "0.06" "exit")
  (fin_sh)
)
;--------------------------------------------------------------------------
(defun sadva5 () 
  (sadva1) (sta_rt)
  (command "dim" "dimblk" "." "dimasz" "0.18" "exit")
  (fin_sh)
)
;--------------------------------------------------------------------------
(defun sadva3 () 
  (sta_rt) (IF (= (GETVAR "DIMLFAC") 100)
              (SETVAR "DIMLFAC" 1)
              (SETVAR "DIMLFAC" 100)
          ) 
  (prompt (strcat "\n \n DIMLFAC SET TO " (RTOS (GETVAR "DIMLFAC"))))
  (fin_sh)
)
;--------------------------------------------------------------------------
(defun sadva4 () 
  (sta_rt) (IF (= (GETVAR "DIMASO") 0)
              (progn (SETVAR "DIMASO" 1)
                     (prompt "\nDimensions will be ASSOCIATIVE " )
              )
              (progn (SETVAR "DIMASO" 0)
                     (prompt "\nDimensions will be EXPLODED " )
              )
          ) 
  
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:cut (/ p1 p2 p3 p4 p5 dis wid)
 (sta_rt)
  (setvar "osmode" 512)
  (setq p1 (setvar "lastpoint" (getpoint "\n First Point : Near to ")))
  (setvar "osmode" 128)
  (setq p2 (getpoint "\n Second : Perp. to"))
  (setvar "osmode" 0)
  (setq wid (getdist "\n cut width :"))
 (cut NIL NIL p1 p2 WID)
 (fin_sh)
)
;-----------------------------------------------------------------------
(defun cut ( LAY LYC p1 p2 WID / p3 p4 p5 P6 dis )
  (setq LAY (IF LAY LAY (GETVAR "CLAYER"))
        dis (distance p1 p2)
        p5 (polar p1 (angle p1 p2) (/ dis 2.0)) 
        p1 (polar p1 (angle p2 p1) (/ wid 2.0))
        p2 (polar p2 (angle p1 p2) (/ wid 2.0))
        p3 (polar p1 (angle p1 p2) (/ dis 2.0))
        p4 (polar p2 (angle p2 p1) (/ dis 2.0))      
        p5 (polar p3 (+ (angle p1 p2) (dtr 90)) wid)
        p6 (polar p4 (+ (angle p2 p1) (dtr 90)) wid)
  )
  (MAKLYR LAY LYC NIL)   (mkline LAY LYC  p1 p3)
  (mkline LAY LYC  p3 p5)(mkline LAY LYC  p5 p6)
  (mkline LAY LYC  p6 p4)(mkline LAY LYC  p4 p2)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:J (/ OBJ OBJ1 OBJS)
(sta_rt)
  (setq objs (ssget)
        OBJ1 (ssname objs 1)
        OBJ (CDR(assoc 0 (entget (ssname objs 1))))
  )
  (COND 
   ((= OBJ "POLYLINE") (COMMAND "PEDIT" OBJ1 "J" OBJS "" ""))
   ((= OBJ "LINE") (COMMAND "PEDIT" OBJ1 "" "J" OBJS "" ""))
   ((= OBJ "ARC") (COMMAND "PEDIT"  OBJ1 "" "J" OBJS "" ""))
  )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN  C:RT(/ objs objlen oldtxt newtxt oldlen cou 
                  obj pos STR  txtseg stay total txtmod)
(sta_rt)
(SETQ  objs(SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
       objlen(if objs (SSLENGTH  objs) 0)
)
(PROMPT (STRCAT "\nFound "(ITOA  objlen)))
(if (> objlen 0)(progn
 
 (SETQ  oldtxt(GETSTRING  T "\nOld Text : ")
        newtxt(GETSTRING  T "\nNew text : ")
        oldlen(STRLEN  oldtxt)
        cou 0 
        total 0
 )
 (WHILE (>  objlen cou)
   (SETQ  obj(ENTGET (SSNAME  objs cou)))
   (SETQ pos 1 STR(CDR (ASSOC 1 obj)) txtseg(SUBSTR STR pos oldlen) stay T)
     (WHILE  stay 
       (IF (=  txtseg oldtxt)
           (PROGN 
             (SETQ txtmod(STRCAT (SUBSTR STR 1(1- pos))
                                 newtxt
                                 (SUBSTR STR (+ pos oldlen))
                         )
                       obj(SUBST (CONS  1 txtmod)(ASSOC  1 obj)obj)
             )
             (ENTMOD  obj)
             (SETQ total(1+ total) 
                   str txtmod
                   pos(+ pos oldlen)
                   txtseg(SUBSTR STR pos oldlen)
                   stay(IF (< (STRLEN txtseg)oldlen) nil stay)
             )
           ) 
           ;;;else
           (PROGN (SETQ  pos(1+  pos)
                         txtseg(SUBSTR  STR  pos oldlen)
                         stay(IF (< (STRLEN txtseg)oldlen) nil stay)
                  )
           )
       )
     )
     (SETQ  cou(1+  cou))
 )
 (PROMPT (STRCAT "\nChanged "(ITOA  total)))
))
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN  C:FT(/ objs objlen oldtxt newtxt oldlen cou 
                  obj pos STR  txtseg stay total txtmod)
(sta_rt)
(SETQ  objs(SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
       objlen(if objs (SSLENGTH  objs) 0)
)
(PROMPT (STRCAT "\nFound "(ITOA  objlen)))
(if (> objlen 0)(progn
 
 (SETQ  fndtxt(GETSTRING  T "\nText to find: ")
        fndlen(STRLEN  fndtxt)
        cou 0 
        total 0
 )
 (grclear)
 (WHILE (>  objlen cou)
   (SETQ  obj(ENTGET (SSNAME  objs cou)))
   (SETQ pos 1 STR(CDR (ASSOC 1 obj)) txtseg(SUBSTR STR pos fndlen) stay T)
     (WHILE  stay 
       (IF (=  txtseg fndtxt)
           (progn
             (SETQ total(1+ total) stay nil)
             (REDRAW (SSNAME  objs cou))
           )
        ;else
           (SETQ  pos(1+  pos)
                  txtseg(SUBSTR  STR  pos fndlen)
                  stay(IF (< (STRLEN txtseg) fndlen) nil stay)
           )
       )
     )
     (SETQ  cou(1+  cou))
 )
 (PROMPT (STRCAT "\nFound "(ITOA  total)))
))
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
;                              AUTO DIMENSION
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ

(defun smax (xlis lt / xco big nthlis)
           (setq  xco 0 big nil fuzz 0.00001)
    (while (/= xco (length xlis))
        (setq nthlis (nth xco xlis) )
        (if (and (< big nthlis)  (< nthlis lt ))
            (setq big (if (equal nthlis lt fuzz) big nthlis))
        )
        (setq xco (1+ xco))
    )
        big
)  
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun addvrt (pnt)                   ;;;surve lis bigest

            (setq   pnt (inters  pnt  (polar pnt (+ angdm (/ PI 2.0))1)
                               pntdm  (polar pntdm angdm 1) 
                                 nil
                        )
                 carpnt (if m (car pnt) (cadr pnt))
                    lis (append  lis (list carpnt ))
            )
            (if (> carpnt bigest) (setq bigest carpnt) )
)       
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun gtvrts ( / grb cou ent nam lyr t x y a b r) ;;;;calls addvrt  
 
 (setq grb (ssget) cou 0 )

 (while (< cou (sslength grb)) (progn
    (setq ent (ssname grb cou )
          nam (cdr (assoc 0  (ENTGET ENT)))
          lyr (CDR (assoc 8  (ENTGET ENT)))
            t (CDR (ASSOC 1 (ENTGET ENT)))
            X (CDR (ASSOC 10 (ENTGET ENT)))
            Y (CDR (ASSOC 11 (ENTGET ENT)))
            a (CDR (ASSOC 50 (ENTGET ENT)))
            b (CDR (ASSOC 51 (ENTGET ENT)))
            R (CDR (ASSOC 40 (ENTGET ENT)))  ;Raduis or text Hight
    )
    (cond 
     ((= nam "LINE") (progn (addvrt (trans x 0 1)) (addvrt(trans y 0 1))))
    
     ((= nam "ARC") (progn (addvrt (trans (polar x a r) 0 1)) 
                           (addvrt (trans (polar x b r) 0 1))))

     ((= nam "CIRCLE") (progn  
                (addvrt (polar (trans x 0 1) angdm r))
                (addvrt (polar (trans x 0 1) (+ PI angdm) r))))

     ((= nam "POLYLINE") (progn 
              (setq ilis (gtver ent) l (length ilis) co 0 )
              (while (< co l) (addvrt (trans (nth co ilis) 0 1)) 
                              (setq co (1+ co))
              )))
    )
    ; cond
    (setq cou (1+ cou))           
  )) 
  ;; WHILE progn
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun gtpts (/ gtpt)    ;;;;calls addvrt  
           (command "OSNAP" "ENDP")
           (while (setq gtpt (getpoint "\nPick Point : End of "))
                  (if gtpt (addvrt gtpt))
           ) 
           (command "OSNAP" "NONE")
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun adim (/ lis lis2 coun corbig last bigest co)
  
  (setq lis '() bigest nil )
  (initget "Points Vertices")
  (setq ptorvr (getkword "\nPoints / <Vertices>: "))
         (cond ((= ptorvr "Points") (gtpts))
               ((= ptorvr "Vertices") (gtvrts))
               ((null ptorvr) (gtvrts))
         )
  (initget "Points Vertices")
  (while (setq ptorvr (getkword "\nPoints / Vertices <ENTER to draw DIM>: "))
         (cond ((= ptorvr "Points") (gtpts))
               ((= ptorvr "Vertices") (gtvrts))
         )
         (initget "Points Vertices")
  )      
  
                      ;;;;;;;;;;now draw dim;;;;;;;;;;;;;;;

  (setq coun   1
        lis2   (list bigest)
        last   bigest
  )
  
  (while (/= coun (length lis))
         (setq lis2 (append lis2 (list (setq last (smax lis last))))
               coun (+ coun 1)
  )      )
  (IF (cadr lis2) (progn     ;;;; at least 2 pts to work
                                         
           (command "DIM" "ROT" (rtd angdm)
                  (if m (list (car lis2) (+(* m (car lis2))cc)) 
                        (list (car pntdm)(car lis2)) 
                        
                  )        
                  (if m       
                    (list (nth 1 lis2) (+(* m (nth 1 lis2))cc)) 
                    (list (car pntdm)(nth 1 lis2)) 
                  )       
                   inspdm
                   "" "exit"
           )
           (setq co 2)
           (while (/= co (length lis2))
            (if  (nth co lis2) 
              ( command "DIM" "cont" 
                   (if m
                    (list (nth co lis2) (+(* m (nth co lis2))cc)) 
                    (list (car pntdm)(nth co lis2)) 
                   )
                    "" "exit"
              )
            )
              (setq co (1+ co))
           )
           ;while       
  ))   
  ;;;progn IF                
)

;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:adim (/ ent spt namlis co l angdm m cc pntdm inspdm)
(sta_rt)
  
  (setq   ent  (entsel "\nSelect LINE or PLINE  <Enter for value> :")
          spt  (if ent (trans (cadr ENT) 1 0) nil)
          ent  (if ent (car ent) nil)
          nam  (if ent (cdr (assoc 0  (ENTGET ENT))) nil)
        angdm  nil
  )
  
  (cond
    ((= nam "LINE") 
            (setq angdm (angle (trans (cdr(assoc 10 (entget ent))) 0 1)
                               (trans (cdr(assoc 11 (entget ent))) 0 1) 
                        ) 
            )   
    )                

    ((= nam "POLYLINE") (progn 
      (setq namlis (gtver ent)
            l   (length namlis)
            co 0
      )
      (while (< co (- l 1) ) (progn
         (if (betwn  (nth co namlis) spt (nth (1+ co) namlis))
             (setq angdm (angle (trans (nth co namlis) 0 1)
                                (trans (nth (1+ co) namlis) 0 1)
             )           )
         )    
         (setq co (1+ co))
                             ) 
      )
   ))
  )  
  ;;cond
             
  (if (null angdm) (setq angdm  (getangle " \nAngle :")) )
  (if angdm (progn
     
     (setq   m  (if (or (equal angdm (* pi 1.5) 0.00001) 
                        (equal angdm (/ pi 2.0) 0.00001)
                    )
                    nil
                    (/(sin angdm)(cos angdm))
                )
         inspdm  (getpoint "\n Position of DIM :")
          pntdm  (polar inspdm (+ (/ PI 2.0) angdm) (getvar "dimexe"))
             cc  (if m (- (cadr pntdm) (* m (car pntdm))) nil)
     ) 

    (adim)           ;;/ common vars.  angdm m cc pntdm inspdm

  )) 
  ;; if progn

(fin_sh)
)          
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
;                           END Auto Dimension
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ

;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:ELWIN ()
(sta_rt)
(KLER)
(SETQ TR 0.05 
      IPT (POLAR IPT 0 (/ (- B TR) 2.0) )
      B (/ (- B (* TR 3.0)) 2.0)  
)
(command "LINE" IPT (POLAR IPT (DTR 90) H) "" )
  (SETQ IPT (POLAR IPT (DTR 90) TR)
        H (- H (* TR 2.0)) 
  )
  (rect IPT 0 H (* -1 B) 0)
  (rect (POLAR IPT 0 TR) 0  H B 1)
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:coord (/ EPT YELV XELV TPT)       
(sta_rt)
  (setq #CRPT# (G_PT #CRPT# "\nRiference Point ")
       EPT  (getpoint " Pick Point :")
       YELV (- (CADR EPT) (CADR #CRPT#))
       YELV (if (and sngflg (> YELV 0)) (strcat "+" (rtos YELV)) (rtos YELV))
       XELV (- (CAR EPT) (CAR #CRPT#))
       XELV (if (and sngflg (> XELV 0)) (strcat "+" (rtos XELV)) (rtos XELV))
       TPT (if ltfflg (polar EPT (* PI 0.7) 0.32) 
                      (polar EPT (* PI 0.3) 0.32))
  )
     (if (NOT ltfflg)
      (MKTXT  NIL NIL TPT 0 "L" 0.2 (STRCAT "(" XELV "," YELV ")") )
      (MKTXT  NIL NIL TPT 0 "R" 0.2 (STRCAT "(" XELV "," YELV ")") )
     )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:FWIN (/ PT P6 ORI ANG)
  (sta_rt)
  (setq LAY (getvar "CLAYER")    
         PT (getpoint "\nInsertion Point of Window <Enter for Ref. Point>:")
  )
   (if (null PT) (setq PT (frompt)))
  (setq #FWD# (g_dist #FWD# PT "\nWindow Width "))
   (prompt "\nOther Side Of Wall :") (command "LINE" pt "PER" pause "")
  
  (setq P6 (cdr (assoc 11 (entget (entlast)))) 
       ANG (getpoint  "\nDirection of Window:")
       ORI (angle PT P6)
      ANG (angle (inters PT P6 ANG (polar ANG (+ ORI (DTR 90)) #FWD#)nil)ANG)
  )
   (SBREAK (polar PT  ANG #FWD#) PT) (SBREAK (polar P6 ANG #FWD#) P6)
   (maklyr "WINDOWS" "G" nil) (maklyr "OUT" "C" nil)

   (COMMAND "LINE" (polar PT ang #fwd#) (polar P6 ang #fwd#) ""
            "LAYER" "S" "OUT" ""
            "LINE" PT (polar PT ang #fwd#) ""
            "LINE" P6 (polar P6 ang #fwd#) ""
   )
  (setq P6 (polar P6 (+ PI ORI) (/ (- (distance PT P6) 0.1) 2.0)) 
        P2 (polar P6 (+ PI ORI) 0.10) 
  )
  (bluwin ang #fwd# p2 p3 p5 p6 ORI)
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:WALL () (PROMPT "\nSelect Wall Type from  ARCH Pop Up Menu"))
;------------------------------------------------------------------------
(DEFUN WALL (sw cw iw bw ccw / PT PTL SID) 
  (sta_rt)
  (setq PT  (entsel "\nSELECT OUTER STONE LINE: "))
  (setq SID  (getpoint "\ndirection of WALL")
  )
  (maklyr "concrete" nil nil) (maklyr "brick" "G" nil) 
  (maklyr "stone" "M" nil)
  
  (command  "CHANGE" PT "" "P" "LA" "STONE" ""
            "OFFSET" sw  PT SID "")
            (setq PTL (entlast))
  (command  "CHANGE" PTL "" "P" "LA" "CONCRETE" ""
            "OFFSET"  (+ sw cw) PT SID "")
            (setq PTL (entlast))
  (command  "CHANGE" PTL "" "P" "LA" "CONCRETE" ""
            "OFFSET"  (+ sw cw iw) PT SID "")
            (setq PTL (entlast))
  (command "CHANGE" PTL "" "P" "LA" "BRICK" ""
           "OFFSET" (+ cw sw iw bw) PT SID "")
            (setq PTL (entlast))         
  (command "CHANGE" PTL "" "P" "LA" "BRICK" "")
  
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun bluwin (ang wd p2 p3 p5 p6 ORI)
  (MKLINE "windows" "B" P2 (polar P2  ang wd))
  (MKLINE "windows" "B" P6 (polar P6  ang wd))
  (MKLINE "windows" "B" (polar P2  ang 0.10) (polar P6  ang 0.10))
  (MKLINE "windows" "B" (polar P2  ang (- wd 0.10))
                        (polar P6  ang (- wd 0.10)))
  (MKLINE "windows" "B" (polar P2  ang (- (/ wd 2.0) 0.05)) 
                        (polar P6  ang (- (/ wd 2.0) 0.05)))
  (MKLINE "windows" "B" (polar P2  ang (+ (/ wd 2.0) 0.05)) 
                        (polar P6  ang (+ (/ wd 2.0) 0.05)))
          
  (setq P2 (polar P2 Ang 0.10) 
        P2 (polar P2 ORI 0.05) 
        P3 (polar P2 (+ ORI PI) 0.025) 
        P6 (polar P2 Ang (- wd 0.20))
        P5 (polar P6 ORI 0.025) 
  )
  (MKLINE "windows" "B" P2 p6)
  (MKLINE "windows" "B"p3 (polar P3  ang (/ (- wd 0.3) 2.0)))
  (MKLINE "windows" "B" p5 (polar P5  (- ang PI) (/ (- wd 0.3) 2.0)))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:W25 (/ iw bw PT SID)
 (sta_rt)
 (setq PT (entsel "\nSELECT OUTER BRICK LINE: ") 
      SID (getpoint "\ndirection of WALL") 
       iw 0.05 
       bw 0.10
 )
 (maklyr "brick" "G" nil)
 (command "CHANGE" PT "" "P" "LA" "BRICK" "" 
          "OFFSET" bw PT SID "" 
          "OFFSET" (+ bw iw) PT SID "" 
          "OFFSET" (+ bw iw bw) PT SID "" )
 (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:WIN () (PROMPT "\nSelect Window Type from  ARCH Pop Up Menu"))
;------------------------------------------------------------------
(defun WIN (sw cw iw bw ccw / PT WD ang P2 PP2 P1 P3 P4 P5 P6 obj)
  (sta_rt)
  (setq PT (getpoint "\nInsertion point of window <Enter for Ref. Point>: "))
  (if (null PT) (setq PT (frompt)))
  (setq WD (getdist PT "\nWindow width: "))
  (command "OSNAP" "NEAR")
  (setq ang (getangle PT "\nDirection of window : Near to "))
  (command "OSNAP" "NONE")
  (setq  P2 (polar PT (+ ang (dtr 270)) (+ sw cw))
        PP2 (polar P2 (+ ang PI) sw)
         P1 (polar PP2 (+ ang (dtr 90)) cw)
         P3 (polar P2 (+ ang PI) ccw )
         P4 (polar P3 (+ ang (dtr 270)) iw)
         P5 (polar P4 (+ ang (dtr 270)) bw)
         P6 (polar P5  ang  ccw)
  )
  (setvar "PICKBOX" 0)
  (SBREAK  PT (polar PT ang wd))
  (SBREAK  P1 (polar P1 ang (+ wd sw sw)))
  (SBREAK  P3 (polar P3 ang (+ wd ccw ccw)))
  (SBREAK  P4 (polar P4 ang (+ wd ccw ccw)))
  (SBREAK  P5 (polar P5 ang (+ wd ccw ccw)))
  (setvar "PICKBOX" 4)
  (maklyr "concrete" nil nil) (maklyr "brick" "G" nil) 
  (maklyr "stone" "G" nil) (maklyr "out" "C" nil) 
  (maklyr "windows" "B" nil)
  (command "PLINE" P1 PP2 P2 P6 P5 P3 ""
           "CHANGE" (entlast) "" "P" "LA" "concrete" "C" "BYLAYER" ""
           "MIRROR" (entlast) "" (polar PT  ang (/ wd 2.0)) 
                                 (polar P6  ang (/ wd 2.0)) ""
  )
  (MKLINE "stone" "M" PT P2 )
  (MKLINE "stone" "M" (polar PT ang wd)(polar P2 ang wd))
  (MKLINE "out" "C" PT (polar PT ang wd))
  (MKLINE "out" "c" P6 (polar P6 ang wd))
  
  (setq P6 (polar P6 (+ (dtr 90) ang) 0.02) 
        P2 (polar P6 (+ (dtr 90) ang) 0.10) 
  )
  (bluwin ang wd p2 p3 p5 p6 (- ang (dtr 90)))
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:DOOR (/ INSPT THETAL THETA THICK)
  (sta_rt)
  (setq   A90 (/ PI 2.0) A27 (* A90 3.0)
         INSPT (GETPOINT "\nHinge Point of Door <Enter for Ref. Point>:")
  )
  (if (null INSPT) (setq INSPT (frompt)))
  ( setq #WID# (g_dist #WID# inspt "\nDoor Width "))
  (prompt "\nOther Side Of Wall :")
  (command "LINE" inspt "PER" pause "")
  (setq  PT21 (cdr (assoc 11 (entget (entlast)))) 
         THETA  (getpoint  "\nDirection of Door:")
         THETAL (angle INSPT PT21)
         THETA  (angle (inters INSPT PT21 THETA 
                             (polar THETA (+ THETAL A90) #WID#)
                              nil
                        )
                       THETA
                 )
         THICK  (getdist INSPT "\nDOOR thick <0.05>: ")
  )
       (if (null THICK) (setq THICK 0.05))
  (setq PT12 (polar INSPT THETA THICK)
        PT13 (polar INSPT  THETA #WID#)
        PT14 (polar PT12 (+ THETAL PI) #WID#)
        PT15 (polar INSPT (+ THETAL PI) #WID#)
        PT22 (polar PT21 THETA #WID#)
  )
  (SBREAK PT13 INSPT) (SBREAK PT22 PT21)
  (maklyr "doors" "B" nil)
  (command          
           "LINE" PT13 PT22 ""
           "PLINE" INSPT PT12 PT14 PT15 INSPT ""
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
           "ARC" PT13  PT14  PT15 
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
   )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:DDOOR ();(/ PT ORI ANG TH)
  (sta_rt)
  (setq  PT (getpoint "\nHinge Point of Door <Enter for Ref. Point>:"))
  (if (null PT) (setq PT (frompt)))
  (prompt "\nOther Side Of Wall :")
  (command "LINE" PT "PER" pause "")
  (setq PT21 (cdr (assoc 11 (entget (entlast)))) 
        ANG (getpoint  "\nDirection of Door :")
        ORI (angle PT PT21)
        #DWID# (G_DIST  #DWID# PT "\nLeft Door Width ") 
  )     
  (setq ANG (angle (inters PT PT21 ANG (polar ANG (+ ORI (dtr 90)) #DWID#) nil) 
                    ANG)
       PT13 (polar PT  ANG #DWID#) 
        #WID2# (G_DIST #WID2# PT13 "\nRight Door Width ") 
  )     
  (setq  TH (getdist PT "\nDOOR thick <0.05>: "))
       (if (null TH) (setq TH 0.05))
  (setq PT12 (polar PT ANG TH)    PT2 (polar PT  ANG (+ #DWID# #WID2#))
                                   PT122 (polar PT13 ANG (- #WID2# TH)) 
        PT14 (polar PT12 (+ ORI PI) #DWID#) PT142 (polar PT122 (+ ORI PI) #WID2#)
        PT15 (polar PT (+ ORI PI) #DWID#)   PT152 (polar PT2 (+ ORI PI) #WID2#)
        PT22 (polar PT21 ANG #DWID#)   PT222 (polar PT21 ANG (+ #DWID# #WID2#))
  )
  (SBREAK PT2 PT) (SBREAK PT222 PT21)
  
  (maklyr "DOORS" "B" nil) 
  (command          
           "LINE" PT2 PT222 ""
           "PLINE" PT PT12 PT14 PT15 PT ""
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
           "ARC" PT13  PT14  PT15 
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
   )
  (command "PLINE" PT2 PT122 PT142 PT152 PT2 ""
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
           "ARC" PT13  PT142  PT152 
           "CHANGE" (entlast) "" "P" "LA" "doors" "C" "BYLAYER" ""
   )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:stair (/ pt tr ri no )
  (sta_rt)
  
    (setq pt (getpoint "\n Insertion Point :")
          tr (rtos (getdist  pt "\n Tread Length :"))
          ri (rtos (getdist  pt "\n Rise  :"))
          no (getint   "\n No. of Steps :")
    )
    (command "PLINE" pt )
    (repeat no (command  (strcat "@" ri "<90") (strcat "@" tr "<0")) )
    (command "")

  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:ELV (/ EPT ELV TPT)
     (sta_rt)
     (if sldflg (princ "\nSolid") (princ "\nHollow"))
     (if lftflg (princ " Left Sign") (princ " Right Sign"))
       
     (setq #RPT# (G_PT #RPT# "Riference Point ")
           EPT (getpoint "Elevation Point :")
           ELV (- (CADR EPT) (CADR #RPT#))
           ELV (if (and sgnflg (> ELV 0)) (strcat "+" (rtos ELV)) (rtos ELV))
           TPT (if lftflg (polar EPT (* PI 0.7) 0.32) 
                          (polar EPT (* PI 0.3) 0.32))
     )
     (if lftflg 
      (PROGN
       (command "PLINE" (polar EPT (dtr 45) 0.2) EPT "@0.2<135" "c"
                "line"  (polar EPT (dtr 135) 0.2) "@0.9<0" ""
       )         
       (MKTXT  NIL NIL TPT 0 "L" 0.2 ELV )
      )
      (PROGN
       (command "PLINE" (polar EPT (dtr 135) 0.2) EPT "@0.2<45" "c"
                 "line" (polar EPT (dtr 45) 0.2) "@0.9<180" "")
       (MKTXT  NIL NIL TPT 0 "R" 0.2 ELV )
      )
     )
     (if sldflg (command "SOLID" EPT "@0.2<45" EPT "@0.2<135"  ""))
     (if (> slbthk 0) (rect (polar EPT PI 0.3) 0 (* -1.0 slbthk) 0.6 1))
     (fin_sh)
)
(defun stsbtk () (setq slbthk (getdist "\n Slab Thich < 0 for none> :")))

;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:sum (/ nums i total tcou)
(sta_rt)
 (setq nums (ssget) i 0 total 0 tcou 0)
 (while (< i (sslength nums)) (progn
     (if (= (cdr (assoc 0 (entget (ssname nums i)))) "TEXT") 
         (setq value (atof (cdr (assoc 1 (entget (ssname nums i)))))
               total (+ total value)
               tcou  (+ tcou 1)
     )   )
     (setq i (+ i 1))
 ))  
 (setq inspt (getpoint "\Total Position :"))
 (if inspt (progn
     (MKTXT NIL NIL inspt 0 "M" (getvar "textsize") (RTOS TOTAL))
     (prompt  (strcat "\nSUM of " (itoa tcou) " Numbers = " (rtos total)))
 ))
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN c:tdim (/ ENT  nam  X Y a b R LENG angl pl_arc)
(sta_rt)
  
  (SETQ ENT  (car (ENTSEL "\nSelect LINE or ARC to be measured or < 2 Points >")))
  (if ent (progn
   (setq nam (cdr (assoc 0  (ENTGET ENT)))  ;e.g "POLYLINE" 
           X (CDR (ASSOC 10 (ENTGET ENT)))  ;start pt. or center
           Y (CDR (ASSOC 11 (ENTGET ENT)))  ;end pt. 
           a (CDR (ASSOC 50 (ENTGET ENT)))  ;start angle of arc
           b (CDR (ASSOC 51 (ENTGET ENT)))  ;end angle of arc
           R (CDR (ASSOC 40 (ENTGET ENT)))  ;Raduis or text Hight
   )
   (cond 
    ((= nam "LINE") 
          (setq leng  (rtos(ABS (DISTANCE Y X))))
    )
    ((= nam "ARC") 
          (setq leng (rtos (* r (if 
                             (> a b) 
                             (+ (* 2.0 PI) (- b a)) 
                             (- b a)
                     )    ))
                y (polar x a r)
                x (polar x b r)
          )
    )
    ((= nam nam) (setq pl_arc (princ "\nSelect LINE or ARC only ! ") ))
   )
  ) (progn
    (setvar "osmode" 1)
    (setq    x (TRANS(getpoint "\nFirst Point : end of")1 0)
             y (TRANS(getpoint "\nSecond Point : end of")1 0)
          leng (if (and x y) (rtos(ABS (DISTANCE Y X))) nil)
    )
    (setvar "osmode" 0)
  ))
  (if (and leng (null pl_arc)) (progn
    (setq  angl  (if (and (> (angle x y) (* 0.5 PI)) 
                          (< (angle x y) (* 1.5 PI))
                     )
                     (angle y x)
                     (angle x y) 
    )            )
    (setq inspt (trans (getpoint "\nPosition of Text ? :") 1 0))
    (MKTXT NIL NIL inspt angl "M" (getvar "textsize") leng)
  ))
(fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:tri () (sta_rt)(rectri "Triangle")(fin_sh))
(defun c:rec () (sta_rt)(rectri "Rectangle")(fin_sh))
;------------------------------------------------------------------------
(defun rectri ( trirec / nums i total tcou prenam)
(setq prenam (getstring "\nPrefix Text :")
      prenam (if (= prenam "") "" (STRCAT prenam " = "))
      num1a (cdr(assoc 1 (entget(car(entsel(strcat "\nPick Base of " trirec ":"
            )   )        )      )   )      )
       num1 (atof num1a)
      num2a (cdr(assoc 1 (entget (car(entsel(strcat "\nPick Hight of " trirec ":"
            )   )        )      )   )      )
       num2  (atof num2a)
      total (/ (* num1 num2) (if (= trirec "Triangle")  2.0 1.0))
        det (strcat prenam num1a " x " num2a  (if(= trirec "Triangle") " / 2.0  = " " = ") )
 )
 (if (/= (+ num1 num2 ) 0) (progn
   (setq inspt (getpoint "\nMath. Operation Position :"))
   (MKTXT NIL NIL inspt 0 "L" (getvar "textsize") det)
   (setq inspt2 (getpoint "\nResult Position :")
         inspt2 (if (= (getvar "orthomode") 0)
                    inspt2
                    (list (car inspt2 ) (cadr inspt))
                )
   )
   (MKTXT NIL NIL inspt2 0 "L" (getvar "textsize") (RTOS TOTAL))
 ))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TRA (/ nums i total tcou prenam)
(sta_rt)
(setq prenam (getstring "\nPrefix Text :")
      prenam (if (= prenam "") "" (STRCAT prenam " = "))
      
      num1a (cdr(assoc 1 (entget(car(entsel"\nPick First Base of Trapizoidal :"
            )   )        )      )   )      
       num1 (atof num1a)
      
      num2a (cdr(assoc 1 (entget(car(entsel"\nPick Second Base of Trapizoidal :"
            )   )        )      )   )      
       num2 (atof num2a)
      num3a (cdr(assoc 1 (entget(car(entsel"\nPick  Hight of Trapizoidal :"
            )   )        )      )   )      
       num3 (atof num3a)
      total (* 0.5 (+ num1 num2) num3) 
        det (strcat prenam " ( "num1a " + " num2a " ) x " num3a " / 2.0 = ")
 )
 (if (/= (+ num1 num2 ) 0) (progn
   (setq inspt (getpoint "\nMath. Operation Position :"))
   (MKTXT NIL NIL inspt 0 "L" (getvar "textsize") det)
   (setq inspt2 (getpoint "\nResult Position :")
         inspt2 (if (= (getvar "orthomode") 0)
                    inspt2
                    (list (car inspt2 ) (cadr inspt))
                )
   )
   (MKTXT NIL NIL inspt2 0 "L" (getvar "textsize") (RTOS TOTAL))
 ))
 (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:SEC ()
 (sta_rt)
 (SETQ ENT  (ENTSEL "\nSelect ARC :")
        ENT  (car ENT)
        nam (cdr (assoc 0  (ENTGET ENT)))
          a (CDR (ASSOC 50 (ENTGET ENT)))
          b (CDR (ASSOC 51 (ENTGET ENT)))
          R (CDR (ASSOC 40 (ENTGET ENT)))  ;Raduis or text Hight
  )
  (if     (= nam "ARC") 
          (progn 
             (setq alfa  (/(if(> a b)  (+(* 2.0 PI)(- b a))  (- b a))2.0)
                   total (* r r 
                            (- alfa 
                               (* (cos alfa) (sin alfa))
                            )
                         )
                   inspt (getpoint "\nMath. Operation Position :")
                   det   "R^2 x [a-cos(a) x sin(a)Y"
             )
            (MKTXT NIL NIL inspt 0 "L" (getvar "textsize") det)
            (setq inspt2 (getpoint "\nResult Position :")
                  inspt2 (if (= (getvar "orthomode") 0)
                             inspt2 
                             (list (car inspt2 ) (cadr inspt))
                         )
            )
            (MKTXT NIL NIL inspt2 0 "L" (getvar "textsize") (RTOS TOTAL))
          )       
  )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun DOT (lay lyc po an)
  (MAKLYR LAY LYC NIL)
  (COMMAND "DONUT" "0" "0.1" PO ""
           "CHANGE" (entlast) "" "p" "la" lay ""
  )
  (MKLINE lay lyc (polar po (+ (/ PI 2.0) an) 0.2)
                  (polar po (+ (/ PI 2.0) an PI) 0.2)
  ) 
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun TIC (lay lyc po an)
  (MAKLYR LAY LYC NIL)
  (MKLINE lay lyc (polar po (+ (/ PI 4.0) an) 0.2)
              (polar po (+ (/ PI 4.0) an PI) 0.2)
  )
  (MKLINE lay lyc (polar po (+ (/ PI 2.0) an) 0.3)
              (polar po (+ (/ PI 2.0) an PI) 0.3)
) )
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN ARROW (LAY LYC IPT)
   (MKSOLD LAY LYC ipt (mov ipt 0.2 0.05) (mov ipt 0.2 -0.05) NIL)
   (MOV IPT 0.2 0)
)   
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun LNK ( LAY LYC ppt vv hh f ARW lap gab / LAPB GABB PS PS2)
  (SETQ LAY  (IF LAY LAY (GETVAR "CLAYER"))
        LAPB (IF (= F 0) 0 LAP) 
        GABB (IF (= F 0) 0 GAB) 
        ps   (mov ppt hh (- vv gabB))
        ps2 (mov ppt (+ hh gabB) vv)
        ARWPOS (MOV PPT HH (/ VV 2.0))
  )
  (MAKLYR LAY LYC NIL)
  (command "pline" (polar ps pi lapB) ps (mov ppt hh 0) ppt
           (mov ppt 0 vv) ps2 (mov ps2 0 (* -0.7 lapB)) "" 
           "fillet" "r" f "fillet" "p" (entlast)
           "change" (entlast) "" "p" "la" lay ""
  )
  (IF ARW (ARROW "LEADER" "C" ARWPOS) ARWPOS)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun blbl (tx h_ b_ ipt)

    (rect (mov ipt (* -1.0 (/ b_ 2.0)) 
                   (* -1.0 (/ h_ 2.0))
          ) 
          0 
          h_ 
          b_ 
          1
    )
    (command "fillet" "r" "0.1" "fillet" "p" (entlast) 
             "change" (entlast) "" "p" "la" "out" ""
    )         
    (MKTXT "TEXT" "Y" ipt 0 "M" 0.2 TX)
    
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN BMBRDR ( LAY LYC IPT H B LTS RTS / URPT ULPT MRPT MLPT DRPT DLPT)
  
  (MAKLYR LAY LYC NIL)
  (SETQ LAY  (IF LAY LAY (GETVAR "CLAYER"))
        ULPT (MOV IPT 0 H)
        MLPT (MOV ULPT 0 (* -1.0 (if LTS lts 0)))
        URPT (MOV IPT B H)
        MRPT (MOV URPT 0 (* -1.0 (if RTS rts 0)))
        DRPT (MOV IPT B 0)
        DLPT IPT
  )
  
  (MKLINE LAY LYC ULPT URPT)
  (MKLINS LAY LYC (LIST MLPT IPT DRPT MRPT))
  (if lts (progn
  (MKLINE LAY LYC ULPT (MOV ULPT -1.0 0))
  (IF (> LTS 0) (MKLINE "OUT" "G" MLPT (MOV MLPT -1.0 0)))
  (MKLINE LAY LYC DLPT (MOV DLPT -1.0 0))
  (CUT "LEADER" "C" (MOV DLPT -1.0 0) (MOV ULPT -1.0 0) 0.3)
  ))
  (if rts (progn
  (MKLINE LAY LYC URPT (MOV URPT 1.0 0))
  (IF (> RTS 0) (MKLINE "OUT" "G" MRPT (MOV MRPT 1.0 0)))
  (MKLINE LAY LYC DRPT (MOV DRPT 1.0 0))
  (CUT "LEADER" "C" (MOV DRPT 1.0 0) (MOV URPT 1.0 0) 0.3)
  ))
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun P2LDis (p2t pl1 pl2)
   
   (setq xpt (inters p2t (polar p2t (+ (dtr 90) (angle pL1 pL2)) 1) 
                     pL1 pL2 nil)
   )
   (distance p2t xpt)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun LxLis ( px1 px2 lista)
   (setq co -1 lispts '() )
   (repeat (- (length lista) 1)
      (setq  co  (1+ co)
             ipt (inters px1 px2 (nth co lista) (nth (1+ co) lista))
             lispts (if ipt (append lispts (list ipt)) lispts) 
   )  )
   lispts
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:beam ( / pt b h h2 lst rst nu du nd dd ns sd sps bn bt m1 
                  cov cov2 spd spu pvd pv pvu gab lap n spc pos 
                  npos pv2 pv3 pt3 ptd pt3d p1 p2 p3 p4
              )
(sta_rt)
 (setq pt  (getpoint "\nInsertion Point ")
      b   (* 5.0 (getdist pt "\nBeam Breadth (m) = "))
      h   (* 5.0 (getdist pt "\nBeam Hight (m) = "))
      h2  (/ h 2.0) b2 (/ b 2.0)
      LST (getdist pt "\nLeft Slab Thick. (m) <None> = ") 
      lst (* 5.0 (if lst lst -1))
      RST (getdist pt "\nRight Slab Thick. (m) <None> = ")
      rst (* 5.0 (if rst rst -1))
      nu  (getint "No. of Top Bars = ")
      du  (getint "Diameter of Top Bars = ")
      nd  (getint "No. of Buttom Bars = ")
      dd  (getint "Diameter of Buttom Bars = ")
      ns  (getint "No. of stirrups in section = ")
      SD  (GETINT " Diam. (mm) = ")
      sps (GETINT "\n STIRRUP SPACING (cm) = ")
      BN  (GETSTRING " BEAM NAME : ")
      BT  (STRCAT "%%U SECTION. TRROUGH " BN )
      m1  0.4
      cov 0.15 cov2 0.3 
      spd (/ (- b cov2 cov2) (- nd 1))
      spu (/ (- b cov2 cov2) (- nu 1))
      pv  (mapcar '+ pt  (list cov cov))
      pvd (mapcar '+ pt  (list cov2 cov2))
      pvu (polar pvd (/ PI 2.0) (- h cov2 cov2))
      gab 0.05  lap 0.3
 ) 
 (BMBRDR "OUT" "C" PT H B (if (< LST 0) nil lst) (if (< RST 0) nil rst))
 (SETQ PT3M (LNK "LINK" "Y" pv (- h cov cov) (- b cov cov)  0.1 1 lap gab))
 (MAKLYR "STEELROD" "B" NIL)
 (command "DONUT" "0" "0.125" pvd "" 
          "CHANGE" (entlast) "" "p" "la" "STEELROD" ""
          "ARRAY" (entlast) "" "R" "1" nd spd
 )
 (command "DONUT" "0" "0.125" pvu "" 
          "CHANGE" (entlast) "" "p" "la" "STEELROD" ""
          "ARRAY" (entlast) "" "R" "1" nu spu       
 )
 (if (and (> (min nu nd) 3) (>= ns 2)) (progn
    (setq spc (min spd spu) 
          n   (- (max nu nd) 1)
          pos (*  (fix (/ n 3.0)) spc) ;pos. of stirr. from pvu|d
    )
    (if (< nu nd ) 
        (setq pv2 (polar pvu 0 pos)) ;pv2 is left target
        (setq pv2 (polar pvd 0 pos))
    )
    (setq spc (max spd spu) 
          n   (- (min nu nd) 1)
          npos (/ pos spc)
          pv3 (polar pvu 0 pos)
    )
    (if (> (- npos (fix npos)) 0.5) 
        (setq npos (+ (fix npos) 1))  
        (setq npos (fix npos))  ;no. of left moved bar
    )
    (if (< nu nd) 
        (setq pv (polar pvu 0 (* npos spc)))
        (setq pv (polar pvd 0 (* npos spc))) ;pv pos bar of to be meved
    )               
    (command  "MOVE" "nea" pv "" pv pv2 )
    (setq pvu (polar pvu 0 (- b cov2 cov2))
          pvd (polar pvd 0 (- b cov2 cov2))
    )
    (if (< nu nd ) 
        (setq pv2 (polar pvu PI  pos ))
        (setq pv2 (polar pvd PI  pos ))
    )
           
    (if (< nu nd ) 
        (setq pv (polar pvu PI (* npos spc)))
        (setq pv (polar pvd PI (* npos spc)))
    )               
    (setq pv4 (polar pvu PI  pos ))
    (command "MOVE" "nea" pv "" pv pv2 )
                 
    (setq pv2 (polar pt 0 (+ cov pos))
          pv2 (polar pv2 (/ PI 2.0)  cov )
      PT3M (LNK "LINK" "Y" pv2 (- h cov cov) (- b cov2 pos pos) cov 1 lap gab)
    )
 ) 
 
   (setq pvu (polar pvu 0 (- b cov2 cov2)))
 ) 
       
 (setq pt3  (MOV Pvu 1.4 0.7)
       PTD  (MOV PVU 0 (* -1.0 (- H COV2 COV2)))
       PT3D (MOV PTD 1.4 -0.7)
 )
 (MKLINS "LEADER" "C" (LIST pvu (MOV PVU 0 0.7) PT3))
 (MKLINE "LEADER" "C" pt3M (LIST  (CAR PT3) (CADR PT3M)))
 (MKLINS "LEADER" "C" (LIST ptd (MOV PTD 0 -0.7) PT3D))
 
 
 (MKTXT "TEXT" "Y" pt3 0 "L" 0.2 (strcat " " (itoa nu) " Y" (itoa du)))
 (MKTXT "TEXT" "Y" (LIST  (CAR PT3) (CADR PT3M))  0 "L" 0.2 
        (strcat " " (itoa ns) " Y" (itoa sd) "@" (itoa sps) ))         
                
 (MKTXT "TEXT" "Y" (LIST  (CAR PT3) (CADR PT3D)) 0 "L" 0.2 
        (strcat " " (itoa nd) " Y" (itoa dd)))
 (setq P1 (polar PT PI (+ m1 1)) 
       P2 (polar P1 (/ PI 2.0) H) 
       P3 (polar PT (* PI 1.5) (+ m1 m1)) 
       P4 (polar P3 0 B) 
 )      
 (tic "DIM" "M" P1 (/ PI 2.0)) 
 (tic "DIM" "M" P2 (/ PI 2.0)) 
 (tic "DIM" "M" P3 0) (tic "DIM" "M" P4 0)

 (mkline "DIM" "M" P1 P2) (mkline "DIM" "M" P3 P4)
 (setq P1 (mapcar '+ P1 (list -0.2 H2))
       P3 (mapcar '+ P3 (list b2 0.2))
       P4 (mapcar '+ PT (list b2 -1.2))
 )
 (MKTXT "DIM" "M" p1 (dtr 90) "M" 0.2 (rtos (* 20 h) 2 0))
 (MKTXT "DIM" "M" p3 0 "M" 0.2 (rtos (* 20 b) 2 0))
 (MKTXT "TEXT"  "Y" p4 0 "M" 0.2 bt)
 (setq  LEFTPT (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        MIDPT (CDR (ASSOC 11 (ENTGET (ENTLAST))))
        XMOV   (DISTANCE LEFTPT MIDPT)
 )
 (MKTXT "TEXT" "Y" (MOV p4 XMOV -0.5) 0 "R" 0.18 "1:20")
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:cbeam(/ rpt0 rpt shft shftd co tmpt tmp2)
(sta_rt)
  (maklyr "STEEL" "R" nil)
  (maklyr "LCEN"  "B" "dashed")
  (maklyr "TEXT" "Y" nil)
  (maklyr "OUT" "C" nil)

  (setq #ns# (g_int #ns# "No. of spans")
        rpt  (g_pt rpt "Start Point ")
        rpt0 rpt
        shft 0   shftD 0.1
        co 0
        bnms ""
  )
   
 (repeat #ns# (progn
  (setq bnm  (g_str bnm "Beam Name  ")
        bnms (strcat bnms "," bnm)
        l#   (g_dist l# rpt (strcat "span " (itoa (1+ co)) " Length "))
        bsn# (g_str bsn# "No. of Buttom Steel Bars ")
        bsd# (g_str bsd# "Buttom steel Dia. ")
        tpt  (mov rpt (/ l# 2.0) (+ SHFT 0.2))
        co   (1+ co)
  )
  (IF (< CO #NS#)
   (setq Tl#  (g_dist Tl# NIL "Top Steel Length (mizan)")
         Tsn# (g_str Tsn# "No. of Top Steel Bars (mizan) ")
         Tsd# (g_str Tsd# "Top Steel Dia. (mizan) ")
         TSDL (IF (= CO 1) TSD# TSDL)
         TLL  (IF (= CO 1) (- L# (/ TL# 2.0) -0.5) TLL)
   )
   (SETQ TSDR (IF (/= #NS# 1) TSD# 14)
         TLR  (IF (/= #NS# 1) (- L# (/ TL# 2.0) -0.5) (+ 0.3 L#))
  ))

  (mkline "lcen" "B" (mov rpt 0 -2) (mov rpt 0 2))
  (mkline "STEEL" "R" (mov rpt -0.15 shft) (mov rpt (+ 0.15 l#) shft))
  (MKTXT "TEXT" "Y" tpt 0 "M" 0.2 (strcat  bsn# "Y" bsd#))
    
  (blbl bnm 0.5 1.0 (mov tpt 0 (+ (* -1 shft) -1.8)))
  (setq rpt (mov rpt l# 0)
        shft (if (= shft 0) SHFTD 0)
  )
  (IF (< CO #NS#) (progn
   (mkline "STEEL" "R" (mov rpt (/ TL# -2.0) 1.5)(mov rpt (/ TL# 2.0) 1.5))
   (mktxt "TEXT" "Y" (MOV RPT 0 1.7) 0 "M" 0.2
           (strcat  Tsn# "Y" Tsd# " x" (RTOS (* 100 TL#) 2 0) )
  )))
 
 ));rep progn
 (mkline "lcen" "B" (mov rpt 0 -2) (mov rpt 0 2))
 (setq bnms (SUBSTR bnms 2))
 (MKTXT "TEXT" "Y" (mov rpt0 (/ (distance rpt rpt0) 2.0) -2.5) 
        0 "M" 0.2 (strcat "%%uLONG. SECTION IN BEAM (" BNMS  ")   1:100")
 )
 (mkline "STEEL" "R" (mov rpt0 -0.15 0) (mov rpt0 -0.15 0.5))
 (mkline "STEEL" "R" (mov rpt 0.15 (if (= shft 0) SHFTD 0)) 
         (mov rpt 0.15 (+ (if (= shft 0) SHFTD 0) 0.5))
 )
 (setq tmpt (mov rpt 0.15 (- 1.5 SHFTD))
       tmp2 (mov tmpt (* -1 TLR) 0)
 )
 (mkline "STEEL" "R"  tmpt tmp2)
 (mkline "STEEL" "R"  tmpt (mov tmpt 0 -0.4))
 (IF (< 1 #NS#)(progn
    (setq tmpt (mov rpt0 -0.15 (- 1.5 SHFTD)))
    (mkline "STEEL" "R" tmpt (mov tmpt TLL 0))
    (mkline "STEEL" "R" tmpt (mov tmpt 0 -0.4))
               )
    (mkline "STEEL" "R"  tmp2 (mov tmp2 0 -0.4))
 )
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:ARW ( / P1 DST)  
(STA_RT) 
  (SETQ P1 (ARROW NIL NIL (GETPOINT "Insertion Point : "))
        DST (GETDIST P1 "ARROW LENGTH : ")
  )
  (MKLINE NIL NIL P1 (MOV P1 DST 0))
(FIN_SH)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:LNK ( / IPT P2 X1 X2 F)
(STA_RT)
(SETQ IPT (GETPOINT "\nFirst Corner <ENTER for Radius>:"))
(if (null ipt) 
    (SETQ F  (GETDIST 
             (STRCAT "\nFillet Radius <" (RTOS (GETVAR "FILLETRAD")) "> :"))
          F  (IF F F (GETVAR "FILLETRAD"))
         IPT (GETPOINT "\nFirst Corner :")
)   )
(SETQ P2  (GETCORNER IPT "\nSecond Corner :")
      X1  (CAR IPT) Y1 (CADR IPT)
      X2  (CAR P2) Y2 (CADR P2)
)
(LNK NIL NIL (LIST(MIN X1 X2)(MIN Y1 Y2))(ABS(- Y1 Y2))(ABS(- X1 X2)) F NIL 0.3 0.05)
(FIN_SH)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:rib (/ poly lis ang p1 p2 p3 big far tot co nofrbs frg movpt1 
                movpt2 ribp1 ribp2 ribp3 ribp4 frst2p scnd2p tmp3)
(sta_rt)
  (setq poly (car (entsel "\nSelect boundary PLINE :"))
        lis  (gtver poly)
        ang  (getangle "\nRibs angle :")
        web  (G_DIST web nil "\nWeb  Width :")
        fln  (G_DIST fln nil "\nFlange  Width :")  
        p1   (car lis)
        p2   (polar p1 ang 5)
        p3   (polar p1 (+ (dtr 90) ang) 5)
        big  0
        far p1
        tot 0
        co   -1  
  )
  (repeat (length lis)
   (progn
    (setq co  (1+ co)
          dis (P2LDis (nth co lis) p1 p2)
    )
    (if (> dis big) (setq big dis far (nth co lis)))
    (setq tot (+ tot (abs (distance (nth co lis) 
                                    (if (nth (1+ co) lis)
                                        (nth (1+ co) lis)
                                        (nth co lis)
                                    )
    
                          )
                     )
              )
    )
  )) 
  (setq dis 0 
        co  -1 
        big 0
        p1  far
        p2  (polar p1 ang 5)
  )
  (repeat (length lis)
   (progn
    (setq co  (1+ co)
          dis (P2LDis (nth co lis) p1 p2)
    )
    (if (> dis big)(setq big dis far (nth co lis)))
  )) 
  (setq p2  far             ;now p1 p2 are boundry points
        dir (angle (inters p1
                           (polar p1 ang 1)
                           p2
                           (polar p2 (+ ang (dtr 90)) 1)
                           nil
                   )
                   p2
            )
        Nofrbs (/ big (+ web fln))
        frg    (* (- Nofrbs (fix Nofrbs)) (+ web fln))
        Nofrbs (fix Nofrbs)
        
        movpt1 (polar p1 ang tot)
        movpt2 (polar p1 (+ ang pi) tot)
  )
  (entdel poly)
  (repeat Nofrbs (progn
   (setq frst2p (lxlis movpt1 movpt2 lis)
         ribp1  (car frst2p)
         ribp2  (cadr frst2p)
         
         movpt1 (polar movpt1 dir fln)
         movpt2 (polar movpt2 dir fln)
         
         scnd2p (lxlis movpt1 movpt2 lis)
         ribp3  (car scnd2p) 
         ribp4  (cadr scnd2p)
   )      
         (if (inters ribp1 ribp3 ribp2 ribp4)
             (setq tmp3    ribp3   
                   ribp3  ribp4 
                   ribp4  tmp3 
             )
         ) 

   
     (mkline nil nil ribp1 ribp2)
     (mkline nil nil ribp1 ribp3)
     (mkline nil nil ribp3 ribp4)
     (mkline nil nil ribp4 ribp2)
     (setq movpt1 (polar movpt1 dir  web )
           movpt2 (polar movpt2 dir  web )
     )
  ))
  
  (princ frg)(princ "-")(princ web)
 
 (if (> frg web) (progn
   (setq frst2p (lxlis movpt1 movpt2 lis)
         ribp1  (car frst2p)
         ribp2  (cadr frst2p)
         movpt1 (polar movpt1 dir frg)
         movpt2 (polar movpt2 dir frg)
         scnd2p (lxlis movpt1 movpt2 lis)
         ribp3  (car scnd2p) 
         ribp4  (cadr scnd2p)
   )
     (if (inters ribp1 ribp3 ribp2 ribp4)
         (setq tmp3   ribp3   
               ribp3  ribp4 
               ribp4  tmp3 
         )
     ) 
     (mkline nil nil ribp1 ribp2)
     (mkline nil nil ribp1 ribp3)
     (mkline nil nil ribp3 ribp4)
     (mkline nil nil ribp4 ribp2)
   ))
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:foot ()
(sta_rt)
   (SETQ scale 5.0             ;   1:20
         blnd (* 0.1 scale)
         cv (* scale 0.075)  cv2 (* cv 2.0)
         hbd (* 0.025 scale)
         bbd (* 0.025 scale) 
         PT (getpoint "\nInsertion point :")
         PTb (mov pt (* -1.0 blnd) (* -1.0 blnd))
         b  (* scale (getdist "\nFoot Base width Bf (Horizontal) (m):"))
         h  (* scale (getdist "\nFoot Side Hight Hf (Vertical) (m):"))
         t  (* scale (getdist "\nFoot Thickness :"))
         
        bc  (* scale (getdist pt "\nColumn Base Width Bc (Horizontal) (m): "))
        hc  (* scale (getdist pt "\nColumn Side Hight Hf (Vertical) (m): "))
        nb  (getint "\nColumn No. of Bars    : ")
        nl  (getint "\nNo. of Layers  : ")
        bdn (fix (getreal "\nColumn Bar Diameter (mm) : "))

         PTc (mov pt (/ (- b bc) 2.0) (/ (- h hc) 2.0))
         bent (- t cv2 cv)
         neck (* 3 t)
         bd 0.125
         ccb (- b cv2 bd bd)  ; hbd bbd bbd)
         cch (- h cv2 bd bd)  ;bbd hbd hbd)
         Bb  (+ B blnd blnd)
         Hb  (+ H blnd blnd)
         m1  0.6
         gab 2
         nbb nil nbh nil
   )
   
   (SETQ nbb (getint "\n # of bars in Bf dir. (Horizontal) <Enter for spacing> : "))
   (if (null nbb) (SETQ hsp (* scale (getdist "\nSpacing (m):"))))

   (SETQ bdb (fix (getreal "\n Bar Diameter (mm) : "))
     nbh (getint "\n # of bars in H dir. (Vertical) <Enter for spacing> : "))
   
   (if (null nbh) (SETQ bsp (* scale (getdist "\nSpacing (m):"))))
    
   (setq bdh (fix (getreal "\n Bar Diameter (mm) : "))
         FNAM (GETSTRING "\nFoot Name :")
   )

   
   (if nbb (SETQ hsp (/ cch (- nbb 1)))             ;h direc spaceing
           (SETQ nbb (fix (+ 0.5 (/ cch hsp))))     ;hsp now needs correction
   )
   (if nbh (SETQ bsp (/ ccb (- nbh 1)))             ;b direc spaceing
           (SETQ nbh (fix (+ 0.5 (/ ccb bsp))))     ;practically for bsp no 
                                                    ;correction is requiered
   )
   (SETQ bsp (/ ccb (- nbh 1))
         PTbu (mov PTb  0 (+ Hb gab))
         PTu  (mov PTbu  blnd blnd)
         colret  (col ptc bc hc nb nl bdn bn nil)
   )
   (BMBRDR "CONCOUT" "W" PT H B nil nil)
   (BMBRDR "BLINDING" "C" PTb Hb Bb nil nil)
   (BMBRDR "CONCOUT" "W" PTc Hc Bc nil nil)
   (BMBRDR "BLINDING" "C" (mov PTb 0 (+ Hb gab)) blnd Bb nil nil)
   (SETQ p1 (mov PTb blnd (+ Hb gab blnd)) 
         p2 (mov p1 0 t)
         p3 (mov p2 (/ (- B Bc) 2.0 ) 0 )
         p4 (mov p3 0 neck)
       ylnk (cadr p3)
       ypd1 (cadr p4) ;start left dowel L-shape
         
         p5 (mov p4 Bc 0)
         p6 (mov p3 Bc 0)
         p7 (mov p2 B 0)
         p8 (mov p1 B 0)
   )
   (mklins "CONCOUT" "W" (LIST p1 p2 p3 p4))
   (mklins "CONCOUT" "W" (LIST p5 p6 p7 p8))
   (cut "LEADER" "C" p4 p5 cv)
   (SETQ p2 (mov PT cv cv2) 
         p1 (mov p2 0  bent )
         p3 (mov p2 (- b cv2) 0)
         p4 (mov p1 (- b cv2) 0)

         p6 (mov PTu cv cv) 
         
         ypd2 (+ (cadr p6) (* 5.0 bd)) ;turn pt. left dowel L-shape
         
         p5 (mov p6 0 bent )
         p7 (mov p6 (- b cv2) 0)
         p8 (mov p5 (- b cv2) 0)
   )
  (MAKLYR "STEEL" "R" NIL)
  (command "pline" P1 P2 P3 P4 "" "change" (entlast) "" "p" "la" "STEEL" ""
           "pline" P5 P6 P7 P8 "" "change" (entlast) "" "p" "la" "STEEL" ""
  )
   (SETQ p8 (mov p7 (* -1 bd) bd)          ;up ntext
         p7 (mov p6 bd bd)                 ;start donut
         p5 (mov p2 (/ (- b cv2) 2.0) cv)  ;Hor text
         p2 (mov P3 (* -1 cv) (* -1 cv))   ;
         p1 (mov p2 (* -1 bent) 0)         ; up U-steel
         p3 (mov p2 0 (- h cv2))           ;
         p4 (mov p1 0 (- h cv2))           ;
         p6 (mov p2 (* -1 cv) (/ (- h cv2) 2.0)) ;Ver text
   )
  (command "DONUT" "0" bd p7 "" 
           "CHANGE" (entlast) "" "p" "la" "STEEL" ""
           "ARRAY" (entlast) "" "R" "" nbh bsp
  )
 (command "pline" P1 P2 P3 P4 "" "change" (entlast) "" "p" "la" "STEEL" "")
 (MKTXT "TEXT" "Y" p5  0 "M" 0.2 
        (strcat " B" (itoa nbb) "Y" (itoa bdb)))         
 (MKTXT "TEXT" "Y" p6  (dtr 90)  "M" 0.2 
        (strcat " B" (itoa nbh) "Y" (itoa bdh) ))         
 (mkline "LEADER" "C" (ARROW "LEADER" "C" p8) (mov p8 (+ cv2 cv2)0))
 (MKTXT "TEXT" "Y" (mov p8 (+ cv2 cv2)0)  0  "L" 0.2 
        (strcat " B" (itoa nbh) "Y" (itoa bdh) ))         
 (SETQ p8 (mov p8 bd (/ bent 2.0)))
 (mkline "LEADER" "C" (ARROW "LEADER" "C" p8) (mov p8 (+ cv2 cv2)0))
 (MKTXT "TEXT" "Y" (mov p8 (+ cv2 cv2)0)  0  "L" 0.2 
        (strcat " B" (itoa nbb) "Y" (itoa bdb) ))         
 
 
 (MKline "STEEL" "R" (list (cadr colret) ypd1) (list (cadr colret) ypd2))
 (command "ARRAY" (entlast) "" "R" "" (- (car colret) 1) (nth 3 colret))
 
 (MKline "STEEL" "R" (list (cadr colret) ypd2)
                     (list (+ (cadr colret) (* (caddr colret) 0.225)) ypd2)
 )
 (mklins "STEEL" "R" (list 
                      (list (nth 4 colret) ypd1) 
                      (list (nth 4 colret) (- ypd2 bd bd)) 
                      (list (- (nth 4 colret) (* (caddr colret) 0.225)) (- ypd2 bd bd))
                      )

  )
  (MKline "STEELLNK" "Y" (list (cadr colret) YLNK)
                         (list (NTH 4 colret) YLNK) 
  )
  (command "ARRAY" (entlast) "" "R" (fix neck) "" 1)
 
 
 (SETQ  pt1 (list (- (nth 4 colret)  (/(nth 3 colret)2.0))
                  (+ ylnk (fix(/ neck 2.0)))
            ) 
        pt2 (mov pt1 0 0.5)
        pt3 (mov pt1 1.7 0.5)
        
        pt4 (mov pt1 (/(nth 3 colret)2.0) -0.5)
        pt5 (mov pt4 (- 1.7 (/(nth 3 colret)2.0)) 0)
        
 )
 (MKLINS "LEADER" "C" (list pt1 pt2 pt3))
 (MKLINE "LEADER" "C" (ARROW "LEADER" "C" pt4) pt5)
 (MKTXT "text" "Y" pt3 0 "L" 0.2 
        (strcat " " (itoa (nth 6 colret)) "Y8/20cm" ))
 (MKTXT "text" "Y" pt5 0 "L" 0.2 
        (strcat " " (itoa (nth 5 colret)) "Y" (itoa (caddr colret)) )) 
        
(qvhdm "dim" "m" (mov ptb (+ blnd blnd b 2) 0) 
       (list blnd (/(- h hc)2.0) hc (/(- h hc)2.0) blnd)
       "V" 20
)
(qvhdm "dim" "m" (mov ptb (+ blnd blnd b 3) 0) 
       (list blnd h blnd)
       "V" 20
)
(qvhdm "dim" "m" (mov ptb (+ blnd blnd b 4) 0) 
       (list (+ blnd h blnd))
       "V" 20
)
(qvhdm "dim" "m" (mov ptb 0 (+ blnd blnd h (/ 2.0 gab))) 
       (list blnd (/(- b bc)2.0) bc (/(- b bc)2.0) blnd)
       "H" 20
)
(qvhdm "dim" "m" (mov ptb 0 -1)
       (list blnd b blnd)
       "H" 20
)
(qvhdm "dim" "m" (mov ptb 0 -2)
       (list (+ blnd b blnd))
       "H" 20
)
(qvhdm "dim" "m" (mov ptbu (+ blnd blnd b 3) 0) 
       (list blnd t)
       "V" 20
)
(qvhdm "dim" "m" (mov ptbu (+ blnd blnd b 4) 0) 
       (list (+ blnd t))
       "V" 20
)
  
  (SETQ PTTITL (MOV PTB (/ B 2.0) -3)
          FTXT (STRCAT "%%USEC. IN " FNAM)
  )
 (MKTXT "TEXT"  "Y" PTTITL 0 "M" 0.3 FTXT)
 (setq  LEFTPT (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        MIDPT (CDR (ASSOC 11 (ENTGET (ENTLAST))))
        XMOV   (DISTANCE LEFTPT MIDPT)
 )
 (MKTXT "TEXT" "Y" (MOV PTTITL XMOV -0.5) 0 "R" 0.18 "1:20")
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:col (/ PT BC HC NB NL BDN BN BT)
(sta_rt)
  (SETQ pt  (getpoint "\n Insertion Point :")
        bc   (* 5.0 (getdist pt "Base Width  : "))
        hc   (* 5.0 (getdist pt "Side Hight  : "))
        nb  (getint "No. of Bars  : ")
        nl  (getint "No. of Layers  : ")
        bdn (fix (getreal "Bar Diameter (mm) : "))
        BN  (GETSTRING " COLUMN NAME : ")
        BT  (STRCAT "%%USEC. IN COLUMN " BN )
  )     
(col pt bc hc nb nl bdn bn bt)
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun col (pt b h nb nl bdn bn bt / b2 h2 m1 bd cv cv2 gab nbl nl2b lap
                                     pvd cch hsp ccv pvu vsp pvm nhlnk 
                                     pt3m pvhl blnk skp nvlnk pvbl hlnk 
                                     pt3 ns p1 p2 p3 p4 pt leftpt midpt xmov
           )
 (SETQ  b2  (/ b 2.0)
        h2  (/ h 2.0)
        m1  0.4
        bd  0.125
        cv 0.15 cv2 0.3 
        gab 0.05  lap 0.3
        nL2b (- nl 2)
        nbL (/ (- nb (* nL2b 2) ) 2)
        pvd (mov pt cv2 cv2)
        cch (- b cv2 cv2)
        hsp (/ cch (- nbl 1.0))
        ccv (- h cv2 cv2 )
        pvu (mov pvd cch ccv)
        vsp (/ ccv (- nl 1.0))
  )
  (BMBRDR "CONCOUT" "C" PT H B nil nil) 
  (MAKLYR "STEELROD" "B" NIL) 
  (command "DONUT" "0" bd pvd "" 
           "CHANGE" (entlast) "" "p" "la" "STEELROD" ""
           "ARRAY" (entlast) "" "R" "2" nbl ccv hsp
  )
  (if (> nL2b 0) (progn
    (SETQ pvm (mov pvd 0 vsp))
    (if (> nL2b 1)
        (command "DONUT" "0" bd pvm "" 
                 "CHANGE" (entlast) "" "p" "la" "STEELROD" ""
                 "ARRAY" (entlast) "" "R" nL2b "2" vsp cch
        )
        (command "DONUT" "0" bd pvm "" 
                 "CHANGE" (entlast) "" "p" "la" "STEELROD" ""
                 "ARRAY" (entlast) "" "R" nL2b "2" cch
        )
    )
  ))
  (SETQ  nhlnk (fix (+ 0.5 (/ nbl 4.0)))  nvlnk (fix (+ 0.5 (/ nL 4.0)))
         pvhl (mov pt cv cv)      pvbl (mov pt cv cv)
         blnk (- b cv cv)         hlnk (- h cv cv)
  )
  (repeat nhlnk (progn
    (SETQ pt3m (lnk "STEELLNK" "Y" pvhl (- h cv cv) blnk 0.1 1 lap gab))
    (SETQ pvhl (mov pvhl (* hsp 2.0) 0)
          blnk (- blnk hsp hsp hsp hsp)
    )
  ))
  (SETQ skp nil)
  (repeat nvlnk (progn
     (if skp (lnk "STEELLNK" "Y" pvbl hlnk (- b cv cv) 0.1 nil lap gab))
     (SETQ pvbl (mov pvbl 0 (* vsp 2.0))
           hlnk (- hlnk vsp vsp vsp vsp)
           skp  1
     )
  ))
 (SETQ pt3 (mov pvu 0.7 0.5)
        ns (+ nvlnk nhlnk -1)
 )
 (MKLINE "LEADER" "C" pvu (MOV PVU 0 0.5))
 (MKLINE "LEADER" "C" (MOV PVU 0 0.5) pt3)
 (MKLINE "LEADER" "C" pt3M (LIST  (CAR PT3) (CADR PT3M)))
 (MKTXT "text" "Y" pt3 0 "L" 0.2 (strcat " " (itoa nb) "Y" (itoa bdn)))
 (MKTXT "text" "Y" (LIST  (CAR PT3) (CADR PT3M))  0 "L" 0.2 
        (strcat " " (itoa ns) "Y8/20" ))         
 (SETQ P1 (polar PT PI  m1 ) 
       P2 (polar P1 (/ PI 2.0) H) 
       P3 (polar PT (* PI 1.5)  (+ m1 m1)) 
       P4 (polar P3 0 B) 
 )      
 (dot "DIM" "M" P1 (/ PI 2.0)) 
 (dot "DIM" "M" P2 (/ PI 2.0)) 
 (dot "DIM" "M" P3 0) 
 (dot "DIM" "M" P4 0)
 (mkline "DIM" "C" P1 P2) (mkline "DIM" "M" P3 P4)
 (SETQ P1 (mapcar '+ P1 (list -0.2 H2))
       P3 (mapcar '+ P3 (list b2 0.2))
       P4 (mapcar '+ PT (list b2 -1.5))
 )
 (MKTXT "DIM"  "C" p1 (dtr 90) "M" 0.2 (rtos (* 20 h) 2 0))
 (MKTXT "DIM"  "C" p3 0 "M" 0.2 (rtos (* 20 b) 2 0))
 (if bt (progn 
     (MKTXT "text"  "Y" p4 0 "M" 0.2 bt)
     (SETQ  LEFTPT (CDR (ASSOC 10 (ENTGET (ENTLAST))))
             MIDPT (CDR (ASSOC 11 (ENTGET (ENTLAST))))
              XMOV (DISTANCE LEFTPT MIDPT)
     )
     (MKTXT "text"  "Y" (MOV p4 XMOV -0.5) 0 "R" 0.18 "1:20")
 )      )
(LIST  nbl                ;;(car)    No of dowels (bars in 1st,last layer)    
       (CAR pvd)          ;;(cadr)   x-coord of 1st bar (donut)
       bdn                ;;(caddr)  dowel bent = 45ν
       hsp                ;;(nth 3)  hor spacing 
       (car pvu)          ;;(nth 4)  x-coord of top left bar (donut) 
       nb                 ;;(nth 5)  No of bars
       ns                 ;;(nth 6)  No of LINKS
)  
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun qvhdm (lay lyc pos elmlis typ txtscl 
              / typang countr frstpt lastpt txtpos nthlis)

    (setq  countr 0 
           frstpt pos 
           typang (if (= typ "H")
                      0
                      (/ PI 2.0)
                  )
    )
    (maklyr lay lyc nil)
    (dot lay lyc frstpt typang)
    (while (/= countr (length elmlis))
        (setq nthlis (nth countr elmlis) 
              txtpos (if (= typ "H")
                         (mov frstpt (/ nthlis 2.0) 0.3)
                         (mov frstpt -0.3 (/ nthlis 2.0))
                     )
              lastpt (polar frstpt typang nthlis)
        )
        
        (mkline lay lyc frstpt lastpt)
        (dot lay lyc lastpt typang)
        (MKTXT lay lyc txtpos typang "M" 0.2 (rtos (* txtscl nthlis) 2 0))
        
        (setq countr (1+ countr)
              frstpt lastpt
        )
    )
        
)  
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN CG ()
  (SETQ ENT  (ENTSEL "Select RECTANGLE :")
        ENT  (car ENT)
        LIS  (GTVER ENT)
        PT   (NTH 1 LIS)
        P2   (NTH 3 LIS)
  )
        (polar pt (angle pt p2) (/ (distance pt p2) 2.0))
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:FOO (/ IPT ANG B H)
  (sta_rt)
  (setq IPT (CG)
          B (getdist IPT "\nRectangle Base Width: ")
          H (getdist IPT "\nRectangle Height: ")
        IPT (MOV IPT (* -0.5 B) (* -0.5 H))
  )
  (rect IPT 0 H B 1)     
  (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:get () (entget(car(entsel"\nselect entity"))))
(defun c:nget () (entget(car(nentsel"\nselect entity"))))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:saad ()
(alert " SAAD.LSP,   Copyrights (C), 1994,1995\n
   Eng. Saad Abduljaleel Althuweini\n
P.O.BOX 960945 Sport city, Amman, Jordan")
(alert " SN. 96201,  Licensed to Essa Alkhateeb ")
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:loc (/ lay )
   (sta_rt)
   (setq lay (entsel "\nSelect Objet in The Layer to be LOCKED:")
         lay (cdr (assoc 8 (entget (car lay ))))
   )
   (if (= (getvar "clayer") lay)
       (progn (command "layer" "lock" lay "" )
              (princ "WARNING Current Layer LOCKED")
       )
       (progn (command "layer" "lock" lay "" )
              (prompt (strcat "\nLayer " lay " LOCKED"))
   )   )
   (fin_sh)
)
(defun C:unl (/ lay )
   (sta_rt)
   (setq lay (entsel "\nSelect Objet to UNLOCK its layer :")
         lay (cdr (assoc 8 (entget (car lay ))))
   )
   (command "layer" "unlock" lay "" )
   (prompt (strcat "\nLayer " lay " UNLOCKED"))
   (fin_sh)
)
(DEFUN C:UNA () (sta_rt) (COMMAND "LAYER" "UNLOCK" "*" "" ) (fin_sh))

(defun C:lsp ()
 (acad_helpdlg "SAAD.HLP"  "ACAD SAAD.LSP")
 (princ)
)
;=========================================================================
;=========================================================================
(defun C:SS1 () (setq ss1 (ssget)))
(defun C:SS2 () (setq ss2 (ssget)))
(defun C:SS3 () (setq ss3 (ssget)))
(defun c:cc ()(setvar "CMDECHO" 1)(command "DIST" "cen" pause "cen")(princ))

(defun C:ta ()
(sta_rt)
(initget "Horisontal Vertical")
(setq tp (getkword "\nAlign text : Horizontal(---)/Vertical(|) < Ver > : ")
                tp (if (= tp nil) "Vertical" tp))

(prompt "\nSelect text to align : ")
(setq objs  (ssget)
      obj2  (entsel"\nPick text to align with: ")
    Pguide  (cdr (assoc 10 (entget (car obj2))))
       cou  -1
      )
(while (setq enobjs (ssname objs (setq cou (1+ cou))))
  (setq  DBelm  (entget enobjs)
          Pold  (cdr (assoc 10 DBelm))
          Pnew  (if (= tp "Vertical")
                (list (car Pguide) (cadr pold))
                (list (car pold) (cadr Pguide)))
        )
  (command "MOVE" enobjs "" Pold Pnew)
)
(Fin_sh)
);defun

(defun c:wd ()
(sta_rt)
(setq #WDTH#  (G_DIST #WDTH# NIL "Width") )
(command "Pedit" pause "w" #wdth# "")
(fin_sh)
)
;------------------------
(defun c:xwb()
  (SETQ ents (ENTSEL "\nSelect Block :")
        ENT  (car ents)
        nam  (cdr (assoc 0  (ENTGET ENT)))    ;Entity type
        blknam  (if (= nam "INSERT") 
                    (cdr (assoc 2  (ENTGET ENT)))    ;Insert name
                    nil
                )
        
  )
  (if blknam
      (if (setq ff (findfile (strcat (getvar "DWGPREFIX") blknam ".DWG")))
           (princ "\nFile Exist")
           (command "WBLOCK" blknam  blknam)
           
      )
      (princ "\nNot Block")
  )
  (princ )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:zz ()
      
      (SETQ  objs (SSGET)
             objs (SSGET "P" (LIST (CONS 0 "LINE")))
               i 0
            tcou 0
      )
    
    (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "LINE") 
      (setq pt10  (cdr(assoc 10 (entget (ssname objs i))) ) 
            npt10 (list (car pt10) (cadr pt10) 0.0 ) 
            pt11 (cdr(assoc 11 (entget (ssname objs i))) )
            npt11 (list (car pt11) (cadr pt11) 0.0 )
            alst (subst (CONS 10  npt10)
                         (assoc 10 (entget (ssname objs i))) 
                         (entget (ssname objs i))
                 )
            alst (subst (CONS 11  npt11)
                         (assoc 11 (entget (ssname objs i))) 
                         alst
                  )
             tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  

(princ)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:bs (/ i objs obj2 );alst tcou)
 (sta_rt)
 (SETQ objs (SSGET )
       
       obj2  (ATOF(getstrING  "\nNEW Scale:"))
        
          i 0
       tcou 0
 )
 
    (while (< i (sslength objs)) (progn
     (if (cdr (assoc 42 (entget (ssname objs i))))
     (progn
     (setq alst (entget (ssname objs i))
           alst (subst 
                      (CONS 41 OBJ2)     ;NEW
                      (assoc 41  alst)   ;OLD x scale
                      alst                ;ENTITY
                )
           alst (subst 
                      (CONS 42 OBJ2)     ;NEW
                      (assoc 42  alst)   ;OLD y scale
                      alst                ;ENTITY
                )

      )
      (setq tcou (1+ tcou))
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (fin_sh)
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:ho () (command "DIM" "hor" pause pause pause "" "exit" )(princ))
(defun c:ve () (command "DIM" "ver" pause pause pause "" "exit" )(princ))
(defun c:ALI ()(command "DIM" "ali" pause pause pause "" "exit" )(princ))
(defun c:up ( / ssd) (setq ssd (ssget))
               (command "DIM" "upd" ssd "" "e")(princ))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(DEFUN c:rf (/ ENT spt )
(sta_rt)
  (SETQ ent_pt (ENTSEL "Pick point:")
            pt (cadr  ent_pt)
  )
  (command "BREAK" ent_pt pt)
(fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:UL (/ i objs alst tcou prfixt sufixt)
 (sta_rt)
  (SETQ objs (SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
          i 0
       tcou 0
       PRFIXT "%%U"
  )
  
  
     (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
      (setq alst
        (subst (CONS 1 
                     (STRCAT prfixt
                             (cdr(assoc 1 (entget (ssname objs i))))
                             
                     )
               )
               (assoc 1 (entget (ssname objs i))) 
               (entget (ssname objs i))
        )
        tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt (strcat (itoa tcou) " Changed "))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN c:W (/ ENT  nam t X Y a b R LIS L CO LENG TOT);spt
  (sta_rt)
  (SETQ ENT  (ENTSEL "Select Entity :")
        spt  (osnap (cadr  ENT) "nea")
        ENT  (car ENT)
        nam (cdr (assoc 0  (ENTGET ENT)))    ;Entity Name
        lyr (CDR (ASSOC 8 (ENTGET ENT)))     ;Entity Layer
          t (CDR (ASSOC 1 (ENTGET ENT)))     ;Text string
          X (CDR (ASSOC 10 (ENTGET ENT)))    ;1st Point or Center
          Y (CDR (ASSOC 11 (ENTGET ENT)))    ;2nd Point
          a (CDR (ASSOC 50 (ENTGET ENT)))    ;Start Angle of Curve
          b (CDR (ASSOC 51 (ENTGET ENT)))    ;End   Angle of Curve
          R (CDR (ASSOC 40 (ENTGET ENT)))    ;Raduis or text Hight
        col (cdr (assoc 62 (entget ent)))    ;Color
        col (if col (whtclr col) "BYLAYER")
        lty (cdr (assoc 6  (entget ent)))    ;Line Type
        lty (if lty lty "BYLAYER")
     layclr (whtclr(cdr(assoc 62 (tblsearch "LAYER" lyr))))
     laylty (cdr(assoc 6 (tblsearch "LAYER" lyr)))
  )
  (princ (strcat "\nIt's: " nam 
                 " in Layer: " 
                  lyr 
                  " (" 
                  layclr 
                  ", " 
                  laylty 
                 ")  Color: "  
                 col   
                 "  LType: " 
                 lty 
                 
                 "\n"
  )      )
  (PRINC 
  (cond 
   ((= nam "LINE") (strcat " Length: " (rtos(ABS (DISTANCE Y X)))
                           "  Angle: " (rtos(rtd (minang(angle Y X))))
                           " ("  (rtos(- 90 (rtd (minang(angle Y X)))))
                           ")"
   )               )
   ((= nam "ARC") (strcat " Length: " 
                          (rtos(* r (if (> a b) (+ (* 2.0 PI) (- b a)) (- b a))))
                          "    Radius : " (rtos r)
   ))
   ((= nam "CIRCLE") (STRCAT " Perimeter: " (RTOS (* 2.0 PI r))
                             "      Radius: " (RTOS r)
   ))
   ((= nam "TEXT") (STRCAT (ITOA (strlen t)) 
                    " Chars.   Height: " (RTOS r)
                    "   Style: " (cdr (assoc 7 (entget ent)))
   ))
   ((= nam "POLYLINE") (progn 
       (setq 
             lis (gtver ent)
             l   (length lis)
             co 0
             leng 0.0
             tot 0
       )
      (while (< co (- l 1) ) (progn
          (if (betwn  (nth co lis) spt (nth (1+ co) lis) )
            (setq leng (abs (distance (nth co lis) (nth (1+ co) lis) ) ) 
                  sang (angle (nth co lis) (nth (1+ co) lis))
                  
            )  
          )    
      
          (setq tot (+ tot (abs (distance (nth co lis) (nth (1+ co) lis))))
                co (1+ co)
          )
      ))    
      (if (> leng 0) (STRCAT " Segment = " (RTOS leng)  
                             "   Angle = " (RTOS (rtd (minang sang))) 
                             " (" (RTOS (- 90 (rtd (minang sang)))) ")"
                             "   Total Length = " (RTOS tot)
                     )
                     (strcat "   Total Length = " (RTOS tot))
      )
      
   ))
   
   ((= nam "INSERT")  
              (strcat "\nName : " (cdr (assoc 2 (entget ent)))
                    "    Scale  X: " (rtos(cdr (assoc 41 (entget ent))))
                           "  Y: " (rtos(cdr (assoc 42 (entget ent))))
   ))
   ((= nam nam) (princ))
  
  ))
 (fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:GL()
  (STA_RT)
  (prompt "\n \nSelect two lines: ")
  (setq s1 (ssget)
        cnt -1
  )
  (cond
    ((/= 2 (sslength s1))
      (prompt (strcat "\n \n" (itoa (sslength s1)) " entities selected"))
      (prompt "\nTry again for 2 lines")
      (princ)
    )
    (t
      (setq elist1 (entget (ssname s1 0))
            elist2 (entget (ssname s1 1))
      )
      (cond
        ((or
                 (/= (cdr (assoc 0 elist1)) "LINE")
                 (/= (cdr (assoc 0 elist2)) "LINE")
         )
          (prompt (strcat "A " (cdr (assoc 0 elist1)) " and a "
                          (cdr (assoc 0 elist2)) " were selected"))
          (prompt "\nTry again for 2 lines")
          (princ)
        )
        (t
          (setq p1 (cdr (assoc 10 elist1))
                p2 (cdr (assoc 11 elist1))
                p3 (cdr (assoc 10 elist2))
                p4 (cdr (assoc 11 elist2))
                d1 (distance p1 p3)
                d2 (distance p1 p4)
                d3 (distance p2 p3)
                d4 (distance p2 p4)
                dm (max d1 d2 d3 d4)
          )
          (cond
            ((= dm d1)
              (setq p10 p1 p11 p3)
            )
            ((= dm d2)
              (setq p10 p1 p11 p4)
            )
            ((= dm d3)
              (setq p10 p2 p11 p3)
            )
            ((= dm d4)
              (setq p10 p2 p11 p4)
            )
          )
          (cond
            ((= (cdr (assoc 8 elist1)) (cdr (assoc 8 elist2)))
              (setq lyr (cdr (assoc 8 elist1)))
            )
            (t
              (setq lyr (cdr (assoc 8 elist1)))
            )
          )
          (entdel (cdr (assoc -1 elist1)))
          (entdel (cdr (assoc -1 elist2)))
          (mkline lyr nil p10 p11 )
        )
      )
    )
  )
(Fin_sh)
)


;---------------------------------------------------------------------------
(DEFUN c:jl (/ ENT  nam  pt1 pt2 LNG ang1 ang2 p1 p2 spt)
(sta_rt)
  (SETQ ENT  (ENTSEL "Select LINE")
        spt  (cadr  ENT)
        ENT  (car ENT)
  )
  (if ent (progn
   (setq nam (cdr (assoc 0  (ENTGET ENT)))  ;e.g "LINE" 
         pt1 (CDR (ASSOC 10 (ENTGET ENT)))  ;end1 pt.
         pt2 (CDR (ASSOC 11 (ENTGET ENT)))  ;end2 pt. 
         ptm (polar pt1 (angle pt1 pt2) (/(distance pt1 pt2) 2.0)) ;midp
   )
   (if (= nam "LINE") (progn
          
          (setq lng  (* 1 (getdist "\nNew Length :")) ;ATTENTION!!
                d1   (distance spt pt1)
                d2   (distance spt pt2)
                ang1 (angle pt1 pt2)
                ang2 (angle pt2 pt1)
          )
          (cond
           ((equal d1 d2 (/ (distance pt1 pt2) 3.0)) 
                           (setq p1 (polar spt ang1 (/ lng 2.0))
                                 p2 (polar spt ang2  (/ lng 2.0))
                           )
           )
           ((> d1 d2) (setq p1 pt2  
                            p2 (polar pt2 ang2 lng)
                      )
           )
           ((< d1 d2) (setq p1 pt1
                            p2 (polar pt1 ang1 lng)
                      )
           )
         ) 
      (setq alst (subst (CONS 10 P1)
                        (assoc 10 (entget ENT)) 
                        (entget ENT)
                 )
            alst (subst (CONS 11 P2)
                        (assoc 11 (entget ENT)) 
                        alst
                 )
      )
      (entmod alst)
   ))
  ))
(fin_sh)
) 
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:sw (/ i objs obj2 alst tcou)
(sta_rt)
 (SETQ obj1 (car (nentsel " Swap Text\nPick 1st TEXT  :"))
       obj2 (car (nentsel "\nPick 2nd TEXT  :"))
       txt1 (assoc 1 (entget obj1)) 
       txt2 (assoc 1 (entget obj2)) 
 )
 (if (and (= (cdr (assoc 0 (entget obj1))) "TEXT")
          (= (cdr (assoc 0 (entget obj2))) "TEXT")
     )
  (progn
      (entmod (subst txt2  (assoc 1 (entget obj1)) (entget obj1)))
      (entmod (subst txt1  (assoc 1 (entget obj2)) (entget obj2)))
 ))  
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:wr (/ i objs outfile wrline)
(sta_rt)
 (setq outfn (getstring "\nOutput File Name :"))
 (if (findfile outfn) (princ "\nFile already exist...delete it first")
 (progn
    (setq outfile (open outfn "a"))
    (SETQ  objs (SSGET )
           objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
              i 0
    )
    (while (< i  (sslength objs)) 
      (setq wrline (cdr(assoc 1 (entget(ssname objs i))))
                 i (+ i 1)
      )  
      (write-line wrline outfile)
    )  
      
      (close outfile)
 ))
)
;---------------------------------------------------------------------------
(defun C:ARW (); / scl pt pt1 pt2 duz wid)
(STA_RT)
(setq scl  (getvar "DIMSCALE")
      pt   (getpoint "\nStart (Arrow/Bulb) point: ")
      pt1  (osnap pt "end")
      pt2  (osnap pt "mid")
      duz  (* 3.0 scl)
      wid  (* 1.0 scl)
      pt2 (polar pt1 (angle pt1 pt2) duz)
      )
(command "PLINE" pt1 "w" "0.0" wid pt2 "W" "0" "0" "")
(FIN_SH)
)
;===========================================
(defun expm ()
   (setq mm (entlast))
   (setq a1 (subst (cons 41 (abs mirx)) (assoc 41 object) object)) 
   (entmod a1)
   (command "explode" (cdr (assoc -1 a1)))
   (setq a (cdr (assoc 50 a1)))
   (setq pt1 (cdr (assoc 10 a1))) 
   (setq pt2 (polar pt1 (+ (dtr 90) a) 5))
   (princ "\n") (princ "\n")
   (setq ss (ssadd (setq bb (entnext mm) ) ) ) 
   (while (setq aa (entnext bb))
   (ssadd (setq bb aa) ss))
   (command "mirror" ss "" pt1 pt2 "Y")
)

(defun C:XM ()
(sta_rt)
(setq go 1)
(setq prom "\nSelect block, polyline, dim, or mesh: ")
(while (= go 1)
   (setq go (progn
      (setq object (entget (car (entsel prom))))
      (setq prom "\nNot a valid block, polyl, dim, or mesh\nSelect block, polyl, dim, or mesh: ")
      (setq objtyp (cdr (assoc 0 object))) 
      (cond
         ((= "POLYLINE"  objtyp) (command "EXPLODE" (cdr (assoc -1 object)) ))
         ((= "DIMENSION" objtyp) (command "EXPLODE" (cdr (assoc -1 object)) ))
         ((= "INSERT"    objtyp) 
            (progn
               (setq mirx (cdr (assoc 41 object)))
               (setq miry (cdr (assoc 42 object)))
               (cond 
                  ((= miry mirx) (command "EXPLODE" (cdr (assoc -1 object))))
                  ((= (abs mirx) miry) (expm))
                  (t 1)
               )    ; cond
            )       ; progn
         )          ; =
         (t 1)
      )             ; cond
   ))               ; progn
)                   ; while
(fin_sh)
)
;===========================================
;===========================================
(defun c:tar ()
    (command "area" "E" pause)
    (setq inspt (trans (getpoint "\nPosition of Text ? :") 1 0))
    (MKTXT NIL NIL inspt 0 "M" (getvar "textsize") (rtos (getvar "area")))
(princ)
)
;======================================================================
(defun c:cs ()
      
      (SETQ  objs (SSGET )
             objs (SSGET "P" (LIST (CONS 0 "CIRCLE")))
             fctr (getreal "\n Scale Factor : ")
               i 0
            tcou 0
      )
    
    (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "CIRCLE") 
      (setq obj2h (* fctr (cdr(assoc 40 (entget(ssname objs i) ))))
                  
             alst (subst (CONS 40  obj2h)
                         (assoc 40 (entget (ssname objs i))) 
                         (entget (ssname objs i))
                  )
             tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  

(princ)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:get()(PRINC(entget(car(entsel"\nselect entity"))))(TEXTSCR)(PRINC))
(defun c:nget()(entget(car(nentsel"\nselect entity"))))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(DEFUN C:33 () 
      (if (= (getvar "OSMODE") 0) (setvar "OSMODE" 33) (setvar "OSMODE" 0))
)
(DEFUN C:37 () 
      (if (= (getvar "OSMODE") 0) (setvar "OSMODE" 37) (setvar "OSMODE" 0))
)
(DEFUN C:00 () (setvar "OSMODE" 0))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:MDD ( / cc cnt dm llst pt sn st x1 xx yy)
(STA_RT)
  (setq x1 (/ (getvar "viewsize") 20 ) )
 (prompt "select text") (setq cc (ssget (list (cons 0 "text"))) )
  (setq llst (- (sslength cc) 1) )
  (setq cnt -1)
 (while (< cnt llst)
    (setq cnt (1+ cnt))
    (setq en (entget (setq sn (ssname cc cnt) ) ))
  (if (setq pt (assoc 10 en))
    (progn 
     (setq xx (car (cdr pt)) yy (car (cdr (cdr pt))) )
     (grdraw (list (- xx x1) yy) (list (+ xx x1) yy) -1)
     (grdraw (list xx (- yy x1)) (list xx (+ yy x1)) -1)
    ) (setq dm 1)
  )
    (command "ddedit" sn "")
  (if pt 
    (progn
     (grdraw (list (- xx x1) yy) (list (+ xx x1) yy) -1)
     (grdraw (list xx (- yy x1)) (list xx (+ yy x1)) -1)
    )   (setq dm 1)
  )

 ); while
  (setq cc nil)
(FIN_SH)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:i () (command "INSERT" "~" )(princ))
(defun c:55 () (command "zoom" ".5x" )(princ))
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:hi (/ objs) 
 (sta_rt)
 (setq objs (ssget))
 (command "CHANGE" objs "" "P" "LT" "hidden" "")(princ)
 (fin_sh)
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:cen (/ objs) 
 (sta_rt)
 (setq objs (ssget))
 (command "CHANGE" objs "" "P" "LT" "center" "")(princ)
 (fin_sh)
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:DA (/ objs) 
 (sta_rt)
 (setq objs (ssget))
 (command "CHANGE" objs "" "P" "LT" "DASHED" "")(princ)
 (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TC (/ i objs alst tcou uporlw uporlwf)
 (sta_rt)
  
  (SETQ objs (SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
          i 0
       tcou 0
  )
  (initget "Lower Upper")   
  (setq  uporlw (getkword "\nLower/Upper case <U>: ")
         uporlw (if uporlw uporlw "Upper")
        uporlwf (if (= uporlw "Upper") nil 1)
  )
  
  (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
      (setq alst
        (subst (CONS 1 
                     (STRCASE (cdr(assoc 1 (entget (ssname objs i)))) 
                               uporlwf)
               )
               (assoc 1 (entget (ssname objs i))) 
               (entget (ssname objs i))
        )
        tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt (strcat (itoa tcou) " Changed to " uporlw " Case."))
   (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:CAT (/ i obj1 obj2 alst tcou OBJ)
(sta_rt)
(SETQ obj1 (CAR (nentsel "\nPICK FIRST  TEXT LINE : "))
        obj (nentsel "\nPICK SECOND TEXT LINE : ")
       obj2 (car OBJ)
 )
      (setq alst
        (subst (CONS 1 
                 
                 (STRCAT (CDR(assoc 1 (entget obj1)))
                         " "
                         (CDR(assoc 1 (entget obj2)))    ;NEW
                 )
               )
               (assoc 1 (entget obj1))             ;OLD
               (entget obj1)
        )
      )
      (entmod alst)
      (COMMAND "ERASE" OBJ "")
 (fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:uu () 
  (if (= (getvar "LUPREC") 3) 
      (SETVAR "LUPREC" 0)
      (SETVAR "LUPREC" 3)
  )
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun C:MP (/ ss e col lty lay)
(sta_rt)
  (princ "\nSelect entities to Layer/Color/LType-match: ")
  (setq ss (ssget))
  (if ss (progn
           (setq e (car (entsel "Pick an entity to be matched: ")))
           (if e (progn
                   (setq e (entget e))
                   (setq lay (cdr (assoc 8 e)))
                   (setq col (cdr (assoc 62 e)))
                   (setq lty (cdr (assoc 6 e)))
                   (command "CHANGE" ss "" "PROP" "LA" lay "")
                   (if col nil (setq col "BYLAYER"))
                   (if lty nil (setq lty "BYLAYER"))
                   (command "CHANGE" ss "" "PROP" "C" col "")
                   (command "CHANGE" ss "" "PROP" "LT" lty "")
                 );END PROGN
           );END IF
         );END PROGN
  );END IF
(fin_sh)
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun minang (parang)
  (setq parang (abs parang))
  (while (> parang (/ pi 2.0))
         (setq parang (- parang (/ pi 2.0)))
  )
  parang
)
;ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ
(defun c:TP (/ i objs alst tcou prfixt sufixt)
 (sta_rt)
  (SETQ objs (SSGET )
       objs (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
          i 0
       tcou 0
  )
  
  (setq prfixt  (getstring T "\n Prefix text :")
        sufixt  (getstring T "\n Suffix text :")
        prfixt  (if prfixt prfixt "")
        sufixt  (if sufixt sufixt "")
  )
 
     (while (< i (sslength objs)) (progn
     (if (= (cdr (assoc 0 (entget (ssname objs i)))) "TEXT") 
      (setq alst
        (subst (CONS 1 
                     (STRCAT prfixt
                             (cdr(assoc 1 (entget (ssname objs i))))
                             sufixt
                     )
               )
               (assoc 1 (entget (ssname objs i))) 
               (entget (ssname objs i))
        )
        tcou (1+ tcou)
     ))
      (setq i (+ i 1))
      (entmod alst)
    ))  
   (princ "\n\n\n")
   (prompt (strcat (itoa tcou) " Changed "))
   (fin_sh)
)
(defun c:sst( / objs)
      (SETQ  objs (SSGET )
             ss (if objs (SSGET "P" (LIST (CONS 0 "TEXT"))) nil)
      )
)
(defun c:nn ()(setvar "CMDECHO" 1)(command "DIST" "nea" pause "per")(princ))
(defun c:cc ()(setvar "CMDECHO" 1)(command "DIST" "cen" pause "cen")(princ))
