KMSTART.lsp

KMSTART.lsp

0.01MB

;;; 
;=============copy string=================

(defun c:tc (/ txt1 msg txt_lst)
(setq txt1 (cdr (assoc 1 (entget (car (entsel "\n>>> Select Source Text:  "))))))
(setq msg (strcat "\n >>Select Target Text: [" (print txt1) "]:"))
(setq txt_lst (entget (car (entsel msg))))
(entmod (subst (cons 1 txt1) (assoc 1 txt_lst) txt_lst))
(princ)
)

(defun c:tcc (/ txt1 msg txt_lst)
(setq txt1 (cdr (assoc 1 (entget (car (entsel "\n>>> Select Source Text:  "))))))
(WHILE (setq msg (strcat "\n >>Select Target Text: [" (print txt1) "]:"))
  (PROGN
    (setq txt_lst (entget (car (entsel msg))))
    (entmod (subst (cons 1 txt1) (assoc 1 txt_lst) txt_lst))
  )
)
(princ)
)

;===================ROOM NAME AREA=======================
;added "\t" :##.00m2(##PY) insert "\t" > ##.00m2\t(##PY)

(defun KM:area_lwp ( / e id area m2area ) 
(setq PY 0.3025)
(setq e (entget (car (entsel "\n SELECT LWPOLYLINE: \n"))))
(setq id (cdr (assoc -1 e)))
(setq area (vlax-curve-getArea id))
(setq m2area (* 1.0e-06 area))
(setq _M2 (strcat ": " (rtos m2area 2 2) "m2"));
(setq _PY (strcat "\t(" (rtos (* m2area PY) 2 1) "PY)"));
(princ)

);defun

(defun KM:RmAreaX ( _M2 / txt_lst rmname exist_m2 rmarea)
(setq txt_lst (entget (car (entsel "\n SELECT ROOMNAME: \n"))))
(setq rmname (cdr (assoc 1 txt_lst)))
(if (/= nil (setq exist_m2 (vl-string-search ":" rmname)))
(progn
(setq rmname
(substr rmname 1 exist_m2)));progn  
);if it exists the area, extract it's the room name in the rmname to update new area.
(setq rmarea (cons 1 (strcat rmname _M2 _PY)))
(entmod (subst rmarea (assoc 1 txt_lst) txt_lst))
(princ)
);defun

(defun c:AAA ( )
(KM:area_lwp)
(KM:RmAreaX _M2)
);defun

;===================Extract ROOM NAME=======================
(defun KM:ExtRoomName ( / )
(setq txt_lst (entget (car (entsel "\n SELECT ROOMNAME: \n"))))
(setq rmname (cdr (assoc 1 txt_lst)))
(setq exist_m2 (vl-string-search ":" rmname))
(setq rmname (substr rmname 1 exist_m2))
(setq rmm (cons 1 rmname))
(entmod (subst rmm (assoc 1 txt_lst) txt_lst))
(princ)
);defun

(defun c:rnn ( )
(KM:ExtRoomName)
);defun

;===================TXTs to csvfile=======================
;added HEADER "No.\tName\tAREA\t(PY)" for Excel
;added FOOTER "\tTOTAL\t=SUM(c2:cN+1)" for function of Excel

