허걱!!! 님...이리습 쓰지 마세여

[샤미르]

보아하니 이 리습화일은 따로 독립적으러 리습화일을 작성하고

따로 따로 필요할때마다 로드해서 쓰는게 아닌....

acad.lsp 화일에 추가로 넣어눈것 같은데...

이렇게 하면 캐드 실핼시와 화일을 열때마다...

엄청난(?)메모리 낭비효과가 있습니다... ㅡㅡ^

용도는 대충보아하니...

자주쓰는 명령어를 한번에 하는것 같은데...

리습의 용도는 그런게 아닙니다....

단순히 명령어를 한단계 빠르게 하고자 리습이 생긴건 아니라는 거져..

이거...안쓰시는게 좋을듯 합니다....

물론...제 갠적인 생각이지만 말이져... ^^;;;

구람 이만... 휘리릭~~~


--------------------- [원본 메세지] ---------------------
너무나 많은 내용이 하나로 뭉처서 뭐가 무엇인지를 전혀 알수가없습니다..
LISP 고수님들의 분석을 요청합니다....너무 많으니까요..뭐..않해주셔도되요....ㅜ.ㅜ
문서를 자료실이나 올리수가 없서서 무식하게 글 올립니다..

--------------------------------------------------------------------
;********************************************************************
(defun C:QS()(menucmd "s=x")(menucmd "s=")(command "SAVEAS" "LT2" "" "Y"))
(defun C:EAL()(menucmd "s=x")(menucmd "s=")(command "ERASE" "ALL" "LT2" "" "Y"))
(defun C:PUA()(menucmd "s=x")(menucmd "s=")(command "PURGE" "ALL" "" "n"))
(defun C:chpp()(menucmd "s=x")(menucmd "s=")(command "l" ))

(defun C:zz()(menucmd "s=x")(menucmd "s=")(command "zoom" "E"))
(defun C:ZX()(menucmd "s=x")(menucmd "s=")(command "'zoom" "p"))
(defun C:ZD()(menucmd "s=x")(menucmd "s=")(command "'zoom" "D"))
(defun C:ZV()(menucmd "s=x")(menucmd "s=")(command "'zoom" "V"))
(defun C:zw()(menucmd "s=x")(menucmd "s=")(command "zoom" "w" "_endp" "_endp" ))
(defun C:II()(menucmd "s=x")(menucmd "s=")(command "UCS" "e"))
(defun C:Uu()(menucmd "s=x")(menucmd "s=")(command "ucs" ""))
(defun c:za()(menucmd "s=x")(menucmd "s=")(command "_zoom" "all"))
(defun c:h()(menucmd "s=x")(menucmd "s=")(command "dim1" "hor"))
(defun c:v()(menucmd "s=x")(menucmd "s=")(command "dim1" "ver"))
(defun c:LL()(menucmd "s=x")(menucmd "s=")(command "DIM1" "L" "near"))
(defun c:kl()(menucmd "s=x")(menucmd "s=")(command "dim1" "l"))
(defun c:SS()(menucmd "s=x")(menucmd "s=")(command "STRETCH" "C"))
(defun c:dr()(menucmd "s=x")(menucmd "s=")(command "dim1" "rad"))
(defun c:di()(menucmd "s=x")(menucmd "s=")(command "dim1" "dia"))
(defun c:da()(menucmd "s=x")(menucmd "s=")(command "dim1" "ang"))
(defun c:i()(menucmd "s=x")(menucmd "s=")(command "insert" "~" ""))
(defun c:in()(menucmd "s=x")(menucmd "s=")(command "ddinsert"))
(defun c:d()(menucmd "s=x")(menucmd "s=")(command "donut" "0"))
(defun c:df()(menucmd "s=x")(menucmd "s=")(command "dim1" "dimlfac"))
(defun c:UP()(menucmd "s=x")(menucmd "s=")(command "dim1" "UPDATE"))
(defun c:rev()(menucmd "s=x")(menucmd "s=")(command "layer" "make" "rev1" "color" "4" "" ""))
(defun c:rc()(menucmd "s=x")(menucmd "s=")(command "revcloud" "dimlfac"))
(defun c:hom()(menucmd "s=x")(menucmd "s=")(command "dim1" "tedit" "home"))
(defun c:ht()(menucmd "s=x")(menucmd "s=")(command "dim1" "hometext"))
(defun c:ob()(menucmd "s=x")(menucmd "s=")(command "dim1" "oblique"))
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
(defun c:MV1() (menucmd "s=x")(menucmd "s=")(command "script" "001"))
(defun c:MV2() (menucmd "s=x")(menucmd "s=")(command "script" "002"))
(defun c:MV3() (menucmd "s=x")(menucmd "s=")(command "script" "003"))
(defun c:MV5() (menucmd "s=x")(menucmd "s=")(command "script" "005"))
(defun c:MV7() (menucmd "s=x")(menucmd "s=")(command "script" "007"))
(defun c:MV10() (menucmd "s=x")(menucmd "s=")(command "script" "010"))
(defun c:MV15() (menucmd "s=x")(menucmd "s=")(command "script" "015"))
(defun c:MV20() (menucmd "s=x")(menucmd "s=")(command "script" "020"))
(defun c:MV25() (menucmd "s=x")(menucmd "s=")(command "script" "025"))
(defun c:MV30() (menucmd "s=x")(menucmd "s=")(command "script" "030"))
(defun c:MV35() (menucmd "s=x")(menucmd "s=")(command "script" "035"))
(defun c:MV40() (menucmd "s=x")(menucmd "s=")(command "script" "040"))
(defun c:MV45() (menucmd "s=x")(menucmd "s=")(command "script" "045"))
(defun c:MV50() (menucmd "s=x")(menucmd "s=")(command "script" "050"))
(defun c:MV60() (menucmd "s=x")(menucmd "s=")(command "script" "060"))
(defun c:MV70() (menucmd "s=x")(menucmd "s=")(command "script" "070"))
(defun c:MV75() (menucmd "s=x")(menucmd "s=")(command "script" "075"))
(defun c:MV80() (menucmd "s=x")(menucmd "s=")(command "script" "080"))
(defun c:MV100()(menucmd "s=x")(menucmd "s=")(command "script" "100"))
(defun c:MV120()(menucmd "s=x")(menucmd "s=")(command "script" "120"))
(defun c:MV150()(menucmd "s=x")(menucmd "s=")(command "script" "150"))
(defun c:MV200()(menucmd "s=x")(menucmd "s=")(command "script" "200"))
(defun c:MV250()(menucmd "s=x")(menucmd "s=")(command "script" "250"))
(defun c:MV300()(menucmd "s=x")(menucmd "s=")(command "script" "300"))
(defun c:MV350()(menucmd "s=x")(menucmd "s=")(command "script" "350"))
(defun c:MV500()(menucmd "s=x")(menucmd "s=")(command "script" "500"))
;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
(defun c:dset() (SETVAR "CMDECHO" 0)(COMMAND "DIMASZ" "2.5" "DIMCLRD" "4" "DIMCLRE" "4" "DIMSOXD" "OFF")
(command "DIMCLRT" "2" "DIMDLI" "1" "DIMEXE" "1" "DIMEXO" "1" "DIMFIT" "5")
(command "DIMGAP" "1" "DIMTAD" "1" "DIMTIH" "OFF" "DIMTIX" "ON" "DIMTOFL" "ON")
(command "DIMTOH" "OFF" "DIMTXSTY" "ROMANS" "DIMTXT" "3" "DIMZIN" "8")(SETVAR "CMDECHO" 0))
(defun c:lset() (command "LAYER" "NEW" "7" "C" "WHITE" "7" "LT" "CONTINUOUS" "7")
(command "NEW" "1" "C" "RED" "1" "LT" "CENTER" "1")
(command "NEW" "2" "C" "YELLOW" "2" "LT" "hidden" "2")
(command "NEW" "3" "C" "green" "3" "LT" "continuous" "3")
(command "NEW" "4" "C" "cyan" "4" "LT" "CONTINUOUS" "4")
(command "NEW" "5" "C" "magenta" "5" "LT" "phantom" "5")
(command "new" "dim" "c" "cyan" "dim" "lt" "continuous" "dim")
(command "NEW" "0" "C" "yellow" "0" "LT" "CONTINUOUS" "0" "")
)

****************************************************************************


(defun c:do()
(setq a (getver "dimscale"))
(command "donut" "0" a)
)
(defun C:cff (/ key)
(setvar "cmdecho" 0)
(setq c1 (getdist "Chamfer Size: "))
(setq key (getvar "chamfer"))
(command "chamfer" "d" c1 "")
(command "chamfer")
)

(defun C:ff (/ key)
(setvar "cmdecho" 0)
(setq c1 (getdist "Fillet Radius Size : R= "))
(setq key (getvar "fillet"))
(command "fillet" "r" c1)
(command "fillet")
)

(defun C:cf (/ key)
(setvar "cmdecho" 0)
(setq key (getvar "chamfer"))
(command "chamfer" "d" "0" "0")
(command "chamfer")
)

(defun C:f (/ key)
(setvar "cmdecho" 0)
(setq key (getvar "fillet"))
(command "fillet" "r" "0")
(command "fillet")
)
;******************************************************************************
(defun chgterr (s) (if (/= s "Function cancelled") (princ (strcat
"\nError: " s)) ) (setq p nil) (setq *error* olderr) (princ) )


(defun c:ct()
(setq a (entget (car (entsel "Select TEXT: ")))
b (assoc 1 a)
)
(princ "\nOLDTEXT: ")(princ (cdr b))(princ "\n")
(setq c (getstring 1"NEWTEXT: ")
c1 (cons 1 c)
b1 (subst c1 b a)
)
(entmod b1)
(princ)
)

;*****************************************************************************
(defun c:saa()
(setvar "orthomode" 0)
(setvar "osmode" 0)
(setvar "dimasz" 2.5)
(setq sp (getpoint "\nPick leader start point: ")
ep (getpoint sp "\nTo point: ")
str (getstring t "\nText: ")
)
(if (null (tblsearch "block" "AARROW"))
(progn
(command "layer" "s" "dim" "" ".insert" "AARROW")
(command)
)
)
; (layset "dim")
; (layer "s" "dim" "")
(command "dimtad" 0 "dimtvp" 0 "dimgap" 1.5
"dim" "dimblk" "AARROW" "lea" "non" sp "non" ep "" str
"dimblk" "." "exit" "dimtad" 1 "orthomode" 1 "osmode" osmode
)
(princ)
)
(defun stdleader (/ sp ep str)
(setvar "orthomode" 0)
(setvar "osmode" 512)
(command "leader" pause pause "")
)

(defun chp (no lt)
(command "color" no "select" "si" "au" pause "chprop" "p" "" "c" no "lt" lt "")
)

(defun cgg (ln) (command "select" "si" "au" pause "chprop" "p" "" "la" ln "lt" "bylayer" "c" "bylayer" ""))


(defun cgs (no ln lt) (command "select" "si" "au" pause "chprop" "p" "" "la" ln "lt" lt "c" no ""))
(defun dim (se1 se2 cmd) (layset "dim") (command "osmode" osmode "dimse1" se1 "dimse2" se2 "dim1" cmd))
(defun leader (osmd)
(setvar "dimasz" 2)
(layset "ch")
(command "orthomode" 0 "dim1" "lea" osmd pause pause)
(command)
)
(defun coord (x1 y1 x2 y2)
(setq fa (getvar "dimscale") llp (list (* fa x1) (* fa y1)) urp (list (* fa x2) (* fa y2)))
(command "osmode" 0 ".zoom" "w" llp urp "osmode" osmode)
)

