;;;*****************************************
;;;   Superior Designs - Custom programming available
;;;   http://www.surfersnet.com/sdi/acad.htm
;;;   e-mail superior@surfersnet.com
;;;*****************************************



(grtext -1 "GOOD MORNING")
(GRTEXT -1 "AND MAY THE FORCE BE WITH YOU")
(SETQ MYNAME "CDC")


(SETQ TEXTL "DIM") ;;;; LAYER FOR TEXT ENTITIES
(SETQ DIML "DIM") ;;;;; LAYER FOR DIM ENTITIES
(SETQ DIMUNIT (GETVAR "LUNITS")) ;;;;; SET DIMENSION UNITS
(SETQ DIMPREC (GETVAR "LUPREC")) ;;;;; SET DIMENSION PRECISION

(DEFUN C:EXIT()(COMMAND "UCS" "")(COMMAND "GRID" "OFF")(COMMAND "LAYER" "S" "0" "")(command "fill" "on")
(COMMAND "ZOOM" "A")(SETVAR "LUPREC" 4)(SETVAR "OSMODE" 0)(COMMAND "SAVE" "") )

 ; (command "undefine" "layer")


;(DEFUN C:layer()(COMMAND "-layer" "") )
            

        
(SETQ MYVER "3.25")
(DEFUN C:MYVER ()(SETVAR "CMDECHO" 0)(COMMAND "TEXTSCR")
(PRINC (STRCAT "\n VERSION: " MYVER))
(PRINC "\n ")
(PRINC "\n INSTALLED COMMANDS: ")
(PRINC "\n                                  ---  F0      -fillet radius 0 ")
(PRINC "\n LS   -set or create layer        ---  LAY     -toggle layers  ")
(PRINC "\n MO   -match object               ---  MT      -match text ")
(PRINC "\n STR  -stretch crossing           ---  ANGMODE -switch axes")
(PRINC "\n ITEM -leader with balloons       ---  LE      -line w/text")
(PRINC "\n MID2 -midpoint of 2 lines        ---  INT2    -intersection of 2 lines")
(PRINC "\n H    -horizontal dimensions      ---  V       -vertical dimensions ")
(PRINC "\n HD   -break lines & change layer ---  CM      -copy/move ")
(PRINC "\n SQ   -square                     ---  CT      -copy/change text ")
(PRINC "\n ")
(PRINC "\n ")
(PRINC) )