(defun KM:CSV ( / pt1 txt_lst txts str rm_area_m2 rm_area n_rm_area len n  style_ size_ csvfile file_w HEADER FOOTER SUM_)
(setq _LISTXT ( ))

(setq csvname (getstring "\nEnter the filename of csv: "))
(if (= csvname "")
(setq csvfile "c:/temp/area.csv")
(progn
(setq path (getvar "dwgprefix"))
(setq csvfile (strcat path csvname ".csv"))
);progn
);if
;
(prompt "\nSELECT TXTs: \n")
(setq txts (ssget "c" (setq pt1 (getpoint)) (getcorner pt1) '((0 . "text"))))
(setq len (sslength txts))
(setq n 0)
(setq rmno 1)
;
(setq file_w (open csvfile "w"))
(setq HEADER "No.\tRoomName\tAREA\t(PY)")
;;
(write-line HEADER file_w)
;
(setq _AREA 0.0)
(repeat len
(setq txt_lst (entget (ssname txts n)))
(setq str (cdr (assoc 1 txt_lst)))
(if (and (vl-string-search ":" str) (vl-string-search "m2\t" str))
(progn
;; Extract AREA from str
(setq loc_split (+ 3 (vl-string-search ":" str)))
(setq _AREA (+ _AREA (atof (substr str loc_split (- (strlen str) (+ loc_split 1))))))
;;
(setq rm_area_m2 (vl-string-subst "\t" ":" str))
(setq rm_area (vl-string-subst "" "m2" rm_area_m2))
(setq n_rm_area (strcat (itoa rmno) "\t" rm_area))
;;
(write-line n_rm_area file_w)
(setq rmno (+ 1 rmno))
);progn
);if
(setq n (1+ n))
);repeat 
(setq SUM_ (strcat "=SUM(c2:c" (itoa rmno) ")"))
(setq FOOTER (strcat "\tTOTAL\t" SUM_ "\t=0.3025*c" (itoa (+ 1 rmno))))
(write-line FOOTER file_w)
(prompt (strcat "Success to write the csv file at " csvfile))

(setq style_ (cdr (assoc 7 (entget (ssname txts 0)))))
(setq size_ (cdr (assoc 40 (entget (ssname txts 0)))))
;(princ (setq _TOTAL (strcat "\n" (getvar "CLAYER") "_TOTAL AREA: " (rtos _AREA 2 2) "m2\n")))
(princ (setq _TOTAL (strcat "\nTOTAL AREA: " (rtos _AREA 2 2) "m2\t(" (rtos (* _AREA 0.3025) 2 1) "PY)\n")))
(prompt "\n>> Specify Insertion point of the Total Area...\n")
(entmake (list (cons 0 "TEXT") (cons 1 _TOTAL) (cons 7 style_) (cons 10 (getpoint)) (cons 40 size_)))
(princ _AREA)
;
(close file_w)
(princ "\n")
(princ)
);defun

(defun c:csv ()
(KM:CSV)
);defun

;===================TOTAL QUANTITY=======================

(defun KM:TTT (/ _QNT _TOTAL)
(setq _QNT (sslength (ssget '((0 . "LWPOLYLINE")))))
(princ (setq _TOTAL (strcat "\n" (getvar "CLAYER") "_TOTAL QUANTITY: " (itoa _QNT) "\n")))
(entmake (list (cons 0 "TEXT") (cons 1 _TOTAL) (cons 7 (getvar "TEXTSTYLE")) (cons 10 (getpoint)) (cons 40 (getvar "TEXTSIZE"))))
);defun

(defun c:ttt ()
(KM:TTT)
);defun

;===================COPY to current LAYER=======================

(defun c:CCC ()
(ssget)
(command "copy" "p" "" "0,0" "0,0")
(command "_change" "p" "" "p" "la" (getvar "CLAYER") "")
(command "draworder" "p" "" "f")
)

;===================CHANGE to current LAYER=======================

(defun c:CCL ()
(ssget)
(command "_change" "p" "" "p" "la" (getvar "CLAYER") "")
);defun

;===================SET current TEXTSIZE=======================

(defun c:TTH ()
(setvar "TEXTSIZE" (cdr (assoc 40 (entget (car (entsel "\n SELECT TEXT: \n"))))))
);defun

;===================AUTOMATICALLY NUMBER=======================

(defun c:AN ( / txt_lst source string_sn style_sn size_sn serial )
(setq source (entget (car (entsel "\n SELECT SOURCE TEXT: \n"))))
(setq string_sn (cdr (assoc 1 source)))
(setq style_sn (cdr (assoc 7 source)))
(setq size_sn (cdr (assoc 40 source)))
(setq serial 1)
(repeat 99
;(while (< serial 99) ;not spacebar (ascii 32)
(setq p1 (getpoint "\nPick point..."))
(if (> serial 9)
(progn (setq _SN (strcat string_sn "" (itoa serial))))
(setq _SN (strcat string_sn "0" (itoa serial))))
;(princ _SN)
(entmake (list (cons 0 "TEXT") (cons 1 _SN) (cons 7 style_sn)  (cons 10 p1)(cons 40 size_sn)))
(setq serial (1+ serial))
);repeat
);defun 

;|===================Ctrl-C String=======================

(defun setClipText(str / html result)
(if (= 'STR (type str))
  (progn
  (setq html   (vlax-create-object "htmlfile")
        result (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" str)
  )
  (vlax-release-object html)
   str
   )
 );end if
);defun

(defun KM:ctrl_c ( / source )
;insert code of the clear clipboard
(setq source (entget (car (entsel "\n SELECT SOURCE TEXT: \n"))))
(setq _STRING_CCB (cdr (assoc 1 source)))
(setClipText string_s)
);defun

(defun c:ccb ( / msg ); Copy to the CLIPBOARD.
(km:ctrl_c)
(setq msg (strcat "...\"" _STRING_CCB "\"" " copied to the ClipBloard"))
(prompt msg)
(princ)
);defun
|;

;===================Select a LWPOLYLINE to ZOOM window=======================
(defun c:ZS ( );/ lwp dxf len n pts e1 lst_dxf )
(setq dxf (entget (car (entsel "\n...Select a Rectangle to ZOOM..."))))
(setq len (length dxf))
(setq n 0)
(setq pt nil)
(setq ptx '( ))
(setq pty '( ))
(repeat len
(setq lst_dxf (nth n dxf))
(setq e1 (car lst_dxf))
(if (= e1 10)
(progn
(setq pt (cdr lst_dxf))
(setq ptx (append ptx (list (car pt))))
(setq pty (append pty (list (cadr pt))))
)
(princ)
)
(setq n (1+ n))
)
(setq pt1 (list (apply 'min ptx) (apply 'min pty)))
(setq pt2 (list (apply 'max ptx) (apply 'max pty)))
(setq Acad (vlax-get-acad-object))
(vla-ZoomWindow Acad (vlax-3d-point pt1) (vlax-3d-point pt2))
(princ)
);defun

;===================MView locK Unlock=======================
(defun c:MK ( )
(command "MVIEW" "LOCK" "ON")
);defun

(defun c:MU ( )
(command "MVIEW" "LOCK" "OFF")
);defun

;=============Change BLOCKs by MIDPOINT instead it's basepoint selected BLOCKs===================
(defun KM:MoB ( EN / P1 P2 P3 entityname ); Find MIDPOINT of Selected BLOCK
(setq entityname EN)
(vla-GetBoundingBox (vlax-ename->vla-object entityname) 'MinPt 'MaxPt)
(setq P1 (vlax-safearray->list MinPt)); Points of Lower Left of Selected Entity 
(setq P2 (vlax-safearray->list MaxPt)); Points of Upper Right of Selected Entity
(setq P3 (mapcar '(lambda (x y) (/ (+ x y) 2)) P1 P2)); MIDPOINT between p1 and p2
;(princ P3)
;(princ)
)

(defun c:BB ( / olds old _midpoint new new_name len n dxf_block msg)
(vl-load-com)
(prompt "\nSelect Blocks: ")
(if (setq olds (ssget '((0 . "INSERT"))))
(progn
(prompt "\n...Select A target BLOCK to be replaced: ...")
(setq new (ssget ":E:S" '((0 . "INSERT"))))
(setq new_name (assoc 2 (entget (ssname new 0))))
(setq len (sslength olds))
(setq n 0)
(repeat len
(setq old (ssname olds n))
(setq _midpoint (KM:MoB old))
(setq _midpoint (list (car _midpoint) (cadr _midpoint) 0.0))
(setq dxf_block (entget old))
(setq dxf_block (subst new_name (assoc 2 dxf_block) dxf_block))
(setq dxf_block (subst (cons 10 _midpoint) (assoc 10 dxf_block) dxf_block))
(setq dxf_block (subst (cons 41 1.0) (assoc 41 dxf_block) dxf_block))
(setq dxf_block (subst (cons 42 1.0) (assoc 42 dxf_block) dxf_block))
(setq dxf_block (subst (cons 43 1.0) (assoc 43 dxf_block) dxf_block))
(setq dxf_block (subst (cons 50 0.0) (assoc 50 dxf_block) dxf_block))
(entmod dxf_block)
(setq n (1+ n))
);repeat
);progn
(princ)
);if
(setq msg (strcat "\n...Changed " (itoa len) " Blocks."))
(prompt msg)
(close file_w)
(princ)
);defun 

;===================Change A BLOCK Another BLOCK=======================
(defun c:BB1 (/ ss nbl)
(prompt "\nSelect block: ")
(if (setq ss (ssget "_:S:E" '((0 . "INSERT"))))
  (progn
    (setq ss (entget (setq ss (ssname ss 0))))
    (redraw (cdr (assoc 330 ss)) 3)
    (prompt "\nSelect blocks to be replaced: " )
    (while (setq nbl (ssget "_:S:E" '((0 . "INSERT"))))
      (setq nbl (entget (setq nbl (ssname nbl 0))))
      (entmod (subst (assoc 2 nbl) (assoc 2 ss) ss ))
      (redraw entBlock 4)
    ); while
  ); progn  
); if
(princ)
); defun

;===================Count Block to CSV=======================
(defun c:BB2CSV ( / bls bl _bpt len n msg )
(prompt "\nSelect Blocks: ")

(setq csvfile "c:/temp/cnt_blocks.csv")
(setq file_w (open csvfile "w"))

(setq _header "No.\tX_coord\tY_coord")
(write-line _header file_w)

(if (setq bls (ssget '((0 . "INSERT"))))
(progn
(setq len (sslength bls))
(setq n 0)
(repeat len
(setq bl (ssname bls n))
(setq _bpt (assoc 10 (entget bl)))
(setq n (1+ n))

(setq _coord_bpt (strcat (itoa n) "\t" (rtos (cadr _bpt) 2 1) "\t" (rtos (caddr _bpt) 2 1)))
(write-line _coord_bpt file_w)

);repeat
);progn
(princ)
);if
(setq msg (strcat "\n...Extracted Coordinates of " (itoa len) " Blocks."))
(prompt msg)
(close file_w)
(princ)
);defun 

;===================Caculations ,, ++ xx //=======================
(defun KM:GETSTR ( / txt_lst)
(setq txt_lst (entget (car (entsel "\n SELECT TEXT: \n"))))
(setq str (cdr (assoc 1 txt_lst)))
(princ txt_lst)
);

(defun KM:IC ( txt_lst / str); Insert Comma
(setq str (cdr (assoc 1 txt_lst)))
(setq DecimalLength (strlen str))
(setq DecimalPoint (vl-string-search "." str))
(if (= DecimalPoint nil)
(setq DecimalPoint DecimalLength)
);if
(setq FirstCommaLocation (rem DecimalPoint 3))
(setq CountComma (/ (- DecimalPoint 1) 3))
(if (= FirstCommaLocation 0)
(setq FirstCommaLocation 3)
);if
(setq n 0)
;(setq NumberComma "")
(setq NumberComma (substr str 1 FirstCommaLocation))
(repeat CountComma
(setq SplitNumber(substr str (+ 1 FirstCommaLocation (* 3 n)) 3))
(setq NumberComma (strcat NumberComma "," SplitNumber))
(setq n (+ 1 n))
);repeat
(setq NumberComma (strcat NumberComma (substr str (+ 1 DecimalPoint))))
(setq DxfNumberComma (cons 1 NumberComma))
(entmod (subst DxfNumberComma (assoc 1 txt_lst) txt_lst))
(princ)
);defun

(defun KM:RC ( txt_lst / str); Remove Comma
(setq str (cdr (assoc 1 txt_lst)))
(setq NumberCommaRem str)
(repeat (strlen str)
(setq NumberCommaRem (vl-string-subst "" "," NumberCommaRem))
);
(setq DxfNumberCommaRem (cons 1 NumberCommaRem))
(entmod (subst DxfNumberCommaRem (assoc 1 txt_lst) txt_lst))
(princ)
);defun

(defun c:,,()
(setq txt_lst (KM:GETSTR))
(setq str (cdr (assoc 1 txt_lst)))
(if (= nil (vl-string-search "," str))
(KM:IC txt_lst)
(KM:RC txt_lst)
);if
);defun

(defun KM:FF ( / FIRAD); KM TOOLS
(setq FIRAD (getvar "FILLETRAD"))
(command "fillet" "r" "0" "fillet" (entsel) (entsel))
(setvar "FILLETRAD" FIRAD)
);defun
(defun c:ff()
(KM:FF))
;
(defun KM:EXPLORER ()
(startapp "explorer" (strcat "/e, "(getvar "dwgprefix")))
);defun
(defun c:fff()
(KM:EXPLORER))

;===================Explode Minsert block=======================
;ARRAY MODULE
(defun KM:ARR_non ( / )
(princ)
)
(defun KM:ARR_rec (CNT_RW CNT_CL DIS_RW DIS_CL)
(command ".-array" (entlast) "" "R" CNT_RW CNT_CL DIS_RW DIS_CL)
(princ)
)
(defun KM:ARR_lin (CNT_RW CNT_CL DIS)
(command ".-array" (entlast) "" "R" CNT_RW CNT_CL DIS)
(princ)
)
;EXPLODE MINSERT BLOCK
(defun KM:XM ( ENT / NT DXF_ENT NAM_BL COR_IN CNT_RW CNT_CL DIS_RW DIS_CL LYR COLR OSM CLYR)
;
(setq DXF_ENT (entget ENT)
NAM_BL (cdr (assoc 2 DXF_ENT))
COR_IN (cdr (assoc 10 DXF_ENT))
CNT_RW (cdr (assoc 71 DXF_ENT))
CNT_CL (cdr (assoc 70 DXF_ENT))
DIS_RW (cdr (assoc 45 DXF_ENT))
DIS_CL (cdr (assoc 44 DXF_ENT))
LYR (cdr (assoc 8 DXF_ENT))
COLR (cdr (assoc 62 DXF_ENT))
OSM (getvar "osmode")
CLYR (getvar "clayer")
);setq
(cond
((/= nil COLR) (setq COLR (itoa COLR)))
((= nil COLR) (setq COLR "bylayer"))
);cond
(setvar "osmode" 22561)
(setvar "clayer" LYR)
(setvar "cecolor" COLR)
(command ".erase" ENT "")
(command ".-insert" NAM_BL COR_IN "" "" 0)
(cond
((and (= 1 CNT_CL) (= 1 CNT_RW)) (KM:ARR_non))
((and (< 1 CNT_CL) (= 1 CNT_RW)) (KM:ARR_lin CNT_RW CNT_CL DIS_CL))
((and (= 1 CNT_CL) (< 1 CNT_RW)) (KM:ARR_lin CNT_RW CNT_CL DIS_RW))
((and (< 1 CNT_CL) (< 1 CNT_RW)) (KM:ARR_rec CNT_RW CNT_CL DIS_RW DIS_CL))
);cond
(prompt "\nSUCESS EXPLODE MULTY INSERTED BLOCK\n")
(setvar "cecolor" "bylayer")
(setvar "clayer" CLYR)
(setvar "osmode" OSM)
;);progn
;);if
(princ)
);defun
;MAIN FUCTION c:MX
(defun c:xmb ( / ENT) ;eXplode Multy inserted Blocks
(if (setq ENT (car (entsel "\nSELECT MINSERT: \n")))
(progn
(KM:XM ENT)
);progn
);if
);defun

;MAIN EXPLODE ALL MINSERT BLOCKS c:MXX
(defun c:xmm ( / ENT)
(setq n 0)
(setq SS (ssget "X" '((-4 . "<not") (-4 . "<and") (44 . 0) (45 . 0) (-4 . "and>") (-4 . "not>"))))
(setq SSLEN (sslength SS))
(repeat SSLEN
(setq ENT (ssname SS n))
(KM:XM ENT)
(setq n (+ 1 n))
);repeat
);defun

;=================== Replace BLOCKs to Another BLOCK =======================

(defun c:BBK ( / olds old new new_name len n dxf_block msg)
(vl-load-com)
(prompt "\nSelect Blocks: ")
(if (setq olds (ssget '((0 . "INSERT"))))
(progn
(prompt "\n...Select A target BLOCK to be replaced: ...")
(setq new (ssget ":E:S" '((0 . "INSERT"))))
(setq new_name (assoc 2 (entget (ssname new 0))))
(setq len (sslength olds))
(setq n 0)
(repeat len
(setq old (ssname olds n))
(setq dxf_block (entget old))
(setq dxf_block (subst new_name (assoc 2 dxf_block) dxf_block))
(entmod dxf_block)
(setq n (1+ n))
);repeat
);progn
(princ)
);if
(setq msg (strcat "\n...Changed " (itoa len) " Blocks."))
(prompt msg)
(close file_w)
(princ)
);defun 

;=================== RENAME BLOCK =======================

(defun c:REB(/ ent bname rebname elist)
(setq ent (car (entsel "\nSelect a BLOCK to Rename.")))
(while 
(/= "INSERT" (cdr (assoc 0 (entget ent))))
(setq ent (car (entsel "\nSelect again.")))
)
;
(setq old_name (cdr (assoc 2 (entget ent))))
(setq elist (entget (cdr (assoc 330 (entget (tblobjname "block" old_name))))))
(setq msg (strcat "\nInput a New NAME of the BLOCK[" old_name "]: "))
(setq bname (getstring T msg));
(princ old_name)
;

(while
(tblsearch "block" bname)
(progn
(setq rebname (strcat "Specified " bname " is already using. Input the name agian. : "))
(setq bname (getstring T rebname))
)
)
; (setq elist (entget (cdr (assoc 330 (entget (tblobjname "block" (cdr (assoc 2 (entget ent))))))))) ;;;
(entmod (subst (cons 2 bname) (assoc 2 elist) elist))
(princ)
)


;=================== -VPORTS V H 4 SI =======================
;
(defun c:VV ( )
(command "-vports" "2" "Vertical")
(princ)
)
(defun c:VH ( )
(command "-vports" "2" "Horizontal")
(princ)
)
(defun c:V4 ( )
(command "-vports" "4")
(princ)
)
(defun c:V1 ( )
(command "-vports" "SIngle")
(command "zoom" "e")
(princ)
)
;;;
;=================== TEXT MOVE TO MID POINT, ROTATE 0, JUSTIFY MIDDLE =======================
;
(defun KM:MP ( / p1 p2 ) ; Get MP that is MID POINT
(setq p1 (getpoint "\nPick a LowerLeft Point:\n") p2 (getpoint "Pick a UpperRight Point:\n"))
(setq mp (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) 0.0))
)

(defun c:to (/ cl txt ent_name m old new)
(setq cl (getvar "CLAYER"))
;(setq ent_name (ssname (ssget ":S" '((0 . "TEXT"))) 0))
(setq ent (car (entsel "\nSelect a TEXT.")))
(while 
(/= "TEXT" (cdr (assoc 0 (entget ent))))
(setq ent (car (entsel "\nSelect again.")))
)
(setq ent_name (entget ent))
(setq m (KM:MP))
(setq old (assoc 10 ent_name)
new (cons 10 m) ;First alignment point
ent_name (subst new old ent_name)
)
(setq old (assoc 11 ent_name)
new (cons 11 m) ;Second alignment point
ent_name (subst new old ent_name)
)
(setq old (assoc 50 ent_name)
new (cons 50 0) ;Text rotation
ent_name (subst new old ent_name)
)
(setq old (assoc 72 ent_name)
new (cons 72 4) ;Horizontal text justification,0=Left,1=Center,2=Right,4=Middle,5=Fit
ent_name (subst new old ent_name)
)
(entmod ent_name)
(setvar "CLAYER" cl)
(princ)
)

(defun CreateText (txtStyle txtJust insertPt txtString)
 (if (= txtJust "tc") (setq horJust 1
    verJust 3))
 (if (= txtJust "mc") (setq horJust 1
    verJust 2))
 (if (= txtJust "bc") (setq horJust 1
    verJust 1))
 (if (= txtJust "ml") (setq horJust 0
    verJust 2))
;These values are just being used for testing
 ;(setq txtStyle "Standard")
 ;(setq insertPt (list 2.0 3.0))
 ;(setq txtString "test")
 
 (entmake
  (list
   (cons 0 "TEXT")
   (cons 100 "AcDbEntity")
   (cons 100 "AcDbText")
   (cons 7 txtStyle) ;Text style name
   (cons 10 insertPt) ;First alignment point
   (cons 11 insertPt) ;Second alignment point
   (cons 1 txtString) ;Default value (the string itself)
   (cons 50 0) ;Text rotation
   (cons 71 0) ;Flags 0=Normal, 2=Backward, 4=Upside down
   (cons 72 horJust) ;Horizontal text justification,0=Left,1=Center,2=Right,4=Middle,5=Fit
   (cons 73 verJust) ;Vertical text justification, 0=Baseline,1=Bottom,2=Middle,3=Top
  )
 )
)
;;;
;=================== TIMESTAP FUCTION =======================
;
(defun TODAY ( / d yr mo day)
     (setq d (rtos (getvar "CDATE") 2 6)
;          yr (substr d 3 2)
          yr (substr d 1 4)
          mo (substr d 5 2)
          day (substr d 7 2)
     );setq
;     (strcat day "/" mo "/" yr)
     (strcat yr "-" mo "-" day)
);defun
;;;*-------------------------------------------
(defun TIME ( / d hr m s)
     (setq d (rtos (getvar "CDATE") 2 6)
          hr (substr d 10 2)
          m (substr d 12 2)
          s (substr d 14 2)
     );setq
     (strcat hr ":" m ":" s)
);defun
;;;*-------------------------------------------
;;;
;
;===================  Change Fonts 20221207=================== 
(defun c:FC()
  (setq !Style (tblnext "STYLE" T))
  (while !Style
    (setq !Style (strcase (cdr (assoc 2 !Style))))
    (command "-style" !Style "simplex.shx,whgtxt.shx" "0" "1" "0" "n" "n" "n")
    (setq !Style (tblnext "STYLE"))
  )
)