(defun smode (var) (mapcar '(lambda (n) (cons n (getvar n))) var))
(defun rmode (var) (foreach n var (setvar (car n) (cdr n))))


(defun layset (str)
(command "layer" (if (tblsearch "layer" str) "s" "m") str "")
(setvar "osmode" 39)
)
;****************************************************************************
(defun c:det ( / fa cp r ip ep mp ai)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq fa (getvar "dimscale"))
(setq cp (getpoint "\nCenterpoint of detail area: "))
(command "ucs" "" "layer" "s" "ch" "" "circle" cp pause
"chprop" "l" "" "c" 4 "lt" "phantom" ""
)
(setq r (cdr (assoc 40 (entget (entlast)))))
(command "insert" "detlmark" "s" fa pause 0 "explode" "l")
(setq ip (getvar "lastpoint"))
(if (> (car ip) (car cp)) (setq fa (- fa)) )
(setq ep (list (+ (* fa 9) (car ip)) (cadr ip))
ai (angle cp ep)
fa (abs fa)
mp (polar cp ai (sqrt (- (expt r 2) (expt (* 2 fa) 2)) ))
)
(command "pline" mp "w" (* fa 4) 0 (polar mp ai (* fa 2))
ep (polar ep (angle ep ip) (* fa 3)) ""
)
(setvar "orthomode" 1)
(setvar "osmode" 51)
(princ)
)
;****************************************************************************
(defun c:sec (/ ai fa d45 d90 d135 d225 d315 tp hp)
(if
(or
(and (tblsearch "block" "sec-head") (tblsearch "block" "sec-tail"))
(and (findfile "sec-head.dwg") (findfile "sec-tail.dwg"))
)
(progn
(setvar "blipmode" 0) (setvar "cmdecho" 0)
(setvar "osmode" 0) (setvar "filedia" 1) (setvar "mirrtext" 1)
(setq fa (getvar "dimscale")
d45 (* 0.25 pi) d90 (* 0.5 pi) d135 (* 0.75 pi)
d225 (* 1.25 pi) d315 (* 1.75 pi)
)
(command "ucs" "")
(if (/= "CO" (getvar "clayer"))
(if (tblsearch "layer" "co")
(command "layer" "set" "co" "")
(command "layer" "make" "co" "")
)
)
(if (/= "RS3" (getvar "textstyle"))
(if (tblsearch "style" "rs3")
(progn (command "text" "s" "rs3") (command))
(if (setq fn (findfile "romans.shx"))
(command "style" "rs3" "romans" (* 3 fa) 0.8 0 "" "" "")
)
)
)
(while (not ai)
(if (not (setq ai (getorient "\nSection plane angle: ")))
(princ "\Enter numeric value or pick point.")
)
)
(command ".ucs" "z" (/ (* ai 180) pi) "layer" "s" "co" "")
(princ "\nSection-tail mark point: ")

(command ".insert" "sec-head" "s" fa "r" 0 pause)
(command "ucs" "o" (setq hp (getvar "lastpoint")))

(princ "\nSection-tail mark point: ")
(command ".insert" "sec-tail" "s" fa "r" 0 ".x" '(0 0) pause)
(setq tp (getvar "lastpoint"))

(if (or (< d45 ai d135) (< d225 ai d315))
(if (minusp (cadr tp))
(onelin 0 6 0 -14.5)
(onelin 0 -6 0 14.5)
)
(progn
(onelin -6 0 6 0)
(if (minusp (cadr tp))
(onelin 0 -6 0 -14.5)
(onelin 0 6 0 14.5)
)
)
)
(if (minusp (cadr tp))
(command "line" tp (polar tp (* pi 0.5) (* 10 fa)) "")
(command "line" tp (polar tp (* pi -0.5) (* 10 fa)) "")
)
(cond
((< d45 ai d135) (mptxt 3 0 270 "B") (mptxt -3 0 270 "-"))
((<= d135 ai d225)
(mptxt 0 -3 0 "-") (setq en1 (entlast))
(mptxt 0 3 0 "B") (setq en2 (entlast))
(command ".rotate" en1 en2 "" '(0 0) 180)
)
((< d225 ai d315) (mptxt -3 0 90 "B") (mptxt 3 0 90 "-"))
(t (setvar "mirrtext" 0) (mptxt 0 3 0 "B") (mptxt 0 -3 0 "-"))
)

(command "ucs" "")
(setvar "osmode" 49)
)
(princ "\SEC-HEAD.DWG and SEC-TAIL.DWG file not found.")
)
(setvar "mirrtext" 0)
(setvar "osmode" 39)
)

(defun onelin (spx spy epx epy)
(command "line" (list (* fa spx) (* fa spy))
(list (* fa epx) (* fa epy)) ""
)
)

(defun mptxt (mpx mpy ra txt)
(command "text" "m" (list (* fa mpx) (* fa mpy)) ra txt)
)

(defun clerr (s)
(if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs
(princ (strcat "\nError: " s)) ; while this command is active...
)
(command "UCS" "P") ; Restore previous UCS
(setvar "BLIPMODE" sblip) ; Restore saved modes
(setvar "GRIDMODE" sgrid)
(setvar "HIGHLIGHT" shl)
(setvar "UCSFOLLOW" sucsf)
(command "LAYER" "S" "ce" "")
(command "undo" "e")
(setvar "CMDECHO" scmde)
(setq *error* olderr) ; Restore old *error* handler
(princ)
)

;;; --------------------------- Main Program ---------------------------------;

(defun C:Cen (/ olderr clay sblip scmde sgrid shl sucsf e cen rad d ts xx)
(setq olderr *error*
*error* clerr)
(setq scmde (getvar "CMDECHO"))
(command "ORTHO" "ON" "undo" "group" "OSMODE" "0")
(setq clay (getvar "CLAYER"))
(setq sblip (getvar "BLIPMODE"))
(setq sgrid (getvar "GRIDMODE"))
(setq shl (getvar "HIGHLIGHT"))
(setq sucsf (getvar "UCSFOLLOW"))
(setvar "CMDECHO" 0)
(setvar "GRIDMODE" 0)
(setvar "UCSFOLLOW" 0)
(setq e nil
xx "Yes")
; (setq ts (tblsearch "LAYER" "CE"))
; (if (null ts)
; (prompt "\nCreating new layer - CE. ")
; (progn
; (if (= (logand 1 (cdr (assoc 70 ts))) 1)
; (progn
; (prompt "\nLayer CE is frozen. ")
; (initget "Yes No")
; (setq xx (getkword "\nProceed? <N>: "))
; (if (= xx "Yes")
; (command "LAYER" "T" "CE" "")
; )
; )
; )
; )
; )
(if (= xx "Yes")
(progn
(while (null e)
(setq e (entsel "\nSelect arc or circle: "))
(if e
(progn
(setq e (car e))
(if (and (/=
(cdr (assoc 0 (entget e))) "ARC")
(/= (cdr (assoc 0 (entget e))) "CIRCLE")
)
(progn
(prompt "\nEntity is a ")
(princ (cdr (assoc 0 (entget e))))
(setq e nil)
)
)
)
)
)
(command "UCS" "e" e)
(setq cen (trans (cdr (assoc 10 (entget e))) e 1))
(setq rad (cdr (assoc 40 (entget e))))
(prompt "\nRadius is ")
(princ (rtos rad))
(initget 7 "Length")
(setq d (getdist "\nLength/<Extension>: "))
(if (= d "Length")
(progn
(initget 7)
(setq d (getdist cen "\nLength: "))
)
(setq d (+ rad d))
)
(setvar "BLIPMODE" 0)
(setvar "HIGHLIGHT" 0)
; (command "LAYER" "s" "Ce" "")
(command "LINE" (list (car cen) (- (cadr cen) d) (caddr cen))
(list (car cen) (+ (cadr cen) d) (caddr cen)) ""
)
(command "CHANGE" "l" "" "P" "LA" "CE" "")
(command "LINE" (list (- (car cen) d) (cadr cen) (caddr cen))
(list (+ (car cen) d) (cadr cen) (caddr cen)) ""
)
(command "CHANGE" "l" "" "P" "LA" "CE" "")
(command "LAYER" "S" clay "")
)
)
(command "UCS" "P") ; Restore previous UCS
(setvar "BLIPMODE" sblip) ; Restore saved modes
(setvar "GRIDMODE" sgrid)
(setvar "HIGHLIGHT" shl)
(setvar "UCSFOLLOW" sucsf)
(command "undo" "e" "OSMODE" "39")
(setvar "CMDECHO" scmde)
(setq *error* olderr) ; Restore old *error* handler
(princ)
)
;;; --------------------------------------------------------------------------;
(DEFUN C:GGG (/ TEM df dr) (setq olderr *error* *error* KJG)
(IF (= CD nil) (SETQ CD "DV")) (SETVAR "TEXTSTYLE" "ROMANS")
(IF (= nil (tblsearch "layer" "CH"))
(setvar "clayer" "DIM") (setvar "CLAYER" "DIM"))
(setvar "dimtad" 1)
(SETQ TEM (strcase (getstring
(STRCAT "\nDimension <DScale,REet,FSet> VV & DV <" CD ">:"))))
(SETQ CD (IF (= TEM "") CD TEM)) (load "addim")
(cond ((= CD "V")(setq dr 0)(addim "VER"))
((= CD "H")(setq dr 0)(addim "HOR")) ((= CD "DV")(setq dr 1)(addim "D"))
((= CD "VV") (addsv)) ((= CD "DS") (COMMAND "DIMSCALE"))
((= CD "B") (COMMAND "DIM1" "BAS")) ((= CD "D") (COMMAND "DIM1" "DIA"))
((= CD "G") (COMMAND "DIM1" "ANG")) ((= CD "R") (COMMAND "DIM1" "RAD"))
((= CD "RE") (PROGN (SETVAR "DIMLFAC" 1) (SETVAR "DIMSCALE"
(/ (CAR (GETVAR "LIMMAX")) 841))))
((= CD "FS") (PROGN (SETVAR "DIMSCALE" (/ (CAR (GETVAR "LIMMAX")) 841))
(setq msc (/ (car (getvar "limmax")) 841)) (SETQ psc
(GETREAL "\nDimLFAC scale of picture:")) (SETVAR "DIMLFAC" (/ psc msc)))))
(SETVAR "OSMODE" 39) (setq *error* olderr)(princ) )
;--------------------------------------------------------------------------------------
(defun c:ARR(/ arrow_error arr_chk arr_one arr_dbl arr_mrr
arr_win arr_pre arr_pnt opt old_opt olderr s
m_cmdecho m_osmode m_blipmode m_highlight m_menuctl )

(defun arrow_error (s)
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(grtext)

(setq *error* olderr)
(setvar "CMDECHO" 0)
(command "_.UNDO" "END")
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(princ)
)

(defun RTD (y)(* 180.0 (/ y pi)))

(defun arr_chk ()
(if (null (findfile "ARROW.DWG"))
(if (null (tblsearch "BLOCK" "ARROW"))
(progn
(setq m_blipmode(getvar "BLIPMODE"))(setvar "BLIPMODE" 0)
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_highlight(getvar "HIGHLIGHT"))(setvar "HIGHLIGHT" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 0)
(command "_.SOLID" "100,100" "103,100.5" "103,99.5" "" "")
(command "_.SCALE" (entlast) "" "100,100" "1/3")
(command "_.CHPROP" (entlast) "" "c" "BYLAYER" "LT" "BYLAYER" "")
(command "_.BLOCK" "ARROW" "100,100" (entlast) "")
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
)
)
)
)

(defun lc_grt1 ( clv )
(grtext -1 (strcat "Layer " (getvar "CLAYER") " " clv))
)

(defun chg_lay (object)
(cond
)
)

(defun arr_one ( / agl oldlayer)
(setq old_opt opt)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 33)
(initget "Double Mirror Point Window Zprevious")
(setq opt(getpoint "\nDouble/Mirror/Point/zoom W/Zoom p/One<insert point> : "))
(setvar "osmode" m_osmode)
(if (= (type opt) 'LIST)
(progn
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 512)
(setq agl (getangle "Angle : " opt))
(setvar "OSMODE" m_osmode)
(setq m_blipmode(getvar "BLIPMODE"))(setvar "BLIPMODE" 0)
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_highlight(getvar "HIGHLIGHT"))(setvar "HIGHLIGHT" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 0)

(command "_.INSERT" "ARROW" opt
(* (getvar "DIMSCALE")(getvar "DIMASZ")) "" (rtd agl)
"_.EXPLODE" (entlast)
)
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq opt "One")
)
)
(if (null opt)(setq opt "Double"))
)

(defun arr_dbl ( / pnt last dobj )
(setq old_opt opt)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 33)
(initget "One Mirror Point Window Zprevious")
(setq opt(getpoint "\nOne/Mirror/Point/zoom W/Zoom p/Double<insert point> : "))
(if m_osmode(setvar "OSMODE" m_osmode))
(if (= (type opt) 'LIST)
(progn
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 33)
(setq pnt (getpoint "\nNext Arrow insert point : " opt))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq m_blipmode(getvar "BLIPMODE"))(setvar "BLIPMODE" 0)
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_highlight(getvar "HIGHLIGHT"))(setvar "HIGHLIGHT" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 0)
(setq last (entlast))
(command "_.INSERT" "ARROW" opt
(* (getvar "DIMSCALE")(getvar "DIMASZ")) "" pnt
"_.EXPLODE" (entlast)
"_.INSERT" "ARROW" pnt
(* (getvar "DIMSCALE")(getvar "DIMASZ")) "" opt
"_.EXPLODE" (entlast)
)
(setq dobj (ssadd))
(while last
(setq last(entnext last))
(if last(ssadd last dobj))
)
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq opt "Double")
)
)
(if (null opt)(setq opt "Mirror"))
)