;;;;***************
(defun c:sq()
           (setq SQerr *error*) 
           (Defun *error* (msg)(setq *error* SQerr)(command "ucs" "w")(COMMAND "UCS" "O" OLDORG)(setvar "cmdecho" 1)(princ))
           (SETVAR "CMDECHO" 0)
           (IF (= SQTXT nil)(SETQ SQTXT "Pline"))
           (INITGET 1 "P L")
            (WHILE (/= 
           (TYPE (setq SQPT1(getpoint (STRCAT "Line/Pline/<" SQTXT "><pick 1st corner> "))) ) 'LIST)
           (IF (= (STRCASE SQPT1) "P")(PROGN(SETQ SQTXT "Pline")(INITGET 1 "P L"))) 
           (IF (= (STRCASE SQPT1) "L")(PROGN(SETQ SQTXT "Line") (INITGET 1 "P L"))) )

           (SETQ OLDORG(GETVAR "UCSORG"))

           (if (or (/= (car (getvar "ucsxdir")) 1.0) (/= (cadr (getvar "ucsydir")) 1.0))
           (setq SQPT2(getCORNER SQPT1 "\npick 2nd corner: "))

           (progn
           (SETVAR "LASTPOINT" SQPT1)
           (COMMAND "UCS" "O" SQPT1)
           (setq SQPT2(getCORNER '(0 0) "\npick 2nd corner: "))
           (setq SQPT2(list(+(car SQPT2)(car SQPT1))(+(cadr SQPT2)(cadr SQPT1))))
           (COMMAND "UCS" "W")(COMMAND "UCS" "O" OLDORG)
           )      )  ;end prog end if

           (COMMAND SQTXT SQPT1 (LIST (CAR SQPT2) (CADR SQPT1)) SQPT2 (LIST (CAR SQPT1)(CADR SQPT2)) "C") 

           (setq *error* SQerr)
           (SETVAR "CMDECHO" 1)(PRIN1))
;;;;;;;;********************
;;;;;;;;********************

(defun c:bp()(command "break" pause "f" "cen,end,int" pause "@"))

(defun c:da ()(setq clyr(getvar "CLAYER"))(setvar "cmdecho" 0)
(command "layer" "s" dimL "")
(setvar "cmdecho" 1)(command "dim1" "ang" PAUSE PAUSE PAUSE "" PAUSE)
(setvar "cmdecho" 0)(command "layer" "s" clyr "")
(setvar "cmdecho" 1)(princ))

;;;*****************************
(DEFUN C:DL()(COMMAND "LAYER" "S" DIML "")(COMMAND "DIM" "L" PAUSE PAUSE PAUSE PAUSE "EXIT")
(COMMAND "LAYER" "S" "0")
)
;;**************

(defun c:f0()(command "fillet" "r" "0" "fillet"))

;;;;;;;;;;;;************

(defun c:ls () (setvar "cmdecho" 0)(setq rnlr 1 ls:err *error*)
(defun *error* () (msg)(setq *error* ls:err)(setvar "cmdecho" 1))
(IF (= (SETQ lslyr(GETSTRING "\nPress RETURN to select entity <Layer Name> ")) "")
(PROGN(while rnlr(setq layrset (entsel "\nSelect enity on target layer: "))
(if (/= layrset nil) (setq rnlr nil)(princ"\nNo enity found")))
(setq lslyr (cdr(assoc 8(entget(car layrset))))) ) ;END PROGN 

  (IF (= (TBLSEARCH "LAYER" lslyr) nil)(PROGN (PRINC (STRCAT "LAYER '" lslyr "' DOESN'T EXIST"))
         (INITGET 1 "C S")(SETQ LSASK(GETKWORD (STRCAT "\n(C)reate new layer<" lslyr ">/(S)earch for existing layer: ")))
         (IF (= LSASK "C")(PROGN (IF (= (SETQ lslyrCLR(GETSTRING (STRCAT "\nCOLOR OF LAYER " lslyr " <white>: "))) "")(SETQ lslyrCLR "WHITE"))
                           (IF (= (SETQ lslyrLTP(GETSTRING (STRCAT "\nLINETYPE FOR LAYER " lslyr " <continuous>: "))) "")(SETQ lslyrLTP "CONTINUOUS"))
                                 (COMMAND "LAYER" "N" lslyr "C" lslyrCLR lslyr "LT" lslyrLTP lslyr "") ) ;; END "c"
                          (PROGN (COMMAND "LAYER" "?" "" "")
                                 (SETQ lslyr(GETSTRING "\n CHOOSE EXISTING LAYER NAME: ")) ) ) ;; END "s" END IF LSASK
           ))) ;; END PROGN END IF TBLSEARCH ;END IF lslyr
(command "layer" "s" lslyr "")(terpri)(setq *error* ls:err)(setvar "cmdecho" 1)(princ))

;;;;**************

(defun c:mo ()(setvar "cmdecho" 0)(setq mo:err *error* nd 1)
(defun *error* ()(msg)(setq *error* mo:err)(setvar "cmdecho" 1))
(setq mNEW(ssget))(if(/= mNEW nil)(while nd(setq m1
(entsel "\nSelect entity to match: "))(if (/= m1 nil) (progn
(setq nd nil m1 (entget(car m1)) l2 (cdr(assoc 8 m1))
lt2 (cdr(assoc 6 m1)) c2 (cdr(assoc 62 m1)))(if (= c2 nil)
(setq c2 "bylayer"))(if (= lt2 nil)(setq lt2 "bylayer"))          
(command "chprop" mNEW "" "c" c2 "la" l2 "lt" lt2 ""))
(princ "\nNo entity found")))(Princ "\nNothing selected"))
(setvar "cmdecho" 1)(princ))          
;;;;*************

;;;;**********
(defun c:mt()(setq rn 1 tserr *error*)
(defun *error* (msg) (setq *error* tserr)(setvar "cmdecho" 1)(princ))
(setvar "cmdecho" 0)(setq a(ssget))(if (/= a nil) (progn
(setq al (sslength a) newa (ssadd)) (while(> al 0)(setq tmp (ssname a (setq al
(1- al)))) (if (=(cdr(assoc 0 (entget tmp))) "TEXT") (ssadd tmp newa)))(setq a newa)
(while rn(setq t1(entget(car(entsel "\nSelect text style to match: "))))
(if(= "TEXT" (cdr(assoc 0 t1)))(progn(setq rn nil ts (cdr(assoc 7 t1))
th (cdr(assoc 40 t1)) n (sslength a) index 0)
(repeat n(setq bl(entget(ssname a index)) index (1+ index) c (assoc 7 bl)
d (assoc 40 bl) e (cons (car c) ts)  f (cons (car d) th)
b2 (subst f d bl))(setq b2 (subst e c b2))(entmod b2)))(princ "\nInvalid selection"))))
(princ "\nNothing selected"))(setq *error* tserr)(setvar "cmdecho" 1)(princ))

;;;;********
;(defun c:str(); (SETVAR "CMDECHO" 0)
;(SETQ STRERR *error*)
;(DEFUN *error* (MSG)(SETQ *error* strerr) (SETVAR "CMDECHO" 1)
;(SETVAR "LUNITS" OUNITS)(SETVAR "LUPREC" OLUPREC) (PRINC))
;(SETQ OUNITS (GETVAR "LUNITS"))(SETQ OLUPREC (GETVAR "LUPREC"))
;(SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC)
;(command "stretch" "c" pause PAUSE "" PAUSE PAUSE)
;(SETVAR "LUNITS" OUNITS)(SETVAR "LUPREC" OLUPREC)(SETVAR "CMDECHO" 1) 
;(SETQ *error* strerr)(PRINC)  )
;;;**************************************


;;;;********
(defun c:str() (SETVAR "CMDECHO" 0)(SETVAR "DIMCLRT" 0)
(SETQ STRERR *error*)
(DEFUN *error* (MSG)(SETQ *error* strerr) (SETVAR "CMDECHO" 1)
(SETVAR "LUNITS" OUNITS)(SETVAR "LUPREC" OLUPREC) (PRINC))
(SETQ OUNITS (GETVAR "LUNITS"))(SETQ OLUPREC (GETVAR "LUPREC"))
(SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC)
(command "stretch" "c" pause PAUSE "" PAUSE PAUSE)

   (setq ssdim(ssget "p")) (SETQ I 0)
   (WHILE (< I (SSLENGTH SSDIM))
          (IF (and (= (CDR (ASSOC 0 (ENTGET(SSNAME SSDIM I)) )) "DIMENSION")
                   (= (CDR (ASSOC 3 (ENTGET(SSNAME SSDIM I)) )) "*UNNAMED")
              );end and
          (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" "GREEN" "" )
          ); END IF
          (SETQ I(1+ I)) ) ; END WHILE

(SETVAR "LUNITS" OUNITS)(SETVAR "LUPREC" OLUPREC)(SETVAR "CMDECHO" 1) 
(SETQ *error* strerr)(PRINC)  )
;;;**************************************

;;;*****************************************
(defun c:angmode ()(setq angerr *error* rr 1)
(defun *error* (msg)(setq *error* angerr)(command "ucs" "w")(setvar "ucsicon" 0)(setvar "cmdecho" 1)(princ))
(setvar "cmdecho" 0)(setvar "ucsicon" 1)(command "ucs" "w")
(initget 1 "S")(setq et(getreal "\nSelect a line/<Type in an angle>: "))
(if et(cond ((= (type et) 'REAL) 
(if(and(/= et 90.0) (/= et 180.0)(/= et 270.0) (/= et -90.0) (/= et -180) (/= et -270))
(progn(setq et (* pi (/ et 180.0)))(if(< et -1.55334)(setq et(+ et 3.14159)))
(if(and(> et 1.57079) (< et 3.14159))(setq et(- et 1.57079)))
(if(and(> et 3.14159) (< et 4.71238))(setq et(+ et 3.14159)))
(setq xpt(polar '(0 0) et 100.2))(command "ucs" "3" "" xpt ""))
(progn(princ et)(princ " degrees is invalid")(terpri))))
((and (= (type et) 'STR) (= (strcase et) "S"))(while rr(setq et(entsel "\nPick a line: "))
(if(/= et nil) (if(= (cdr(assoc 0 (setq ett(entget (car et))))) "LINE")
(progn(setq rr nil)(setq et (angle (cdr(assoc 10 ett)) (cdr(assoc 11 ett))))
(if(< et -1.55334)(setq et(+ et 3.14159)))(if(and(> et 1.57079) (< et 3.14159))
(setq et(- et 1.57079)))(if(and(> et 3.14159) (< et 4.71238))(setq et(+ et 3.14159)))
(setq ett(* 180.0 (/ et pi)))
(if(or(equal ett 0.00 0.01) (equal ett 90.0 0.01) (equal ett 360.0 0.01) (equal ett 270.0 0.01) (equal ett 180.0 0.01))
(setq et 0.0))(setq xpt(polar '(0 0) et 100.0))(command "ucs" "3" "" xpt ""))
(princ "\nEntity is not a LINE"))(princ "\nNo line found"))))))(setvar "ucsicon" 1)
(setvar "orthomode" 1)(setvar "cmdecho" 1)(setq *error* angerr)(princ))

(defun c:qe()(command "erase" "si" "au" pause))

;;;;;*************
(DEFUN MID2() (SETQ INTERR *ERROR*)
(DEFUN *ERROR* (MSG) (SETVAR "CMDECHO" 1) (PRINC))
(SETQ A(ENTGET(CAR(ENTSEL "\n PICK 1st LINE"))))
(SETQ B(CDR(ASSOC 10 A)))
(SETQ C(CDR(ASSOC 11 A)))
(SETQ D(ENTGET(CAR(ENTSEL "\n PICK 2nd LINE\n"))))
(SETQ E(CDR(ASSOC 10 D)))
(SETQ F(CDR(ASSOC 11 D)))
(SETQ X(/ (+ (/ (+ (CAR B) (CAR C)) 2) (/ (+ (CAR E) (CAR F)) 2)) 2))
(SETQ Y(/ (+ (/ (+ (CADR B) (CADR C)) 2) (/ (+ (CADR E) (CADR F)) 2)) 2))
(SETQ PT(LIST X Y))
(SETQ *ERROR* INTERR) (PRINC PT))
;;;;;*************

;;;;;*************
(DEFUN INT2 () (SETQ INTERR *ERROR* R 1 RR 1 A NIL D NIL)
(DEFUN *ERROR* (MSG) (PRINC))
(while r(SETQ A(ENTSEL "\nPick 1st line: "))
(if (/= a nil)
    (progn
         (SETQ A(ENTGET(CAR A)))
         (SETQ B(CDR(ASSOC 10 A)))
         (SETQ C(CDR(ASSOC 11 A)))
         (setq r nil)
    )
)
)
(while rr(SETQ D(ENTSEL "\nPick 2nd line: "))
(if (/= d nil)
    (progn
          (SETQ D(ENTGET(CAR D)))
          (SETQ E(CDR(ASSOC 10 D)))
          (SETQ F(CDR(ASSOC 11 D)))
          (setq rr nil)
    )
)
)
(SETQ B1(- (CADR B) (* (SETQ M1(/ (SIN(ANGLE C B)) (COS(ANGLE C B)))) (CAR B))))
(SETQ B2(- (CADR E) (* (SETQ M2(/ (SIN(ANGLE E F)) (COS(ANGLE E F)))) (CAR E))))
(IF(NOT(EQUAL M1 M2 0.00005))
   (PROGN
        (SETQ X(/ (- B2 B1) (- M1 M2)))
        (IF (= (CAR B) (CAR C)) (SETQ Y(+ (* M2 X) B2)) (SETQ Y(+ (* M1 X) B1)))
        (IF (= (CAR E) (CAR F)) (SETQ Y(+ (* M1 X) B1)) (SETQ Y(+ (* M2 X) B2)))
        (SETQ PT (LIST X Y))
   )
   (SETQ PT "PARALLEL-LINES")
) 
(IF (AND (= (CAR B) (CAR C)) (= (CAR E) (CAR F)))(SETQ PT "PARALLEL-LINES"))
(SETQ *ERROR* INTERR)
(PRIN1 PT))
;;;;;******************

;;;;;******************
;Hd.lsp will break and create hidden line between solid lines

(defun c:HD (/ p1 p2 p3)
  (setq olderr *error*)
  (setvar "cmdecho" 0)
(DEFUN *error* (MSG) (SETVAR "OSMODE" 0)(SETQ *error* OLDERR)
               (SETVAR "CMDECHO" 1)(PRIN1))



(setq rnlr 1)
  (IF (= HDLAYER nil)(PROGN (SETQ HDLAYER "HID")
                     (IF (= (TBLSEARCH "LAYER" HDLAYER) nil)
                     (PROGN (PRINC (STRCAT "\nLAYER '" HDLAYER "' DOESN'T EXIST, DEFAULTING TO LAYER '0' \n "))
                            (SETQ HDLAYER "0")  ))                  
                     ))

  (IF (= HDBREAK nil)(SETQ HDBREAK "2"))

           (setvar "osmode" 512)          
           (INITGET 1 "1 2 L")
           (WHILE (/= 
           (TYPE (setq P1(getpoint (STRCAT "1/2/Layer/<" HDBREAK " pt break/Layer-" HDLAYER "> <select line to break> "))) ) 'LIST)
           (IF (= (STRCASE P1) "1")(PROGN(SETQ HDBREAK "1")(INITGET 1 "1 2 L"))) 
           (IF (= (STRCASE P1) "2")(PROGN(SETQ HDBREAK "2")(INITGET 1 "1 2 L"))) 
           (IF (= (STRCASE P1) "L")(PROGN
 
                                    ;;;***** LAYER CONTROL
           (IF (= (SETQ HDLAYER(GETSTRING "\nPress RETURN to select entity <Layer Name> ")) "")
           (PROGN(while rnlr(setq layrset (entsel "\nSelect enity on target layer: "))
           (if (/= layrset nil) (setq rnlr nil)(princ"\nNo enity found")))
           (setq HDLAYER (cdr(assoc 8(entget(car layrset)))))(INITGET 1 "1 2 L") ) ;END PROGN 

           (IF (and (= (TBLSEARCH "LAYER" HDLAYER) nil)(/= hdlayer "ERASE"))
               (PROGN (PRINC (STRCAT "LAYER '" HDLAYER "' DOESN'T EXIST"))
               (INITGET 1 "C S")(SETQ LSASK(GETKWORD (STRCAT "\n(C)reate new layer<" HDLAYER ">/(S)earch for existing layer: ")))
                   (IF (= LSASK "C")(PROGN (IF (= (SETQ hlyrCLR(GETSTRING (STRCAT "\nCOLOR OF LAYER " HDLAYER " <white>: "))) "")(SETQ hlyrCLR "WHITE"))
                   (IF (= (SETQ hlyrLTP(GETSTRING (STRCAT "\nLINETYPE FOR LAYER " HDLAYER " <continuous>: "))) "")(SETQ hlyrLTP "CONTINUOUS"))
                          (COMMAND "LAYER" "N" HDLAYER "C" hlyrCLR HDLAYER "LT" hlyrLTP HDLAYER "") ) ;; END "c"
                          (PROGN (COMMAND "LAYER" "?" "" "")
                          (SETQ HDLAYER(GETSTRING "\n CHOOSE EXISTING LAYER NAME: ")) ) ) ;; END "s" END IF LSASK
                          (INITGET 1 "1 2 L")
           ) (INITGET 1 "1 2 L") )) ;; END PROGN END IF TBLSEARCH ;END IF HDLAYER
           ;;;;;;****** END LAYER CONTROL

) )  )   ;;;; END PROGN IF "L" END WHILE

  (setvar "osmode" 32)

  (IF (= HDBREAK "2")(PROGN
                   (setq p2 (getpoint "\nSelect 1st intersection: ")
                         p3 (getpoint "\nSelect 2nd intersection: "))
                   (command "break" p1 "F" p2 p2
                            "break" p1 "F" p3 p3) )) ;;END PROGN "2" END IF

  (IF (= HDBREAK "1")(PROGN
                   (SETQ P2 (GETPOINT "\nSelect 1st intersection: "))
                   (COMMAND "BREAK" p1 "F" P2 P2) )) ;; END PROGN "1" END IF

(IF (= HDLAYER "ERASE")(COMMAND "ERASE" p1 "")
 (COMMAND "change" p1 "" "p" "LA" HDLAYER "LT" "BYLAYER" "c" "BYLAYER" "") )

  (setvar "osmode" 0)
  (setq *error* olderr)
  (prin1) )    ;;;; END OF HD FUNCTION
;;;;***************


;;;;;;;*********************
(DEFUN C:CM()(SETVAR "CMDECHO" 0) (setq CMerr *error*) 
           (Defun *error* (msg)(setq *error* CMerr)(SETQ CM nil)(setvar "cmdecho" 1)(princ))
                (SETQ CMVER "1.11")
                (IF (= CM nil)(PROGN(PRINC "\n PICK OBJECTS TO MOVE/COPY or <RETURN-previous> ")(SETQ CMOBJ(SSGET))
                      (IF (= CMOBJ nil)(SETQ CMOBJ CMOBJOLD)(SETQ CMOBJOLD CMOBJ))
                      (SETQ CMPT1(GETPOINT "\n PICK BASE POINT or <RETURN-previous> "))
                      (IF (= CMPT1 nil)(SETQ CMPT1 CMPT1OLD)(SETQ CMPT1OLD CMPT1))
                      (IF (OR (= CMOBJ nil)(= CMPT1 nil))(PROGN (PRINC "\nNULL SELECTION SET OR NULL POINT")
                      (PRINC "\nOBJECTS and/or BASE POINTS MUST HAVE BEEN SELECTED PRIOR TO USING 'previous' ")
                      (^C) )) ;; END PROGN END IF
                      (SETQ CM 1) ) ;;END PROGN
                      (PROGN(IF (= CMTEXT nil)(SETQ CMTEXT "COPY"))(INITGET 1 "C M O RC V")
                      (WHILE (/= (TYPE (setq CMPT2(getpoint CMPT1 (STRCAT "Copy/Move/Other/RC/<" CMTEXT " TO POINT> "))) ) 'LIST)
                      (IF (= CMPT2 "C")(PROGN(SETQ CMTEXT "COPY")(INITGET 1 "C M O RC V"))) 
                      (IF (= CMPT2 "RC")(PROGN(SETQ CMTEXT "RC") (INITGET 1 "C M O RC V"))) 
                      (IF (= CMPT2 "O")(PROGN(SETQ CMTEXT (GETSTRING "NEW COMMAND: "))(INITGET 1 "C M O RC V"))) 
                      (IF (= CMPT2 "M")(PROGN(SETQ CMTEXT "MOVE")(INITGET 1 "C M O RC V")))
                      (IF (= CMPT2 "V")(PROGN(PRINC (STRCAT "\nCM VERSION: " CMVER))(SETQ CM nil)(^C)))  ) ;; END OF WHILE
                      (SETQ CM nil)
                      (IF (= CMTEXT "RC")(PROGN(COMMAND "COPY" CMOBJ "" "0,0" "")
                      (GRTEXT -1 (STRCAT "COPIED " (ITOA(SSLENGTH CMOBJ)) " NOW ROTATING"))
                      (COMMAND "ROTATE" CMOBJ "" CMPT1 CMPT2) ); END PROGN RC
                      (COMMAND CMTEXT CMOBJ "" CMPT1 CMPT2) ) ;END IF RC

                      )) ;; END PROGN END IF
                      (setq *error* SQerr)(SETVAR "CMDECHO" 1)(PRIN1)) ;;; END OF FUNCTION

;;;;;****************
;;;;;****************V1.0
(defun c:LAY () (setvar "cmdecho" 0)(setq rnlr 1 ls:err *error*)
(defun *error* () (msg)(setq *error* ls:err)(setq lay "0")(setvar "cmdecho" 1))
(IF (= CMDASKOLD nil)(SETQ CMDASKOLD "SET")) (IF (= lay nil)(SETQ lay "0"))

 (INITGET "S F T O N L A *")
  (IF (= (SETQ cmdASK (GETKWORD (STRCAT "\nSet/Freeze/Off/Thaw/oN/Layer/All but/* on <" CMDASKOLD "> Layer:<" lay "> ")) )  nil)
         (SETQ CMDASK CMDASKOLD)(progn (if (= (STRCASE cmdask) "L")

         (PROGN (setq CMDASK CMDASKOLD) ;; PROG L
         (IF (= (SETQ lay(strcase(GETSTRING "\nPress RETURN to select entity <Layer Name> "))) "")
         (PROGN(while rnlr(setq layrset (entsel "\nSelect enity on target layer: "))
         (if (/= layrset nil) (setq rnlr nil)(princ"\nNo enity found")))
         (setq lay (cdr(assoc 8(entget(car layrset))))) ) ;END PROGN 

             (IF (= (TBLSEARCH "LAYER" lay) nil)(PROGN (PRINC (STRCAT "LAYER '" lay "' DOESN'T EXIST"))
             (INITGET 1 "C S")(SETQ LSASK(GETKWORD (STRCAT "\n(C)reate new layer<" lay ">/(S)earch for existing layer: ")))
             (IF (= LSASK "C")(PROGN (IF (= (SETQ layCLR(GETSTRING (STRCAT "\nCOLOR OF LAYER " lay " <white>: "))) "")(SETQ layCLR "WHITE"))
                           (IF (= (SETQ layLTP(GETSTRING (STRCAT "\nLINETYPE FOR LAYER " lay " <continuous>: "))) "")(SETQ layLTP "CONTINUOUS"))
                                 (COMMAND "LAYER" "N" lay "C" layCLR lay "LT" layLTP lay "") ) ;; END "c"
                          (PROGN (COMMAND "LAYER" "?" "" "")
                                 (SETQ lay(strcase(GETSTRING "\n CHOOSE EXISTING LAYER NAME: "))) ) ) ;; END "s" END IF LSASK
             ))) ;; END PROGN END IF TBLSEARCH ;END IF lay

         (INITGET "S F T O N A *")
         (if (= (SETQ cmdASK (GETKWORD (STRCAT "\nSet/Freeze/Off/Thaw/oN/All but/* on <" CMDASKOLD "> Layer:<" lay "> ")) )  nil)
                (setq cmdask cmdaskold))        

          ) ; END PROGN L

         (SETQ CMDASKOLD CMDASK) )) ) ;; end if END PROG END MAIN IF

    (IF (AND (= (GETVAR "CLAYER") lay)(= CMDASK "F"))  ;; CHECK FOR FREEZING CURRENT LAYER ***
             (PROGN (PRINC (STRCAT "\n Can't FREEZE 'CURRENT' Layer:<" lay "> "))
                (PRINC "\n Pick a new 'CURRENT' Layer ")
                (IF (= (SETQ layTMP(GETSTRING "\nPress RETURN to select entity <Layer Name> ")) "")
                (PROGN(while rnlr(setq layrset (entsel "\nSelect enity on target layer: "))
                      (if (/= layrset nil) (setq rnlr nil)(princ"\nNo enity found")))
                      (setq layTMP (cdr(assoc 8(entget(car layrset))))) ) ;END PROGN 
                (IF (= (TBLSEARCH "LAYER" layTMP) nil)(PROGN (PRINC (STRCAT "LAYER '" layTMP "' DOESN'T EXIST"))
                    (INITGET 1 "C S")(SETQ LSASK(GETKWORD (STRCAT "\n(C)reate new layer<" layTMP ">/(S)earch for existing layer: ")))
                    (IF (= LSASK "C")(PROGN (IF (= (SETQ layCLR(GETSTRING (STRCAT "\nCOLOR OF LAYER " layTMP " <white>: "))) "")(SETQ layCLR "WHITE"))
                           (IF (= (SETQ layLTP(GETSTRING (STRCAT "\nLINETYPE FOR LAYER " layTMP " <continuous>: "))) "")(SETQ layLTP "CONTINUOUS"))
                                 (COMMAND "LAYER" "N" layTMP "C" layCLR layTMP "LT" layLTP layTMP "") ) ;; END "c"
                           (PROGN (COMMAND "LAYER" "?" "" "")
                                 (SETQ layTMP(GETSTRING "\n CHOOSE EXISTING LAYER NAME: "))  ) ) ;; END "s" PROG END IF LSASK
                 ))) ;; END PROGN END IF TBLSEARCH ;END IF layTMP
      (COMMAND "LAYER" "S" layTMP "")
      )) ;; END PROG END FREEZE IF  **********      

(IF (= (STRCASE CMDASK) "O")(SETQ CMDASK "Off" ))(IF (= CMDASK "N")(SETQ CMDASK "oN")) 
(IF (= CMDASK "Off")(SETQ CMDASKOLD "oN"))(IF (= CMDASK "oN")(SETQ CMDASKOLD "Off"))

(IF (= CMDASK "*")(PROGN (SETQ lay "*")(SETQ CMDASK "oN")))

(IF (= CMDASK "A")(COMMAND "LAYER" "OFF" "*" "Y" "ON" lay "")
(PROGN
(IF (AND (= (GETVAR "CLAYER") lay)(= CMDASK "Off"))(command "layer" cmdask lay "Y" "")
(command "layer" cmdask lay "")) ))
(terpri)(setq *error* ls:err)(setvar "cmdecho" 1)(princ))


;;;;;;**************************

;;;;;;**********************
(DEFUN C:CT()(SETVAR "CMDECHO" 0)
(SETQ CPT1 (CADR (setq t1 (entsel "Select Text")) ))       
(PRINC "\nCopy To Point ")
(COMMAND "COPY" t1 "" CPT1 pause)
(command "change" "l" "" "" "" "" "" "")
(SETVAR "CMDECHO" 1)
(PRIN1))
;;;;;;**********************
;;;**************************************

(defun c:item () (setq iterr *error* ad 1 radi ( * 0.25 (getvar "dimscale")) clyr (getvar "clayer"))
(setvar "cmdecho" 0)(defun *error* (msg) (command "layer" "s" clyr "")
(setq *error* iterr)(setvar "cmdecho" 1)(princ))
(IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER"))
(command "layer" "s" dimL "")(initget 1 "A")(setq ldr1 (getpoint "\nAdd/<From point>: "))
(if (= (type ldr1) 'LIST)(progn(initget 1)(setq ldr2 (getpoint ldr1 "\nTo point: "))
(grdraw ldr1 ldr2 -1)(setq ldr3 (getpoint ldr2 "\nTo point: "))(if (= ldr3 nil)
(progn(setq ang(angle ldr1 ldr2) dist(-(distance ldr1 ldr2) radi))
(command "dim1" "lea" ldr1 (polar ldr1 ang dist) ^c)(setq ldr3 ldr2))
(progn(setq ang(angle ldr2 ldr3) dist(-(distance ldr2 ldr3) radi))
(command "dim1" "lea" ldr1 ldr2 (polar ldr2 ang dist) ^c)))
(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "")
(command "layer" "s" TEXTL "")
(initget 1)(setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE") (GETVAR "DIMTXT") ) 0 c)))
(if (= (strcase ldr1) "A")(progn(setq ldr3(cdr(assoc 10(entget(car(entsel "\npick existing balloon: "))))))
(setq dir(getangle ldr3 "\nDirection for balloon: "))
(if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi)))))
(if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3))))
(if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi)))))
(if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3))))
(command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "")
(command "layer" "s" TEXTL "")
(setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) 0 c)))
(while ad(setq ad "")   ;;;;(getstring "\nAdd adjacent balloon:<Y> ")   )
(if (OR (= AD "") (= (strcase ad) "Y"))  (progn(setq dir(getangle ldr3 "\nDirection for balloon: "))
(if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi)))))
(if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3))))
(if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi)))))
(if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3))))
(command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "")
(setq c(getstring t "\nEnter item #: "))
(command "layer" "s" TEXTL "")(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) "0" c)) (setq ad nil)))
(command "layer" "s" clyr "")(setq *error* iterr)(setvar "cmdecho" 1) (princ))
;;;*****************************************
(defun c:LE () (setq iterr *error* ad 1 radi ( * 0.1875 (getvar "dimscale")) clyr (getvar "clayer"))
(setvar "cmdecho" 0)(defun *error* (msg) (command "layer" "s" clyr "")
(setq *error* iterr)(setvar "cmdecho" 1)(princ))
(command "layer" "s" dimL "")(initget 1 "A")(setq ldr1 (getpoint "\nAdd/<From point>: "))
(if (= (type ldr1) 'LIST)(progn(initget 1)(setq ldr2 (getpoint ldr1 "\nTo point: "))
;(grdraw ldr1 ldr2 -1)
(setq ldr3 (getpoint ldr2 "\nTo point: "))(if (= ldr3 nil)
(progn(setq ang(angle ldr1 ldr2) dist(-(distance ldr1 ldr2) radi))
(command "LINE"  ldr1 (polar ldr1 ang dist) ^c)(setq ldr3 ldr2))
;(command "dim1" "lea" ldr1 (polar ldr1 ang dist) ^c)(setq ldr3 ldr2))
(progn(setq ang(angle ldr2 ldr3) dist(-(distance ldr2 ldr3) radi))
(command "LINE" ldr1 ldr2 (polar ldr2 ang dist) ^c)))
;(command "dim1" "lea" ldr1 ldr2 (polar ldr2 ang dist) ^c)))
;(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" "green" "")
(command "layer" "s" TEXTL "")
(initget 1)(setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE") (GETVAR "DIMTXT") ) 0 c)))
(if (= (strcase ldr1) "A")(progn(setq ldr3(cdr(assoc 10(entget(car(entsel "\npick existing balloon: "))))))
(setq dir(getangle ldr3 "\nDirection for balloon: "))
(if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi)))))
(if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3))))
(if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi)))))
(if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3))))
(command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" "green" "")
(command "layer" "s" TEXTL "")
(setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) 0 c)))
(while ad(setq ad "")   ;;;;(getstring "\nAdd adjacent balloon:<Y> ")   )
(if (OR (= AD "") (= (strcase ad) "Y"))  (progn(setq dir(getangle ldr3 "\nDirection for balloon: "))
(if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi)))))
(if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3))))
(if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi)))))
(if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3))))
(command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" "green" "")
(setq c(getstring t "\nEnter item #: "))
(command "layer" "s" TEXTL "")(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) "0" c)) (setq ad nil)))
(command "layer" "s" clyr "")(setq *error* iterr)(setvar "cmdecho" 1) (princ))
;;;*****************************************

;;;***************************************
(princ "Here")
;;;;**************
;;;; END OF MY.LSP
;;;;**************