(defun arr_mrr ( / agl last dobj )
(setq old_opt opt)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 33)
(initget "Double One Point Window Zprevious")
(setq opt(getpoint "\nOne/Double/Point/zoom W/Zoom p/Mirror<insert point> : "))
(if m_osmode(setvar "OSMODE" m_osmode))
(if (= (type opt) 'LIST)
(progn
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 512)
(setq agl (getangle "Angle : " opt))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq m_blipmode(getvar "BLIPMODE"))(setvar "BLIPMODE" 0)
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_highlight(getvar "HIGHLIGHT"))(setvar "HIGHLIGHT" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 0)
(setq last (entlast))
(command "_.INSERT" "ARROW" opt
(* (getvar "DIMSCALE")(getvar "DIMASZ")) "" (rtd agl)
"_.EXPLODE" (entlast)
"_.ARRAY" (entlast) "" "P" opt "2" "360" "Y"
)
(setq dobj (ssadd))
(while last
(setq last(entnext last))
(if last(ssadd last dobj))
)
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq opt "Mirror")
)
)
(if (null opt)(setq opt "Point"))
)

(defun arr_pnt ( / )
(setq old_opt opt)
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 33)
(initget "Double Mirror One Window Zprevious")
(setq opt(getpoint "\nOne/Double/Mirror/zoom W/Zoom p/Point<insert point> : "))
(if m_osmode(setvar "OSMODE" m_osmode))
(if (= (type opt) 'LIST)
(progn
(setq m_blipmode(getvar "BLIPMODE"))(setvar "blipmode" 0)
(setq m_cmdecho(getvar "CMDECHO"))(setvar "cmdecho" 0)
(setq m_highlight(getvar "HIGHLIGHT"))(setvar "highlight" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "menuctl" 0)
(setq m_osmode(getvar "OSMODE"))(setvar "osmode" 0)
(command "_.DONUT" "0" (getvar "DIMSCALE") opt "")
;(if (null (tblsearch "LAYER" "DIMLINE"))
; (progn
; (setq oldlayer(getvar "CLAYER"))
; (command "_.LAYER" "MAKE" "DIMLINE" "COLOR" "WHITE" "DIMLINE"
; "LTYPE" "CONTINUOUS" "DIMLINE" "SET" oldlayer ""
; )
; )
;)
;(command "_.CHPROP" (entlast) "" "LAYER" "DIMLINE" "")
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq opt "Point")
)
)
(if (null opt)(setq opt "One"))
)

(defun arr_win ( / pnt1 pnt2 )
(setq m_osmode(getvar "OSMODE"))(setvar "OSMODE" 0)
(setq pnt1 (getpoint "\nFirst point : "))
(setq pnt2 (getcorner "\nOther point : " pnt1))
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(command "_.ZOOM" pnt1 pnt2)
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(setq opt old_opt)
)

(defun arr_pre ()
(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(setq m_menuctl(getvar "MENUCTL"))(setvar "MENUCTL" 0)
(command "_.ZOOM" "P")
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(setq opt old_opt)
)

;;;
;;; Main
;;;

(setq m_cmdecho(getvar "CMDECHO"))(setvar "CMDECHO" 0)
(command "_.UNDO" "GROUP")
(setvar "CMDECHO" m_cmdecho)
(setq olderr *error*
*error* arrow_error)
(setq opt "One")
(princ "\nDraw arrow, Version 0.44 (c)2000 by 666, Cradle Of Filth.")
(arr_chk)
(while opt
(if opt(lc_grt1 opt))
(cond
((= opt "Double") (arr_dbl))
((= opt "Mirror") (arr_mrr))
((= opt "One") (arr_one))
((= opt "Point") (arr_pnt))
((= opt "Window") (arr_win))
((= opt "Zprevious") (arr_pre))
)
)
(if m_blipmode(setvar "BLIPMODE" m_blipmode))
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(if m_highlight(setvar "HIGHLIGHT" m_highlight))
(if m_menuctl(setvar "MENUCTL" m_menuctl))
(if m_osmode(setvar "OSMODE" m_osmode))
(grtext)
(setq *error* olderr)
(setvar "CMDECHO" 0)
(command "_.UNDO" "END")
(if m_cmdecho(setvar "CMDECHO" m_cmdecho))
(princ)
)
(princ " ARROW loaded.")
(princ)

(defun c:xd (/ a b c no en na new old)
(setq olderr *error*
*error* kimhk
)
(setvar "cmdecho" 0)
(prompt "[Text Delete...]")
(setq a (ssget)
b (sslength a)
c 0
no 0
)
(repeat b
(setq en (entget (ssname a c))
c (1+ c)
na (cdr (assoc 0 en))
)
(if (= na "TEXT")
(progn
(setq new "")
(setq old (assoc 1 en)
ne (cons (car old) new)
en (subst ne old en)
)
(entmod en)
(setq no (1+ no))
)
)
)
(prompt "changed < ")
(princ no)
(prompt " > Text line")
(setvar "cmdecho" 1)
(setq *error* olderr)
(princ)
);defun

(defun c:xm () (setq olderr *error* *error* KJG)
(prompt "[Text Move...]")
(while (setq mov (ssget '((0 . "text"))))
(if (/= mov nil) (progn (setq ppt (getpoint "\nBase point:"))
(command "MOVE" mov "" ppt pause ))))
(setq *error* olderr)(SETVAR "OSMODE" 37)(princ))
(defun c:xc (/ cop)
(prompt "[Text Copy...]")
(setq COP (ssget '((0 . "text"))))
(if (/= cop nil)
(command "COPY" COP "" "m"))
(SETVAR "OSMODE" 37)(princ))

;-----------------------------------------------------------------
(defun modes (a)
(setq mlst '())
(repeat (length a)
(setq mlst (append mlst (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
)


(defun moder ()
(repeat (length mlst)
(setvar (caar mlst) (cadar mlst))
(setq mlst (cdr mlst))
)
)


(defun layset (name color)
(if (/= (strcase name) clayer)
(if (tblsearch "layer" name)
(command "layer" "set" name "")
(command "layer" "make" name "color" color name "")
)
)
)


(defun omit_err (st) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= st "Function cancelled")
(princ (strcat "\nError: " st))
)
(moder) ; Restore modified modes
(command "layer" "set" clayer "")
(setq *error* olderr) ; Restore old *error* handler
(princ)
)


(defun draw_P()
(command "pline" sp "arc" "second"
(setq sp (polar (polar sp ai (/ r 2)) ap (* 0.134 r))) ep
"second" (setq sp (polar sp ai r)) (polar ep ai r)
"second" (polar sp (+ ap pi) (* 0.134 r 2)) ep nil
)
)


(defun draw_S()
(command "pline" (polar (polar sp ap (* 0.3 exe)) (+ ai pi) (* 0.6 exe))
"arc" "second" sp (polar sp ai (* 0.3 r))
"second" ep (polar (polar ep ai (* 0.6 exe)) (+ ap pi) (* 0.3 exe))
nil
)
)



(defun draw_Z()
(command "pline"
(polar sp (+ ai pi) exe)
(setq tmp (polar sp ai (* 0.5 (- r zsz))))
(polar (polar tmp (+ ap pi) zsz) ai (* 0.25 zsz))
(polar (polar tmp ap zsz) ai (* 0.75 zsz))
(polar tmp ai zsz)
(polar ep ai exe) nil
)
)


;============================================================================
; Main Routine
;============================================================================
(defun c:ta()

;---------------------------------------
; STEP 001 - initialize configurations
;---------------------------------------
(setq olderr *error*)
(setq *error* omit_err)
(setq clayer (getvar "clayer"))
(modes '("blipmode" "cmdecho" "osmode"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(layset "CH" 2)
(if cutzsz nil (setq cutzsz 2))
(if cutexe nil (setq cutexe 1.2))
(setq fa (getvar "dimscale")
zsz (* cutzsz fa)
exe (* cutexe fa)
)


;-------------------------------------
; STEP 002 - Getting user input data
;-------------------------------------
(initget "Pipe Zomit Somit Auto")
(setq code (getkword "\nPipe/Zomit/Somit/<Auto>: "))
(if code nil (setq code "Auto"))

(setvar "osmode" 1)
(initget 1)
(setvar "lastpoint" (setq sp (getpoint "\Pick first point: ")))

(if (= code "Pipe") (setvar "osmode" 128))
(initget 33)
(setq ep (getpoint (if (= code "Pipe")
"\nPick second point on the pipe center line: "
"\nPick second point: ") sp)
)
(setvar "osmode" 0)


;-------------------------------------------
; STEP 003 - Check code and draw omit mark
;-------------------------------------------
(setq ai (angle sp ep)
ap (+ ai (* 0.5 pi))
r (distance sp ep)
)

(cond
((= code "Auto")
(if (< r (* 1.5 zsz)) (draw_S) (draw_Z))
)
((= code "Pipe") (draw_P))
((= code "Somit") (draw_S))
(t (draw_Z))
)


;------------------------------------
; STEP 004 - restore modified modes
;------------------------------------
(moder)
(command "layer" "set" clayer "")
(setq *error* olderr)
(princ)
)
;****************************************************************************
(defun cloud (sp ep
/ ang am len ea dist dist1 dist2 05dist1 05dist2 p3 p4 p5 p6 p7
)
(setq ang (angle sp ep)
am (+ ang (angle (list 0.0 0.0 0.0) (list 0.0 -1.0 0.0)))
len (distance sp ep)
ea (fix (+ remaind (/ len units )))
)
(if (zerop ea) (setq ea 1))
(setq dist (/ len ea)
dist1 (* divide dist) 05dist1 (* 0.5 dist1)
dist2 (- dist dist1) 05dist2 (* 0.5 dist2)
p3 sp
)
(repeat ea
(setq p4 (polar (polar p3 ang 05dist1) am (* bulge 05dist1))
p5 (polar p3 ang dist1)
p6 (polar (polar p5 ang 05dist2) am (* bulge 05dist2))
p7 (polar p5 ang dist2)
)
(command "s" p4 p5 "s" p6 (setq p3 p7))

)
)
(defun c:rev ( / units bulge divide remaind sp pts ip ai p1 p2 p3 ang sub i) ;Revision mark
(command "layer" "s" "ch" "")
(setvar "osmode" 0)
(setq fa (getvar "dimscale"))
(setq units (* fa 15.0)
bulge 0.6
divide 0.4
remaind 0.5
)
(if (setq sp (getpoint "\nFirst point: "))
(progn
(setq pts (list sp) ip sp)
(while ip
(initget 32 (if (<= 3 (length pts)) "Close Undo" "Undo"))
(setq ip (getpoint "\nTo point: " ip))
(cond ((null ip)) ;pts -> min 1 ea
((= ip "Undo") (setq ip (cadr pts))
(if ip (grdraw ip (car pts) 0))
(setq pts (cdr pts))
)
((= ip "Close") (grdraw (car pts) sp 7)
(setq pts (cons sp pts) ip nil)
)
(t (grdraw ip (car pts) 7)
(setq pts (cons ip pts))
)
)
)
(setq ai 0)
(repeat (- (length pts) 2)
(setq p1 (car pts)
p2 (cadr pts)
p3 (caddr pts)
ap (+ (angle (list 0.0 0.0 0.0) (list 0.0 1.0 0.0)) (angle p1 p2))
)
(command "ucs" "3p" p1 p2 (polar p1 ap 1))
(setq ang (angle (trans p2 0 1) (trans p3 0 1))
sub (- ang pi)
ai (+ ai (if (< 0 sub) (- sub) ang))
)
(command "ucs" "")
)
(if (> 0 ai) (setq pts (reverse pts)))
(command "pline" (car pts) "a")
(setq i -1)
(repeat (1- (length pts))
(cloud (nth (setq i (1+ i)) pts) (nth (1+ i) pts))
)
(command "" )
(setq i -1)
(repeat (1- (length pts))
(grdraw (nth (1+ i) pts) (nth (+ i 2) pts) 0)
(setq i (1+ i))
)
)
)
(setvar "attdia" 0)
(command "insert" "revmark" "r" 0 "x" fa "y" fa )
(setvar "osmode" 39)
(princ)
)
;========================================================
(defun c:Ac( / b1 b2 b3 b4 tot pot total)
(setvar "CMDECHO" 0)
(setq n 0 t 1
ss (ssget)
en (sslength ss)
)
(while (< n en)
(setq ename (ssname ss n)
elist (entget ename)
no (atof (cdr (assoc 1 elist) ) )
sum (* t no)
t sum
n (+ n 1)
)
)
(setq pot (getint "Decimal point <0 to 8> : ")
total (rtos t 2 pot))
(prompt (strcat "\nTotal = " total )) (terpri)
(setq tot (entsel "Pick a change on target text"))(terpri)
(setq b1 (entget (car tot)))
(setq b2 (assoc 1 b1))
(setq b3 (cons (car b2) total))
(setq b4 (subst b3 b2 b1))
(entmod b4) (princ)
)
;----------------------------------------------------------
(defun remode ()
(grtext -1 (cond ((minusp mode) (setq mode 0 sign "+") "Addition mode")
(t (setq mode -1 sign "-") "Subtraction mode")
)
)
(redraw en2 4)
)
(defun calerr (s / i)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(if enss (delight))
(if en1 (redraw en1 4))
(grtext)
(setq *error* olderr)
(princ)
)
(defun istext (edata) (= "TEXT" (cdr (assoc 0 edata))))
(defun dxf (code edata) (cdr (assoc code edata)))
(defun bymode (arg1 arg2) (if (minusp mode) arg1 arg2))
(defun delight()
(setq i -1)
(repeat (length enss)
(redraw (nth (setq i (1+ i)) enss) 4)
)
)
(defun c:aac ( / en1 ed1 en3 1str 1num mode chk tmp sub enss
en2 ed2 ed3 2str 2num sign old tmpstr modstr
)
(setq olderr *error
*error* calerr
chk t
)
(while chk
(if (setq en1 (entsel "\nSelect first number: "))
(progn
(setq ed1 (entget (setq en1 (car en1))))
(redraw en1 3)
(if (istext ed1)
(setq 1num (atof (setq 1str (dxf 1 ed1))) chk nil)
(progn
(princ "\nNot a text. ")
(redraw en1 4)
)
)
)
(princ "\nNot selected. ")
)
)
(if calmode
(setq mode 0 sign "+" modstr "Addition ")
(setq mode -1 sign "-" modstr "Subtraction ")
)
(princ (strcat "\n" 1str sign))
(grtext -1 (strcat modstr "mode"))
(setq chk t)
(while chk
(if (setq en2
(entsel (strcat "\nSelect number to " (bymode "subtract: " "add: "))))
(progn
(setq ed2 (entget (setq en2 (car en2))))
(redraw en2 3)
(if (istext ed2)
(setq tmp (atof (setq tmpstr (dxf 1 ed2)))
2num (if 2num
(+ 2num (bymode (- tmp) tmp))
(bymode (- tmp) tmp)
)
2str (if 2str
(strcat 2str (bymode "-" "+") tmpstr)
tmpstr
)
enss (append enss (list en2))
)
(remode)
)
(princ (strcat "\n" 1str sign (if 2str (strcat 2str sign) "")))
)
(setq chk nil)
)
)
(if 2num
(progn
(setq sub (rtos (+ 1num 2num) 2 4) chk t)
(princ (strcat "\n\n" 1str sign 2str " = " sub))
(while chk
(if (setq en3 (entsel "\nSelect a text to modify: "))
(if (istext (setq ed3 (entget (car en3))))
(setq chk nil)
(princ "\nNot a text. ")
)
(princ "\nNot selected. ")
)
)
(entmod (subst (cons 1 sub) (assoc 1 ed3) ed3))
(delight)
)
)
(redraw en1 4)
(grtext)
(setq *error* olderr)
(princ)
)
;===============================================================

(defun C:TC (/ p j n e os as ns st s nsl osl sl si chf chm olderr)
(setq olderr *error*
*error* chgterr
chm 0)
(setq p (ssget))
(if p (progn
(while (= 0 (setq osl (strlen (setq os (getstring t "\nOld string: "))))) (princ "Null input invalid")
)
(setq nsl (strlen (setq ns (getstring t "\nNew string: "))))
(setq j 0 n (sslength p))
(while (< j n)
(if (= "TEXT"
(cdr (assoc 0 (setq e (entget (ssname p j)))))) (progn
(setq chf nil si 1)
(setq s (cdr (setq as (assoc 1 e))))
(while (= osl (setq sl (strlen
(setq st (substr s si osl)))))
(if (= st os)
(progn
(setq s (strcat (substr s 1 (1- si)) ns
(substr s (+ si osl))))
(setq chf t)
(setq si (+ si nsl))
)
(setq si (1+ si))
)
)
(if chf (progn
(setq e (subst (cons 1 s) as e))
(entmod e)
(setq chm (1+ chm))
))
)
)
(setq j (1+ j))
)
))
(princ "changed")
(princ chm)
(princ "text lines.")
(terpri)
(setq *error* olderr)
(princ)
)
;***********************************************************************
(defun C:BB (/ a b)
(graphscr)
(setvar "cmdecho" 0)
(setq a (entsel))
(setq b (getpoint " Pick break cross point : ")) (terpri)
(command "break" a "f" b "@")
)
(defun c:mb (/ p1 p2 s1 s2 n olderr )
(setq olderr *error*
*error* chgterr)
(graphscr)
(setq s1 nil
p1 nil
p2 nil)
(while (= nil s1)
(setq s1 (ssget))
(if (= s1 nil)
(princ "No object found.")
)
)
(setq no 0)
(setq n (sslength s1))
(repeat n
(setq s2 (ssname s1 no))
(redraw s2 3)
(setq no (1+ no))
)
(while (= nil p1)
(setq p1 (getpoint "\nEnter first point:"))
)
(while (= nil p2)
(setq p2 (getpoint "\nEnter second point:"))
)
(setvar "CMDECHO" 0)
(setq no 0)
(repeat n
(setq s2 (ssname s1 no))
(setq p3 (cdr (assoc 10 (entget s2))))
(setq s3 (list s2 p3))
(command "BREAK" s3 "F" p1 p2)
(setq no (1+ no))
)
(setvar "CMDECHO" 1)

(setq *error* olderr)
(princ)
)
(defun e_on ()
(setvar "cmdecho" 1)
)
(defun e_off ()
(setvar "cmdecho" 0)
)
(defun c:ho() ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; move offset
(e_off)
(setq m:err *error* *error* berror)
(if hdst (progn (setq hvstr(rtos hdst)
hprompt(strcat "Offset distance<" hvstr ">: "))
)
(setq hprompt "Offset distance<Move Offset>: ")
)
(setq hd(getdist hprompt))
(if hd(setq hdst hd))
(setq s1(entsel))
(while s1
(setq h(/ hdst 1.0))
(command "offset" h s1 pause "")
(entdel (car s1))
(setq s1(entsel))
)
(e_on)(princ))

(defun c:oo() ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; half offset
(e_off)
(setq m:err *error* *error* berror)
(if hdst (progn (setq hvstr(rtos hdst)
hprompt(strcat "Offset distance<" hvstr ">: "))
)
(setq hprompt "Offset distance: ")
)
(setq hd(getdist hprompt))
(if hd(setq hdst hd))
(setq s1(entsel))
(while s1
(setq h(/ hdst 2.0))
(command "offset" h s1 pause "")
(setq s1(entsel))
)
(e_on)(princ))

(defun c:mo () ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; multcopy
(e_off)
(setq m:err *error* *error* berror)
(setq ss(ssget)
osmod(getvar "osmode")
s 0)
(if ss (progn
(setq ang(getangle "Angle<0>: "))
(if (not ang) (setq ang 0))
(setq dist(getdist "Distance:"))
(while dist
(setvar "osmode" 0)
(setq s (+ s dist))
(setq a (angtos ang)
d (rtos s)
sec(strcat "@" d "<" a))
(command "copy" ss "" "0,0" sec)
(setq dist(getdist "Distance: "))
)
)
)
(setvar "osmode" osmod)
(e_on)
(princ)
)

(defun c:ca (/ a b b1 b2 c d index n ts z)
(setq a (ssget))
(setq z (getstring "Change of Height/Width: "))
(if (= "H" z)
(progn
(setq ts (getreal "Enter new text size: "))
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (+ index 1))
(setq b (assoc 0 b1))
(if (= "TEXT" (cdr b))
(progn
(setq c (assoc 40 b1))
(setq d (cons (car c) ts))
(setq b2 (subst d c b1))
(entmod b2)
)
)
)
)
)
(if (= "W" z)
(progn
(setq ts (getreal "Enter new text size: "))
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (+ index 1))
(setq b (assoc 0 b1))
(if (= "TEXT" (cdr b))
(progn
(setq c (assoc 41 b1))
(setq d (cons (car c) ts))
(setq b2 (subst d c b1))
(entmod b2)
)
)
)
)
)
)
;********************************************************************
(defun C:cv(/ e0 e1 nco n0 e)
(setvar "cmdecho" 0)
(prompt "\nSelect Entites To Change: ")
(setq e0 (ssget))
(prompt "\nTo What Entity: ")
(setq e1 (entsel))
(setq nco (cdr (assoc 8 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "la" nco "")
(setq n0 (+ 1 n0))
)
(setq nco (cdr (assoc 62 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "c" nco "")
(setq n0 (+ 1 n0))
)
(setq nco (cdr (assoc 6 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "lt" nco "")
(setq n0 (+ 1 n0))
)
(setvar "cmdecho" 1)
(prin 1)
)
;******************************************************************
(defun C:cx(/ e0 e1 nco n0 e)
(setvar "cmdecho" 0)
(prompt "\n바꿀 선을 택하시오: ")
(setq e0 (ssget))
(prompt "\n바꾸고자 하는 선을 찍으면 그것으로 변할 것이요: ")
(setq e1 (entsel))
(setq nco (cdr (assoc 8 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "la" nco "")
(setq n0 (+ 1 n0))
)
(setq nco (cdr (assoc 62 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "c" nco "")
(setq n0 (+ 1 n0))
)
(setq nco (cdr (assoc 6 (entget (car e1)))))
(if (null nco) (setq nco "bylayer"))
(setq n0 0)
(while
(setq e (ssname e0 n0))
(command "change" e "" "p" "lt" nco "")
(setq n0 (+ 1 n0))
)
(setvar "cmdecho" 1)
(prin 1)
)
;**************************************************************
(defun c:pol (/ p1 p2 p3 t1 t2 t3 t4 pt1 pt2)
(graphscr)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\nFirst Point: "))
(setq p2 (getpoint "\nEnd Point: "))
(setq t1 (car p1) t2 (car p2) t3 (cadr p1) t4 (cadr p2))
(setq pt1 (/ (+ t1 t2) 2) pt2 (/ (+ t3 t4) 2))
(setq p3 (list pt1 pt2))
(command "arc" p1 "e" p3 "a" 90)
(command "arc" p3 "e" p2 "a" 90)
(command "arc" p2 "e" p3 "a" 90)
(setvar "cmdecho" 1)
)

;***************************************************************
(defun c:TT(/ ce ss ls no p1 p2)
(setvar "cmdecho" 0)
(prompt "\nSelect cutting edge")
(setq ce (ssget))
(prompt "\nSelect objects to trim:")
(setq p1 (getpoint "first point"))
(setq p2 (getcorner p1 "2nd point"))
(setq ss (ssget "c" p1 p2)
ls (sslength ss)
no -1
)
(command "trim" ce "")
(repeat ls
(setq no (+ 1 no))
(command (list (ssname ss no) p2))
)
(command "")
(command "redraw")
(setvar "cmdecho" 1)
(prin1)
)
;******************************************************************
(defun c:EE(/ ce ss ls no p1 p2)
(setvar "cmdecho" 0)
(prompt "\nSelect cutting edge")
(setq ce (ssget))
(prompt "\nSelect objects to trim:")
(setq p1 (getpoint "first point"))
(setq p2 (getcorner p1 "2nd point"))
(setq ss (ssget "c" p1 p2)
ls (sslength ss)
no -1
)
(command "extend" ce "")
(repeat ls
(setq no (+ 1 no))
(command (list (ssname ss no) p2))
)
(command "")
(setvar "cmdecho" 1)
(prin1)
)
;*************************************************************
(defun c:add (/ ent ct anx snum slen e ee x ol nl ent2)
(command "layer" "n" "addnum" "")
(prompt "\nPick numbers to add:")
(setq ent (ssget))
(setq ct 0 anx 0 an 0)
(setq snum (ssname ent ct))
(setq slen (sslength ent))
(while (<= (1+ ct) slen)
(setq snum (ssname ent ct))
(setq e (entget snum))
(setq ee (cdr (assoc 1 e)))
(setq x (atof ee))
(setq ol (assoc 8 e))
(setq nl (cons 8 "addnum"))
(setq ent2 (subst nl ol e))
(entmod ent2)
(setq anx (+ an x))
(setq an anx)
(setq ct (1+ ct))
)
(princ "\ntotal = ")
(princ (rtos anx 2 4))(princ)
)


;*******************************************************************
(defun c:MA (/ cpoint spoint answer)
(setvar "cmdecho" 0)
(setq answer "Y")
(setq cpoint(getpoint "\nPick Center Point => "))
(ssget)
(while (= answer "Y")
(prompt "\nPick base point => ")
(setq spoint(getpoint))
(prompt "\nType Angle or Pick point ? ")
(menucmd "s=x")(menucmd "s=")(command "copy" "p" "" cpoint cpoint)
(menucmd "s=x")(menucmd "s=")(command "Rotate" "p" "" cpoint "r" cpoint spoint pause)
(menucmd "s=x")(menucmd "s=")(command "'redraw" "")
)
)
;***************************************************************
(defun c:hb()
(setq a(getdist "HBEAM size:"))(terpri)
(setq b(getdist "HBEAM SUB SIZE:"))(terpri)
(setq t1(getdist "t1:"))
(setq t2(getdist "t2:"))
(setq st1(getpoint "insert point:"))
(setq mp(list (car st1) (- (cadr st1) (/ a 2))))
(setq pt1(list (+ (car mp) (/ b 2)) (cadr mp)))
(setq pt2(list (car pt1) (+ (cadr pt1) t2)))
(setq pt3(list (+ (car mp) (+ (/ t1 2) t2)) (cadr pt2)))
(setq pt4(list (- (car pt3) T2) (+ (cadr pt3) t2)))
(setq pt5(list (car pt4) (+ (cadr pt4) (- a (* t2 4)))))
(setq pt6(list (+ (car pt5) t2) (+ (cadr pt5) t2)))
(setq pt7(list (car pt1) (cadr pt6)))
(setq pt8(list (car pt1) (+ (cadr pt7) t2)))
(setq pt9(list (car mp) (cadr pt8)))
(setq mirr1(list (+ (car mp) 1) (+ (cadr pt9) 3)))
(setq mirr2(list (+ (car mp) (* b 2)) (- (cadr mp) 3)))
(setq cen1(list (car mp) (+ (cadr pt9) 4)))
(setq cen2(list (car mp) (- (cadr MP) 4)))
(setq rpt1(list (car pt3) (cadr pt4)))
(setq rpt2(list (car pt6) (cadr pt5)))
(setq rotate1(list (+ (car pt8) 3) (+ (cadr pt8) 5)))
(setq rotate2(list (- (car mp) (+ (/ b 2) 3)) (- (cadr mp) 5)))
(command "osnap" "non")
(command "line" mp pt1 pt2 pt3 "")
(command "line" pt4 pt5 "")
(command "line" pt6 pt7 pt8 pt9 "")
(command "arc" "c" rpt1 pt4 pt3 "")
(command "arc" "c" rpt2 pt6 pt5 "")
(command "mirror" "W" ROTATE1 ROTATE2 "" cen1 cen2 "")
(command "LINE" cen1 cen2 "" (command "osnap" "int,endp,mid,quad"))
(command "change" cen1 "" "p" "la" "cen2" "" "")
(command "rotate" "w" rotate1 rotate2 "" st1)
)
;**********************************************************************
;(defun c:chan()
;; (setvar "osmode" 0)
;; (setq key1 (getvar "osmode))
;; (setq key2 (getvar "fillet"))
; (setq a(getdist "chan size:"))(terpri)
; (setq b(getdist "channel SUB SIZE:"))(terpri)
; (setq t1(getdist "t1:"))
; (setq t2(getdist "t2:"))
; (setq r(/ (* t2 2) 3))
; (setq pt1(getpoint "insert point:"))(terpri)
; (setq pt2(list (+ (car pt1) b) (cadr pt1)))
; (setq pt3(list (car pt2) (+ (cadr pt2) (/ t2 2))))
; (setq pt4(list (- (car pt2) (/ b 2)) (+ (cadr pt2) t2)))
; (setq pt5(polar pt4 (dtr -5) (* t2 2)))
; (setq pt6(polar pt4 (dtr 175) (* t2 2)))
; (setq md(list (car pt1) (+ (cadr pt1) (/ a 2))))
; (setq md1(list (+ (car md) t1) (cadr md)))
; (setq pt7(list (car md1) (- (cadr md1) (* t2 2))))
; (setq r1 (list (car pt1) (+ (cadr pt1) a)))
; (command "osnap" "non")
; (command "line" md pt1 pt2 pt3 "")
; (command "line" pt5 pt6 "")
; (command "line" pt7 md1 "")
; (command "fillet" "r" r "")
; (command "fillet" "r" pt3 pt5 "")
; (command "fillet" "r" t2 "")
; (command "fillet" pt6 pt7 "")
; (command "osnap" "int,endp,mid,quad")
; (command "mirror" "W" md pt2 "" md md1 "")
; (command "rotate" "w" r1 pt2 "" pt1 "")
;)
(defun c:chan()
(setq a(getdist "CHANNEL size:"))(terpri)
(setq b(getdist "channel SUB SIZE:"))(terpri)
(setq t1(getdist "t1:"))
(setq t2(getdist "t2:"))
(setq r(/ (* t2 2) 3))
(setq pt1(getpoint "insert point:"))(terpri)
(setq pt2(list (+ (car pt1) b) (cadr pt1)))
(setq pt3(list (car pt2) (+ (cadr pt2) (/ t2 2))))
(setq pt4(list (- (car pt2) (/ b 2)) (+ (cadr pt2) t2)))
(setq pt5(polar pt4 (dtr -5) (* t2 2)))
(setq pt6(polar pt4 (dtr 175) (* t2 2)))
(setq md(list (car pt1) (+ (cadr pt1) (/ a 2))))
(setq md1(list (+ (car md) t1) (cadr md)))
(setq pt7(list (car md1) (- (cadr md1) (* t2 2))))
(setq r1 (list (car pt1) (+ (cadr pt1) a)))
(command "osnap" "none")
(command "line" md pt1 pt2 pt3 "")
(command "line" pt5 pt6 "")
(command "line" pt7 md1 "")
(command "fillet" "r" r "")
(command "fillet" pt3 pt5 "")
(command "fillet" "r" t2 "")
(command "fillet" pt6 pt7 "")
(command "osnap" "end,int,qua")
(command "mirror" "W" md pt2 "" md md1 "")
(command "rotate" "w" r1 pt2 "" pt1 "")
)
;***************************************************
(defun c:ang()
(setq a(getdist "angle size:"))(terpri)
(setq b(getdist "angle T:"))(terpri)
(setq pt1(getpoint "insert point:"))(terpri)
(setq pt2(list (+ (car pt1) a) (cadr pt1)))
(setq pt3(list (- (car pt2) b) (+ (cadr pt2) b)))
(setq pt4(list (+ (car pt1) (* b 2)) (cadr pt3)))
(setq pt5(list (- (car pt4) b) (+ (cadr pt4) b)))
(setq pt6(list (car pt5) (+ (cadr pt1) (- a b))))
(setq pt7(list (- (car pt6) b) (+ (cadr pt6) b)))
(setq rpt1(list (car pt3) (cadr pt2)))
(setq rpt2(list (car pt4) (cadr pt5)))
(setq rpt3(list (car pt7) (cadr pt6)))
(COMMAND "OSNAP" "NON")
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(command "line" pt5 pt6 "")
(command "line" pt7 pt1 "")
(command "arc" "c" rpt1 pt2 pt3 "")
(command "arc" "c" rpt2 pt5 pt4 "")
(command "arc" "c" rpt3 pt6 pt7 "")
(command "osnap" "int,endp,mid,quad")
(command "rotate" "w" pt2 pt7 "" pt1)
)
;**********************************************
(defun c:ang2()
(setq a (getdist "angle size:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- a b))
(setq pt1 (getpoint "start point:"))
(setq pt2 (getpoint pt1 "to point:"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) a))
(setq pt4 (polar pt3 (+ ang pi) len))
(setq pt5 (polar pt4 (+ ang (dtr 270)) c))
(setq pt6 (polar pt5 ang len))
;
(setq hid1 (polar pt6 (+ ang pi) 10))
(command "layer" "make" "0" "")
(command "line" pt1 pt2 pt3 pt4 "c" "")
(command "line" pt5 pt6 "")
)



;**************************************************************
(defun c:ang3()
(setq a (getdist "angle size:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- a b))
(setq pt1 (getpoint "start point:"))
(setq pt2 (getpoint pt1 "to point:"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) a))
(setq pt4 (polar pt3 (+ ang pi) len))
(setq pt5 (polar pt4 (+ ang (dtr 270)) c))
(setq pt6 (polar pt5 ang len))
;
(setq hid1 (polar pt6 (+ ang pi) 10))
(command "line" pt1 pt2 pt3 pt4 "c" "")
(command "linetype" "set" "hidden" "")
(command "line" pt5 pt6 "")
(command "linetype" "set" "bylayer" "")
)




;***************************************************************
(defun c:ang4()
(setq a (getdist "angle size:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- a b))
(SETQ SIZE (GETREAL "SIZE100 IF 1:"))
(setq se1 (getpoint "start point:"))
(setq se2 (getpoint se1 "to point:"))
(if (= SIZE 1) (setq x (- (/ a 2) 5)) (setq x(/ (- a 5) 2)))
(setq pt1 (list (+ (car se1) 30) (- (cadr se1) (- a x))))
(setq ang (angle se1 se2))
(setq len (distance se1 se2))
(SETQ P1(POLAR SE1 ANG 30))
(SETQ PT1 (POLAR P1 (- ANG (DTR 90)) (- A X)))
(setq pt2 (polar pt1 ang (- len 60)))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) a))
(setq pt4 (polar pt3 (+ ang pi) (- len 60)))
(setq pt5 (polar pt4 (+ ang (dtr 270)) c))
(setq pt6 (polar pt5 ang (- len 60)))
;
(setq hid1 (polar pt6 (+ ang pi) 20))
(command "linetype" "set" "center" "")
(command "line" se1 se2 "")
(command "linetype" "set" "bylayer" "")
(command "line" pt1 pt2 pt3 pt4 "c" "")
(command "line" pt5 pt6 "")
)



;***************************************************************
(defun c:ang5()
(setq a (getdist "angle size:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- a b))
(SETQ SIZE (GETREAL "SIZE100 IF 1:"))
(setq se1 (getpoint "start point:"))
(setq se2 (getpoint se1 "to point:"))
(if (= SIZE 1) (setq x (- (/ a 2) 5)) (setq x(/ (- a 5) 2)))
(setq pt1 (list (+ (car se1) 30) (- (cadr se1) (- a x))))
(setq ang (angle se1 se2))
(setq len (distance se1 se2))
(SETQ P1(POLAR SE1 ANG 30))
(SETQ PT1 (POLAR P1 (- ANG (DTR 90)) (- A X)))
(setq pt2 (polar pt1 ang (- len 60)))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) a))
(setq pt4 (polar pt3 (+ ang pi) (- len 60)))
(setq pt5 (polar pt4 (+ ang (dtr 270)) c))
(setq pt6 (polar pt5 ang (- len 60)))
;
(setq hid1 (polar pt6 (+ ang pi) 20))
(command "layer" "make" "0" "")
(command "line" se1 se2 "")
(command "layer" "make" "0" "")
(command "line" pt1 pt2 pt3 pt4 "c" "")
(COMMAND "LAYER" "MAKE" "0" "")
(command "line" pt5 pt6 "")
(COMMAND "LAYER" "MAKE" "0" "")
)

;**********************************************************
(defun c:chan1()
(setq a(getdist "chan size:"))(terpri)
(setq b(getdist "channel SUB SIZE:"))(terpri)
(setq t1(getdist "t1:"))
(setq t2(getdist "t2:"))
(setq r(/ (* t2 2) 3))
(setq pt1(getpoint "insert point:"))(terpri)
(setq pt2(list (+ (car pt1) b) (cadr pt1)))
(setq pt3(list (car pt2) (+ (cadr pt2) (/ t2 2))))
(setq pt4(list (- (car pt2) (/ b 2)) (+ (cadr pt2) t2)))
(setq pt5(polar pt4 (dtr -5) (* t2 2)))
(setq pt6(polar pt4 (dtr 175) (* t2 2)))
(setq md(list (car pt1) (+ (cadr pt1) (/ a 2))))
(setq md1(list (+ (car md) t1) (cadr md)))
(setq pt7(list (car md1) (- (cadr md1) (* t2 2))))
(setq r1 (list (car pt1) (+ (cadr pt1) a)))
(command "line" md pt1 pt2 pt3 "")
(command "line" pt5 pt6 "")
(command "line" pt7 md1 "")
(command "fillet" "r" r "")
(command "fillet" pt3 pt5 "")
(command "fillet" "r" t2 "")
(command "fillet" pt6 pt7 "")
(command "mirror" "W" md pt2 "" md md1 "")
(command "rotate" "w" r1 pt2 "" pt1 "")
)

;*******************************************************
(defun c:chan2()
(setq a (getdist "length:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- (/ a 2) b))
(setq pt1 (getpoint "start point:"))
(setq pt2 (getpoint pt1 "to point:"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) (/ a 2)))
(setq pt4 (polar pt3 (+ ang pi) len))
(setq pt5 (polar pt4 (+ ang (dtr 270)) a))
(setq pt6 (polar pt5 ang len))
;
(setq pt7 (polar pt2 (+ ang (* pi 0.5)) c))
(setq pt8 (polar pt7 (+ ang pi) len))
(setq pt9 (polar pt8 (+ ang (dtr 270)) (* c 2)))
(setq pt10 (polar pt9 ang len))
;
(setq cen1 (polar pt1 (+ ang pi) 10))
(setq cen2 (polar pt2 ang 10))
(command "layer" "make" "0" "")
(command "line" cen1 cen2 "")
(command "layer" "make" "con" "")
(command "line" pt2 pt3 pt4 pt5 pt6 pt2 "")
(command "line" pt7 pt8 "")
(command "line" pt9 pt10 "")
)
;************************************************************
(defun c:chan3()
(setq a (getdist "length:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- (/ a 2) b))
(setq pt1 (getpoint "start point:"))
(setq pt2 (getpoint pt1 "to point:"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) (/ a 2)))
(setq pt4 (polar pt3 (+ ang pi) len))
(setq pt5 (polar pt4 (+ ang (dtr 270)) a))
(setq pt6 (polar pt5 ang len))
;
(setq pt7 (polar pt2 (+ ang (* pi 0.5)) c))
(setq pt8 (polar pt7 (+ ang pi) len))
(setq pt9 (polar pt8 (+ ang (dtr 270)) (* c 2)))
(setq pt10 (polar pt9 ang len))
;
(setq cen1 (polar pt1 (+ ang pi) 10))
(setq cen2 (polar pt2 ang 10))
;
(setq hid1 (polar pt7 (+ ang pi) 10))
(setq hid2 (polar pt9 ang 10))
(command "layer" "make" "0" "")
(command "line" cen1 cen2 "")
(command "layer" "make" "0" "")
(command "line" pt2 pt3 pt4 pt5 pt6 pt2 "")
(command "layer" "make" "0" "")
(command "line" pt7 pt8 "")
(command "line" pt9 pt10 "")
(command "layer" "make" "0" "")
)
;************************************************
(defun c:chan4()
(setq a (getdist "angle size:"))(terpri)
(setq b (getdist "T:"))(terpri)
(setq c (- a b))
(setq pt1 (getpoint "start point:"))
(setq pt2 (getpoint pt1 "to point:"))
(setq ang (angle pt1 pt2))
(setq len (distance pt1 pt2))
(setq pt3 (polar pt2 (+ ang (* pi 0.5)) a))
(setq pt4 (polar pt3 (+ ang pi) len))
(setq pt5 (polar pt4 (+ ang (dtr 270)) c))
(setq pt6 (polar pt5 ang len))
;
(setq hid1 (polar pt6 (+ ang pi) 10))
(command "line" pt1 pt2 pt3 pt4 "c" "")
(command "layer" "make" "0" "")
(command "line" pt5 pt6 "")
(command "layer" "make" "0" "")
)
;*******************************************************
(defun c:speed( / chk time1 time2 time3 ccc cnt spp sum
p1 p2 p3 p4 emax emin lmax lmin umax umin
ttx tty cpx cpy cpp cpq t1 t2 dd
)

(setq ocmd (getvar "cmdecho"))
(setvar "cmdecho" 0)

(setq emax (getvar "extmax")
emin (getvar "extmin")
lmax (getvar "limmax")
lmin (getvar "limmin")
)
(if (> (car emax) (car lmax)) (setq umax emax) (setq umax lmax))
(if (< (car emin) (car lmin)) (setq umin emin) (setq umin lmin))

(setq ttx (/ (- (car umax) (car umin)) 100)
tty (/ (- (cadr umax) (cadr umin)) 100)
p1 (list (+ (car umin)(* ttx 10)) (+ (cadr umin)(* tty 10)) )
p2 (list (+ (car umin)(* ttx 10)) (- (cadr umax)(* tty 10)) )
p3 (list (- (car umax)(* ttx 10)) (- (cadr umax)(* tty 10)) )
p4 (list (- (car umax)(* ttx 10)) (+ (cadr umin)(* tty 10)) )
dd (/ (- (cadr p2) (cadr p1)) 10)
)

(grdraw p1 p2 7 0)
(grdraw p2 p3 7 0)
(grdraw p3 p4 7 0)
(grdraw p4 p1 7 0)

(setq cnt 0)
(while (< cnt 9)
(setq cnt (+ cnt 1)
t1 (list (car p1) (+ (cadr p1) (* dd cnt)) )
t2 (list (car p4) (+ (cadr p1) (* dd cnt)) )
)
(grdraw t1 t2 1 1)
)

(prompt (strcat "\nAutoCAD Version : " (getvar "acadver")))
(prompt "\n[CADmus-Benchmarks 1.0] AutoCAD Speed Test ")
(setq chk 1 time3 0)
(prompt "\n\n")
(setq chk 0 cpx (car p1) cpy 0)
(while (<= chk 100)
(setq time1 (* (rem (getvar "cdate") 0.0001) 10000))
(setq cnt 0 sum 0)
(while (< cnt 25)
(repeat cnt
(setq sum (+ sum 1))
)
(setq cnt (1+ cnt))
)
(if (/= time2 nil)
(progn
(setq spp (- time1 time2))
(if (< spp 0) (setq spp (- (+ time1 0.6) time2)))
(setq cpx (+ cpx (* ttx 0.8))
cpy (+ (* spp (* tty 0.8) 10000.0) (cadr p1)))
;;;;;;;;(if (> cpy (cadr p2))(setq cpy (cadr p2))) ;;;;;;;;;;;;;; Upper limit
(setq cpp (list cpx cpy)
time3 (+ time3 spp)
)

(prompt (strcat "\r" (nth (rem chk 4) '("-" "\\" "|" "/"))
" [Count] " (itoa chk)
" [Elapsed-Time] " (rtos (* time3 100))
" [Current-Speed] " (rtos (* spp 10000))
" " ))
(grtext -1 (strcat (nth (rem chk 4) '("-" "\\" "|" "/"))
" [Count] " (itoa chk)
" [Elasped-Time] " (rtos (* time3 100)) ))
(grtext -2 (strcat " [Current-Speed] " (rtos (* spp 10000)) ))
(if (/= cpq nil) (grdraw cpp cpq 3 0))
)
)
(setq cpq cpp time2 time1 chk (1+ chk))
)

(setq cpp (list (car p1) (+ (* time3 dd 10) (cadr p1)) ))
(setq cpq (list (car p4) (+ (* time3 dd 10) (cadr p1)) ))
(grdraw cpp cpq 2 0)

(setvar "cmdecho" ocmd)
(prompt (strcat "\nSpeed : " (rtos (* time3 100))))
(princ)
)
;********************************************************************
(defun c:mt(/ ce pnt1 pnt2 ss ls)
(setq olderr *error*
*error* kaerr)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(graphscr)
(prompt "\nSelect extending edge!")
(setq ce (ssget))
(prompt "\nSelect objects to extend: ")
(setq pnt1 (getpoint "\nSelect First corner: "))
(initget 32)
(setq pnt2 (getcorner pnt1 "\nSelect second corner: "))
(setq SS (ssget "C" pnt1 pnt2))
(setq ls (sslength SS))
(setq no -1)
(command "trim" ce "")
(repeat ls
(setq no (1+ no))
(command (list (ssname ss no) pnt2))
)
(command "")
(setvar "blipmode" 1)
(setvar "highlight" 1)
(setvar "cmdecho" 1)
(setq *error* olderr)
(prin1)
)

(defun kaerr(k)
(if (/= k "Function cancelled")
(princ (strcat "\nError: " k))
)
(setvar "blipmode" 1)
(setvar "highlight" 1)
(setvar "cmdecho" 1)
(graphscr)
(princ)
)
(defun c:me(/ ce pnt1 pnt2 ss ls)
(setq olderr *error*
*error* kaerr)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(graphscr)
(prompt "\nSelect extending edge!")
(setq ce (ssget))
(prompt "\nSelect objects to extend: ")
(setq pnt1 (getpoint "\nSelect First corner: "))
(initget 32)
(setq pnt2 (getcorner pnt1 "\nSelect second corner: "))
(setq SS (ssget "C" pnt1 pnt2))
(setq ls (sslength SS))
(setq no -1)
(command "extend" ce "")
(repeat ls
(setq no (1+ no))
(command (list (ssname ss no) pnt2))
)
(command "")
(setvar "blipmode" 1)
(setvar "highlight" 1)
(setvar "cmdecho" 1)
(setq *error* olderr)
(prin1)
)


(defun c:ex1()
(setq a (entget(car (entsel "\nSelect line")))
sp(assoc 10 a)
ep(assoc 11 a)
pt(getpoint "\nEnter extend Point:")
)
(if(<(distance(cdr sp) pt) (distance(cdr ep)pt))
(progn(setq sp1 (cons 10 pt))
(setq a1(subst sp1 sp a))
)
(progn(setq ep1(cons 11 pt))
(setq a1(subst ep1 ep a))
)
)
(entmod a1)
(command "redraw")
)


(defun c:mr()
(setq pt1(getpoint "start point:"))(terpri)
(setq pt2(getcorner pt1 "to point:"))(terpri)
(setq pt3(getpoint "move base point:"))
(setq pt4(getpoint "move new point:"))
(SETVAR "HIGHLIGHT" 1)
(SETVAR "DRAGMOde" 2)
(command "move" "auto" pt1 pt2 "" pt3 pt4)
(command "rotate" "p" "" pt4 "")
)


(defun c:pcm()
(setq pt1 (getpoint "start point:"))(terpri)
(setq pt2 (getpoint pt1 "to point:"))(terpri)
(setq ang (angle pt1 pt2))
(setq sc (getreal "scale:"))
(setq sc1 (* 8 sc))
(setq h (* 3 sc))
(setq pt3 (polar pt1 (+ ang (dtr 345)) h))
(setq pt4 (polar pt1 (+ ang (dtr 15)) h))
(setq pt5 (polar pt2 ang sc1))
(setq pt6 (polar pt2 ang (/ sc1 2)))
(command "layer" "make" "0" "")
(command "line" pt1 pt2 "")
(command "solid" pt1 pt3 pt4 "" "")
(command "circle" "2p" pt2 pt5 "")
(command "layer" "make" "0" "")
(command "dtext" "m" pt6 h "" "")
(command "layer" "make" "0" "")
)

;=========================================================================
;==========================================================================


(defun c:1 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s "" "p" "LA" "OUT" "C" "7" "LT" "CONTINUOUS" "")
(setvar "cmdecho" 1)
(princ)
)

(defun c:2 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s "" "p" "LA" "CEN" "c" "1" "LT" "CENTER2" "")
(setvar "cmdecho" 1)
(princ)
)


(defun c:3 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s "" "p" "LA" "HID" "c" "4" "LT" "HIDDEN2" "")
(setvar "cmdecho" 1)
(princ)
)


(defun c:4 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s "" "p" "LA" "PHA" "C" "6" "LT" "PHANTOM2" "")
(setvar "cmdecho" 1)
(princ)
)


(defun c:5 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s"" "p" "LA" "CON" "C" "1" "LT" "continuous" "")
(setvar "cmdecho" 1)
(princ)
)

(defun c:6 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s"" "p" "LA" "dim" "C" "3" "LT" "continuous" "")
(setvar "cmdecho" 1)
(princ)
)

(defun c:0 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s"" "p" "LA" "0" "C" "2" "LT" "continuous" "")
(setvar "cmdecho" 1)
(princ)
)

(defun c:7 ()
(setvar "cmdecho" 0)
(setq m:err *error* *error* berror)
(setq s(ssget ))
(command "change" s"" "p" "LA" "TEXT" "C" "2" "LT" "CONTINUOUS" "")
(setvar "cmdecho" 1)
(princ)
)

;***********************************************************************
(defun c:ACT ()
(prompt "\nSelect text to edit: ")
(setq a (ssget))
(setq b (sslength a))
(setq c 0)
(while (<= 1 b)
(setq d (ssname a c))
(if (eq (cdr (assoc 0 (entget d))) "TEXT")
(progn
(prompt "\nnew text string <")
(princ (cdr (assoc 1 (entget d))))
(princ ">:")
(setq e (getstring t))
(if (= e "") (setq e (cdr (assoc 1 (entget d)))))
(entmod (subst (cons 1 e) (assoc 1 (entget d)) (entget d)))
(redraw d 4)
)
)
(setq b (- b 1))
(setq c (+ c 1))
)
(princ)
)
;*********************************************************************
(defun C:LLL ()
(setq p1 (getpoint "\nEnter point of Arrow location: "))
(setq p2 (getpoint"\nEnter point of Text location: "))
(setq a1 (angle p1 p2))
(setq a2 (+ a1 (* pi 0.5)))
(setq a3 (+ a1 (* pi 1.5)))
(setq d1 (/ (distance p1 p2) 5))
(setq p3 (polar (polar p1 a1 (* 4 d1)) a2 d1))
(setq p4 (polar (polar p1 a1 d1) a3 d1))
(setq p5 (polar (polar p1 a1 (* 4.5 d1)) a2 (* 0.25 d1)))
(command "dim" "leader" p1 p3)
(command) (command)
(entdel (entlast))
(command "pline" p1 p3 p4 p5 p2 "")
(command "pedit" "L" "S" "X")
(if (and (> (angle p5 p2) (* 0.5 pi)) (< (angle p5 p2) (* 1.5 pi)))
(command "Dtext" "J" "R"
(polar p2 pi (* (getvar "dimtxt") (getvar "dimscale")))
(* (getvar "dimtxt") (getvar"dimscale")) 0)
(command "Dtext"
(polar p2 0 (* (getvar "dimtxt") (getvar"dimscale")))
(* (getvar "dimtxt") (getvar"dimscale")) 0)
);;if
);;defun
(defun *error* (msg)
(princ msg)
(princ)
)
;**************************************************************
(defun C:SUM (/ ent ct anx an snum slen e ee x ol nl ent2)
(prompt "\nPick numbers to add: ")
(setvar "cmdecho" 0)
(setq ent (ssget))
(setq ct 0 anx 0 an 0)
(setq snum (ssname ent ct))
(setq slen (sslength ent))
(while (<= (1+ ct) slen)
(setq snum (ssname ent ct))
(setq e (entget snum))
(setq ee (cdr (assoc 1 e)))
(setq x (atof ee))
(setq ol (assoc 8 e))
(setq nl (cons 8 "0"))
(setq ent2 (subst nl ol e))
(entmod ent2)
(setq anx (+ an x))
(setq an anx)
(setq ct (1+ ct))
)
(princ "\nTotal = ")
(princ (rtos anx 2 4))(princ)
)
;*****************************************************
(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 an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(if olderr (setq *error* olderr)) ; Restore old *error* handler
(princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr)
(gc) ; close any sel-sets
(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 Color Entity Flag LAyer LType Pick Style Thickness Vector")
(setq t1 (getkword (strcat
"\n>>Block name/Color/Entity/Flag/"
"LAyer/LType/Pick/Style/Thickness/Vector: ")))
)
(setq t2
(cond
((eq t1 "Block") 2) ((eq t1 "Color") 62)
((eq t1 "Entity") 0) ((eq t1 "LAyer") 8)
((eq t1 "LType") 6) ((eq t1 "Style") 7)
((eq t1 "Thickness") 39) ((eq t1 "Flag" ) 66)
((eq t1 "Vector") 210)
(T t1)
)
)
(setq t3
(cond
((= t2 2) (getstring "\n>>Block name to add/<RETURN to remove>: "))
((= t2 62) (initget 4 "?")
(cond
((or (eq (setq t3 (getint
"\n>>Color number to add/?/<RETURN to remove>: ")) "?")
(> t3 256))
(ssx_pc) ; Print color values.
nil
)
(T
t3 ; Return t3.
)
)
)
((= t2 0) (getstring "\n>>Entity type 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>: "))
((= t2 66) (if (assoc 66 f1) nil 1))
((= t2 210)
(getpoint "\n>>Extrusion Vector 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. "))
f2
)
(progn (princ "\n0 found.") (prin1))
)
)
(defun ssx_pc ()
(if textpage (textpage) (textscr))
(princ "\n ")
(princ "\n Color number | Standard meaning ")
(princ "\n ________________|____________________")
(princ "\n | ")
(princ "\n 0 | <BYBLOCK> ")
(princ "\n 1 | Red ")
(princ "\n 2 | Yellow ")
(princ "\n 3 | Green ")
(princ "\n 4 | Cyan ")
(princ "\n 5 | Blue ")
(princ "\n 6 | Magenta ")
(princ "\n 7 | White ")
(princ "\n 8...255 | -Varies- ")
(princ "\n 256 | <BYLAYER> ")
(princ "\n \n\n\n")
)
(defun c:ssx () (ssx)(princ))
(princ "\n\tType \"ssx\" at a Command: prompt or ")
(princ "\n\t(ssx) at any object selection prompt. ")
(princ)
(defun chtxt (/ sset opt ssl nsset temp unctr ct_ver cht_er cht_oe
sslen style hgt rot txt ent cht_oc cht_ot cht_oh
loc loc1 justp justq orthom )

(setq ct_ver "1.02") ; Reset this local if you make a change.
;;
;; Internal error handler defined locally
;;
(defun cht_er (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "\nError: " s))
)
)
(eval‎(read U:E))
(if cht_oe ; If an old error routine exists
(setq *error* cht_oe) ; then, reset it
)
(if temp (redraw temp 1))
(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
(if cht_ot (setvar "texteval‎" cht_ot))
(if cht_oh (setvar "highlight" cht_oh))
(princ)
)
;;
;; Body of function
;;
(if *error* ; Set our new error handler
(setq cht_oe *error* *error* cht_er)
(setq *error* cht_er)
)

;; Set undo groups and ends with (eval‎(read U:G)) or (eval‎(read U:E))
(setq U:G "(command \"undo\" \"group\")"
U:E "(command \"undo\" \"en\")"
)

(setq cht_oc (getvar "cmdecho"))
(setq cht_oh (getvar "highlight"))
(setvar "cmdecho" 0)

(eval‎(read U:G))

(princ (strcat "\nChange text, Version " ct_ver
", (c) 1990-1991 by Autodesk, Inc. "))
(prompt "\nSelect text to change. ")
(setq sset (ssget))
(if (null sset)
(progn
(princ "\nERROR: Nothing selected.")
(exit)
)
)
;; Verify the entity set.
(cht_ve)
;; This is the main option loop.
(cht_ol)

(if cht_oe (setq *error* cht_oe)) ; Reset old error function if error
(eval‎(read U:E))
(if cht_ot (setvar "texteval‎" cht_ot))
(if cht_oh (setvar "highlight" cht_oh))
(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
(princ)
)
;;;
;;; Verify and sort out non-text entities from the selection set.
;;;
(defun cht_ve ()
(setq ssl (sslength sset)
nsset (ssadd))
(if (> ssl 25)
(princ "\nVerifying the selected entities -- please wait. ")
)
(while (> ssl 0)
(setq temp (ssname sset (setq ssl (1- ssl))))
(if (= (cdr(assoc 0 (entget temp))) "TEXT")
(ssadd temp nsset)
)
)
(setq ssl (sslength nsset)
sset nsset
unctr 0
)
(print ssl)
(princ "text entities found. ")
)
;;;
;;; The option loop.
;;;
(defun cht_ol ()
(setq opt T)
(while (and opt (> ssl 0))
(setq unctr (1+ unctr))
(command "_.UNDO" "_GROUP")
(initget "Location Justification Style Height Rotation Width Text Undo")
(setq opt (getkword
"\nHeight/Justification/Location/Rotation/Style/Text/Undo/Width: "))
(if opt
(cond
((= opt "Undo")
(cht_ue) ; Undo the previous command.
)
((= opt "Location")
(cht_le) ; Change the location.
)
((= opt "Justification")
(cht_je) ; Change the justification.
)
((= opt "Style") (cht_pe "Style" "style name" 7) )
((= opt "Height") (cht_pe "Height" "height" 40) )
((= opt "Rotation") (cht_pe "Rotation" "rotation angle" 50) )
((= opt "Width") (cht_pe "Width" "width factor" 41) )
((= opt "Text")
(cht_te) ; Change the text.
)
)
(setq opt nil)
)
(command "_.UNDO" "_END")
)
)
;;;
;;; Undo an entry.
;;;
(defun cht_ue ()
(if (> unctr 1)
(progn
(command "_.UNDO" "_END")
(command "_.UNDO" "2")
(setq unctr (- unctr 2))
)
(progn
(princ "\nNothing to undo. ")
(setq unctr (- unctr 1))
)
)
)
;;;
;;; Change the location of an entry.
;;;
(defun cht_le ()
(setq sslen (sslength sset)
style ""
hgt ""
rot ""
txt ""
)
(command "_.CHANGE" sset "" "")
(while (> sslen 0)
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
opt (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
)
(prompt "\nNew text location: ")
(command pause)
(if (null loc)
(setq loc opt)
)
(command style hgt rot txt)
)
(command)
)
;;;
;;; Change the justification of an entry.
;;;
(defun cht_je ()
(if (getvar "DIMCLRD")
(initget (strcat "TLeft TCenter TRight "
"MLeft MCenter MRight "
"BLeft BCenter BRight "
"Aligned Center Fit Left Middle Right ?"))
(initget "Aligned Center Fit Left Middle Right ?")
)
(setq sslen (sslength sset))
(setq justp (getkword (strcat "\nJustification point(s) - "
"Aligned/Center/Fit/Left/Middle/Right/<?>: ")))
(cond
((= justp "Left") (setq justp 0 justq 0) )
((= justp "Center") (setq justp 1 justq 0) )
((= justp "Right") (setq justp 2 justq 0) )
((= justp "Aligned") (setq justp 3 justq 0) )
((= justp "Fit") (setq justp 5 justq 0) )
((= justp "TLeft") (setq justp 0 justq 3) )
((= justp "TCenter") (setq justp 1 justq 3) )
((= justp "TRight") (setq justp 2 justq 3) )
((= justp "MLeft") (setq justp 0 justq 2) )
((= justp "Middle") (setq justp 4 justq 0) )
((= justp "MCenter") (setq justp 1 justq 2) )
((= justp "MRight") (setq justp 2 justq 2) )
((= justp "BLeft") (setq justp 0 justq 1) )
((= justp "BCenter") (setq justp 1 justq 1) )
((= justp "BRight") (setq justp 2 justq 1) )
((= justp "?") (setq justp nil) )
(T (setq justp nil) )
)
(if justp
(justpt) ; Process them...
(justpn) ; List options...
)
(command)
)
;;;
;;; Get alignment points for "aligned" or "fit" text.
;;;
(defun justpt ()
(while (> sslen 0)
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
ent (subst (cons 72 justp) (assoc 72 ent) ent)
opt (trans (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
(cdr(assoc -1 ent)) ; from ECS
1) ; to current UCS
)
(if (getvar "DIMCLRD")
(setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
)
(cond
((or (= justp 3) (= justp 5))
(prompt "\nNew text alignment points: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(redraw (cdr(assoc -1 ent)) 3)
(initget 1)
(setq loc (getpoint))
(initget 1)
(setq loc1 (getpoint loc))
(redraw (cdr(assoc -1 ent)) 1)
(setvar "orthomode" orthom)
(setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
(setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
)
((or (/= justp 0) (/= justq 0))
(redraw (cdr(assoc -1 ent)) 3)
(prompt "\nNew text location: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(setq loc (getpoint opt))
(setvar "orthomode" orthom)
(redraw (cdr(assoc -1 ent)) 1)
(if (null loc)
(setq loc opt)
(setq loc (trans loc 1 (cdr(assoc -1 ent))))
)
(setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
)
)
(entmod ent)
)
)
;;;
;;; List the options.
;;;
(defun justpn ()
(if (getvar "DIMCLRD") (textpage))
(princ "\nAlignment options: ")
(princ "\n\t TLeft TCenter TRight ")
(princ "\n\t MLeft MCenter MRight ")
(princ "\n\t BLeft BCenter BRight ")
(princ "\n\t Left Center Right")
(princ "\n\tAligned Middle Fit")
(if (not (getvar "DIMCLRD")) (textscr))
(princ "\n\nPress any key to return to your drawing. ")
(grread)
(princ "\r ")
(graphscr)
)
;;;
;;; Change the text of an entity.
;;;
(defun cht_te ()
(setq sslen (sslength sset))
(initget "Globally Individually Retype")
(setq ans (getkword
"\nSearch and replace text. Individually/Retype/<Globally>:"))
(setq cht_ot (getvar "texteval‎"))
(setvar "texteval‎" 1)
(cond
((= ans "Individually")
(if (= (getvar "popups") 1)
(progn
(initget "Yes No")
(setq ans (getkword "\nEdit text in dialogue? <Yes>:"))
)
(setq ans "No")
)

(while (> sslen 0)
(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
(setq ss (ssadd))
(ssadd (ssname sset sslen) ss)
(if (= ans "No")
(chgtext ss)
(command "_.DDEDIT" sn "")
)
(redraw sn 1)
)
)
((= ans "Retype")
(while (> sslen 0)
(setq ent (entget(ssname sset (setq sslen (1- sslen)))))
(redraw (cdr(assoc -1 ent)) 3)
(prompt (strcat "\nOld text: " (cdr(assoc 1 ent))))
(setq nt (getstring T "\nNew text: "))
(redraw (cdr(assoc -1 ent)) 1)
(if (> (strlen nt) 0)
(entmod (subst (cons 1 nt) (assoc 1 ent) ent))
)
)
)
(T
(chgtext sset) ; Change 'em all
)
)
(setvar "texteval‎" cht_ot)
)
;;;
;;; The old CHGTEXT command - rudimentary text editor
;;;
;;;
(defun C:CHGTEXT () (chgtext nil))

(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp
n_slen o_slen si chf chm cont ans)
(if (null objs)
(setq objs (ssget)) ; Select objects if running standalone
)
(setq chm 0)
(if objs
(progn ; If any objects selected
(if (= (type objs) 'ENAME)
(progn
(setq ent (entget objs))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
(if (= (sslength objs) 1)
(progn
(setq ent (entget (ssname objs 0)))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
)
)
(setq o_str (getstring "\nMatch string : " t))
(setq o_slen (strlen o_str))
(if (/= o_slen 0)
(progn
(setq n_str (getstring "\nNew string : " t))
(setq n_slen (strlen n_str))
(setq last_o 0
tot_o (if (= (type objs) 'ENAME)
1
(sslength objs)
)
)
(while (< last_o tot_o) ; For each selected object...
(if (= "TEXT" ; Look for TEXT entity type (group 0)
(cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
(progn
(setq chf nil si 1)
(setq s_temp (cdr (assoc 1 ent)))
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
(if (= st o_str)
(progn
(setq s_temp (strcat
(if (> si 1)
(substr s_temp 1 (1- si))
""
)
n_str
(substr s_temp (+ si o_slen))
)
)
(setq chf t) ; Found old string
(setq si (+ si n_slen))
)
(setq si (1+ si))
)
)
(if chf
(progn ; Substitute new string for old
; Modify the TEXT entity
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
(setq chm (1+ chm))
)
)
)
)
(setq last_o (1+ last_o))
)
)
;; else go on to the next line...
)
)
)
(if (/= (type objs) 'ENAME)
(if (/= (sslength objs) 1) ; Print total lines changed
(princ (strcat "Changed "
(rtos chm 2 0)
" text lines."
)
)
)
)
(terpri)
)
;;;
;;; Main procedure for manipulating text entities
;;; ARGUMENTS:
;;; typ -- Type of operation to perform
;;; prmpt -- Partial prompt string to insert in standard prompt line
;;; fld -- Assoc field to be changed
;;; GLOBALS:
;;; sset -- The selection set of text entities
;;;
(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw
sslen n sn ssl)
(if (= (sslength sset) 1) ; Special case if there is only
; one entity selected
;; Process one entity.
(cht_p1)
;; Else
(progn
;; Set prompt string.
(cht_sp)
(if (= nw "List")
;; Process List request.
(cht_pl)
(if (= nw "Individual")
;; Process Individual request.
(cht_pi)
(if (= nw "Select")
;; Process Select request.
(cht_ps)
;; Else
(progn
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= (type nw) 'STR)
(if (not (tblsearch "style" nw))
(progn
(princ (strcat "\nStyle " nw " not found. "))
)
(cht_pa)
)
(cht_pa)
)
)
)
)
)
)
)
)
;;;
;;; Change all of the entities in the selection set.
;;;
(defun cht_pa (/ cht_oh temp)
(setq sslen (sslength sset))
(setq cht_oh (getvar "highlight"))
(setvar "highlight" 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)

)
(setvar "highlight" cht_oh)
)
;;;
;;; Change one text entity.
;;;
(defun cht_p1 ()
(setq temp (ssname sset 0))
(setq ow (cdr(assoc fld (entget temp))))
(if (= opt "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(redraw (cdr(assoc -1 (entget temp))) 3)
(initget 0)
(if (= opt "Style")
(setq nw (getstring (strcat "\nNew " prmpt ". <"
ow ">: ")))
(setq nw (getreal (strcat "\nNew " prmpt ". <"
(rtos ow 2) ">: ")))
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(redraw (cdr(assoc -1 (entget temp))) 1)
(if (= opt "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= opt "Style")
(if (null (tblsearch "style" nw))
(princ (strcat "\nStyle " nw " not found. "))

(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
)
;;;
;;; Set the prompt string.
;;;
(defun cht_sp ()
(if (= typ "Style")
(progn
(initget "Individual List New Select ")
(setq nw (getkword (strcat "\nIndividual/List/Select style/<New "
prmpt
" for all text entities>: ")))
(if (or (= nw "") (= nw nil) (= nw "Enter"))
(setq nw (getstring (strcat "\nNew "
prmpt
" for all text entities: ")))
)
)
(progn
(initget "List Individual" 1)
(setq nw (getreal (strcat "\nIndividual/List/<New "
prmpt
" for all text entities>: ")))
)
)
)
;;;
;;; Process List request.
;;;
(defun cht_pl ()
(setq unctr (1- unctr))
(setq sslen (sslength sset))
(setq tw 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(if (= typ "Style")
(progn
(if (= tw 0)
(setq tw (list (cdr(assoc fld (entget temp)))))
(progn
(setq sty (cdr(assoc fld (entget temp))))
(if (not (member sty tw))
(setq tw (append tw (list sty)))
)
)
)
)
(progn
(setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
(if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
(if (< hw w) (setq hw w))
(if (> lw w) (setq lw w))
)
)
)
(if (= typ "Rotation")
(setq tw (* (/ tw pi) 180.0)
lw (* (/ lw pi) 180.0)
hw (* (/ hw pi) 180.0))
)
(if (= typ "Style")
(progn
(princ (strcat "\n"
typ
"(s) -- "))
(princ tw)
)
(princ (strcat "\n"
typ
" -- Min: "
(rtos lw 2)
"\t Max: "
(rtos hw 2)
"\t Avg: "
(rtos (/ tw (sslength sset)) 2) ))
)
)
;;;
;;; Process Individual request.
;;;
(defun cht_pi ()
(setq sslen (sslength sset))
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(setq ow (cdr(assoc fld (entget temp))))
(if (= typ "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(initget 0)
(redraw (cdr(assoc -1 (entget temp))) 3)
(if (= typ "Style")
(progn
(setq nw (getstring (strcat "\nNew "
prmpt
". <"
ow ">: ")))
)
(progn
(setq nw (getreal (strcat "\nNew "
prmpt
". <"
(rtos ow 2) ">: ")))
)
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
(redraw (cdr(assoc -1 (entget temp))) 1)
)
)
;;;
;;; Process the Select option.
;;;
(defun cht_ps ()
(princ "\nSearch for which Style name? <*>: ")
(setq sn (strcase (getstring))
n -1
nsset (ssadd)
ssl (1- (sslength sset))
)
(if (or (= sn "*") (null sn) (= sn ""))
(setq nsset sset sn "*")
(while (and sn (< n ssl))
(setq temp (ssname sset (setq n (1+ n))))
(if (= (cdr(assoc 7 (entget temp))) sn)
(ssadd temp nsset)
)
)
)
(setq ssl (sslength nsset))
(princ "\nFound ")
(princ ssl)
(princ " text entities with STYLE of ")
(princ sn)
(princ ". ")
)
;;;
;;; The C: function definition.
;;;
(defun c:cht () (chtxt))
(princ "\n\tc:CHText loaded. Start command with CHT.")
(princ)
;***********************************************************************;
(DEFUN C:ECT()
(SETVAR "CMDECHO" 0)
(PROMPT "\nCHANGE TEXT LISP PROGRAM....")
(SETQ X1 (SSGET))
(SETQ X2 (GETSTRING "\n NEW TEXT : "" "))
(SETQ X3 (SSLENGTH X1))
(SETQ NO 0)
(SETQ X4 (SSNAME X1 NO))
(WHILE (/= NO X3)
(CHANGE)
(SETQ NO (1+ NO))
(SETQ X4 (SSNAME X1 NO))
)
(PROMPT "\n----Copyright (c) by Hajin.lee FireCAD Ver 1.0----")
(princ)
)
(DEFUN CHANGE ()
(COMMAND "CHANGE" X4 "" "" "" "" "" "" X2)
(COMMAND "")
)
;*********************************************************************;
(defun C:Cb (/ a b c d e)
(prompt "\nSelect text to edit: ")
(setq a (ssget))
(setq b (sslength a))
(setq c 0)
(setq r (getint "\nnuber: "))
(setq r1 (getint "\nsp nuber: "))
(setq f (getstring t ))
(while (<= 1 b)
(setq d (ssname a c))
(if (eq (cdr (assoc 0 (entget d))) "TEXT")
(progn
(redraw d 3)
(princ (cdr (assoc 1 (entget d))))
(setq e (itoa r))
(if (= e "")
(setq e (cdr (assoc 1 (entget d))))
)
(entmod (subst (cons 1 e) (assoc 1 (entget d)) (entget d)))
(setq r (+ r r1))
(redraw d 4)
)
)
(setq b (- b 1))
(setq c (+ c 1))
)
(princ)
)

(defun C:CD (/ a b c d e)
(prompt "\nSelect text to edit: ")
(setq a (ssget))
(setq b (sslength a))
(setq ent (sslength a) c 0 tt1 0)
(setq c 0)
(setq f (getint "\nnuber: "))
(while (<= 1 b)
(setq d (ssname a c))
(setq ent1 (entget d))
(setq tt (assoc 1 ent1))
(setq tt (assoc 1 ent1))
(setq tt (cdr tt))
(setq t (assoc 0 ent1))
(setq t (cdr t))
(if (= t "TEXT")
(progn
(setq tt (atof tt))
(setq r (+ f tt))
(setq e (cdr (assoc 1 (entget d))))
(setq e (rtos r))
(if (= e "")
(setq e (cdr (assoc 1 (entget d))))
)
(entmod (subst (cons 1 e) (assoc 1 (entget d)) (entget d)))
)

)
(setq b (- b 1))
(setq c (+ c 1))
)
(princ)
)
(defun C:CS (/ a b c d e)
(prompt "\nSelect text to edit: ")
(setq a (ssget))
(setq b (sslength a))
(setq ent (sslength a) c 0 tt1 0)
(setq c 0)
(setq f (getREAL "\nnuber: "))
(while (<= 0.1 b)
(setq d (ssname a c))
(setq ent1 (entget d))
(setq tt (assoc 1 ent1))
(setq tt (assoc 1 ent1))
(setq tt (cdr tt))
(setq t (assoc 0 ent1))
(setq t (cdr t))
(if (= t "TEXT")
(progn
(setq tt (atof tt))
(setq r (* f tt))
(setq e (cdr (assoc 1 (entget d))))
(setq e (rtos r))
(if (= e "")
(setq e (cdr (assoc 1 (entget d))))
)
(entmod (subst (cons 1 e) (assoc 1 (entget d)) (entget d)))
)

)
(setq b (- b 1))
(setq c (+ c 1))
)
(princ)
)
;*********************************************************************;
;*******************************************************************
(defun c:MMA (/ cpoint spoint answer)
(setvar "cmdecho" 0)
(setq answer "Y")
(setq cpoint(getpoint "\nPick Center Point => "))
(ssget)
(while (= answer "Y")
(prompt "\nPick base point => ")
(setq spoint(getpoint))
(prompt "\nType Angle or Pick point ? ")
(menucmd "s=x")(menucmd "s=")(command "MOVE" "p" "" cpoint cpoint)
(menucmd "s=x")(menucmd "s=")(command "Rotate" "p" "" cpoint "r" cpoint spoint pause)
(menucmd "s=x")(menucmd "s=")(command "'redraw" "")
)
)
;*******************************************************************
(defun c:NN (/cpoint p1 p2 spoint answer )
(setvar "cmdecho" 0)
(setq answer "Y")
(setq cpoint(getpoint "\nPick Center Point => "))
(ssget)
(while (= answer "Y")
p1 nil
p2 nil)
(while (= nil p1)
(setq p1 (getpoint "\nEnter first point:"))
)
(while (= nil p2)
(setq p2 (getpoint "\nEnter second point:"))
)
(setq cpoint(getpoint "\nPick Center Point => "))
(ssget)
(while (= answer "Y")
(prompt "\nPick base point => ")
(setq spoint(getpoint))
(prompt "\nType Angle or Pick point ? ")
(menucmd "s=x")(menucmd "s=")(command "STRETCH" "C" "" cpoint cpoint)
(menucmd "s=x")(menucmd "s=")(command "Rotate" "p" "" cpoint "r" cpoint spoint pause)
(menucmd "s=x")(menucmd "s=")(command "'redraw" "")
)
)
;*********************************************************************;
;*******************************************************************
(defun c:oI() ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; half offset
(e_off)
(setq m:err *error* *error* berror)
(if hdst (progn (setq hvstr(rtos hdst)
hprompt(strcat "Offset distance<" hvstr ">: "))
)
(setq hprompt "Offset distance: ")
)
(setq hd(getdist hprompt))
(if hd(setq hdst hd))
(setq s1(entsel))
(while s1
(setq h(/ hdst 2.0))
(command "offset" h s1 pause "")
(setq s1(entsel))
)
(e_on)(princ))

(defun c:oII() ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; half offset
(e_off)
(setq m:err *error* *error* berror)
(if hdst (progn (setq hvstr(rtos hdst)
hprompt(strcat "Offset distance<" hvstr ">: "))
)
(setq hprompt "Offset distance: ")
)
(setq hd(getdist hprompt))
(if hd(setq hdst hd))
(setq s1(entsel))
(while s1
(setq h(/ hdst 2.0))
(command "offset" h s1 pause "")
(setq s1(entsel))
)
(e_on)(princ))