f;============================================================================

;**************************** F E R D J AUTOLISP ****************************

;============================================================================
;
; (Glue/One entity)
(DEFUN C:GLUE(/ Qj Q@ QQ Ql Q& Q1 Q# Q0 Q$ QO Q| Q% Q?j)
(PROMPT"\n \nGLUE:")
(SETQ Qj(CAR(ENTSEL"\nSelect main segment (first LINE to GLUE): ")))
(SETQ Q@(CAR(ENTSEL"\nSelect other segment (second LINE to GLUE): ")))
(IF(AND Qj Q@(NOT(EQ Qj Q@)))
(PROGN(SETQ QQ(ENTGET Qj)Ql(ENTGET Q@))
(IF(NOT(AND(EQUAL(CDR(ASSOC 0 QQ))"LINE")
(EQUAL(CDR(ASSOC 0 Ql))"LINE")))
(PROMPT"\nA selected entity is not a LINE...\n ")
(PROGN(SETQ Q1(CDR(ASSOC 10 QQ))Q#(CDR(ASSOC 11 QQ))Q0(CDR(ASSOC 10
Ql))Q$(CDR(ASSOC 11 Ql)))
(IF TRANS(SETQ Q1(TRANS Q1 Qj 0)Q#(TRANS Q# Qj 0)Q0(TRANS Q0 Q@ 0)Q$
(TRANS Q$ Q@ 0)))
(SETQ QO(LIST(DISTANCE Q1 Q0)Q1 Q0))
(SETQ Q|(LIST(DISTANCE Q1 Q$)Q1 Q$))
(SETQ Q%(LIST(DISTANCE Q# Q0)Q# Q0))
(SETQ Q?j(LIST(DISTANCE Q# Q$)Q# Q$))
(IF(>(CAR(SETQ QO(IF(>(CAR QO)(CAR Q|))QO Q|)))
(CAR(SETQ Q%(IF(>(CAR Q%)(CAR Q?j))Q% Q?j))))
(SETQ Q&(CDR QO))(SETQ Q&(CDR Q%)))
(IF TRANS(SETQ Q&(LIST(TRANS(CAR Q&)0 Qj)(TRANS(CADR Q&)0 Qj))))
(SETQ QQ(SUBST(CONS 10(CAR Q&))(ASSOC 10 QQ)QQ))
(SETQ QQ(SUBST(CONS 11(CADR Q&))(ASSOC 11 QQ)QQ))
(ENTDEL Q@)(ENTMOD QQ)(C:ASGCLS))))
(PROMPT"\nTwo separate entities not selected...\n "))
(PRINC))(PRINC)
(DEFUN C:G ()(C:Glue))
;
; (Object exchange)
(defun c:exh ()
(prompt"\nSelect group of entity")
(setq sel1 (ssget))
(setq pt1 (getpoint "\nPick base point"))
(prompt"\nSelect another group of entity")
(setq sel2 (ssget))
(setq pt2 (getpoint "\Pick base point"))
(command ".move" sel1 "" pt1 pt2)
(command ".move" sel2 "" pt2 pt1)
)

; (Linetype scale adjustment in every entity)

(defun C:LM ()
(setq ENT (entsel))
(setq ENTA (entget (car ENT)))
(princ
"\nUSE THE NUMERIC KEYPAD - '8' TO INCREASE...'2' TO DECREASE...'ENTER' WHEN
DONE"
) ;_ end of princ
(while (/= (setq UP_OR_DOWN (cadr (grread))) 13)
(progn
(if (= (assoc 48 ENTA) NIL)
(progn
(setq ENTB (append (cdr ENTA) '((48 . 1.01))))
 (entdel (car ENT))
(entmake ENTB)
(setq ENTA (entget (entlast)))
) ;_ end of progn
) ;_ end of if
(cond ((= UP_OR_DOWN 56) (DEC_SCALE))
((= UP_OR_DOWN 50) (INC_SCALE))
(t (INVALKEY))
) ;_ end of cond
) ;_ end of progn
) ;_ end of while
(princ)
) ;_ end of defun

(defun INC_SCALE ()
(setq ENTA (subst (cons 48 (* (cdr (assoc 48 ENTA)) 0.75))
(assoc 48 ENTA)
ENTA
) ;_ end of subst
) ;_ end of setq
(princ (strcat "\nNew ltscale is " (rtos (cdr (assoc 48 ENTA)))))
(entmod ENTA)
) ;_ end of defun

(defun DEC_SCALE ()
(setq ENTA (subst (cons 48 (* (cdr (assoc 48 ENTA)) 1.5))
(assoc 48 ENTA)
ENTA
) ;_ end of subst
) ;_ end of setq
(princ (strcat "\nNew ltscale is " (rtos (cdr (assoc 48 ENTA)))))
(entmod ENTA)
) ;_ end of defun

(defun INVALKEY ()
(princ
"\nINVALID KEY - USE THE NUMERIC KEYPAD - '8' TO INCREASE...'2' TO
DECREASE...'ENTER' WHEN DONE"
) ;_ end of PRINC
) ;_ end of defun

; (Change any word in one pharagraph)

(defun C:CT (/ p l n e os as ns st s nsl osl sl si chf chm cont)
(setq chm 0 p (ssget))
(if p (progn
(setq cont t)
(while cont
(setq osl (strlen (setq os (getstring "\nOld string: " t))))
(if (= osl 0)
(princ "Null input invalid")
(setq cont nil)
)
)
(setq nsl (strlen (setq ns (getstring "\nNew string: " t))))
(setq l 0 n (sslength p))
(while (< l n)
(if (= "TEXT"
(cdr (assoc 0 (setq e (entget (ssname p l))))))
 (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) ; Found old string
(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 l (1+ l))
)
))
(terpri))

; (Draw standard flange)

(defun c:FL ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq a1 (getreal "\nenter the width of the flange: "))
(setq dp (getreal "\nenter the depth of the beam: "))
(setq w1 (getreal "\nenter the thickness of the web: "))
(setq b1 (getreal "\nenter the thickness of the flange: "))
(setq f1 (- dp (* b1 2)))
(setq c1 (/ (- a1 w1) 2))
(setq o (getpoint "\npick location of the beam: "))
(setq n (polar o 1.5708 (/ dp 2)))
(setq b (polar n 0 (/ a1 2)))
(setq f (polar b 4.71239 b1))
(setq e (polar f 3.14159 c1))
(setq i (polar e 4.71239 f1))
(setq j (polar i 0 c1 ))
(setq l (polar j 4.71239 b1 ))
(setq k (polar l 3.14159 a1 ))
(setq g (polar k 1.5708 b1 ))
(setq h (polar g 0 c1 ))
(setq d (polar h 1.5708 f1 ))
(setq c (polar d 3.14159 c1 ))
(setq a (polar c 1.5708 b1 ))
(command "line" a b f e i j l k g h d c a "")
(setvar "osmode" 33)
)

; (Endpipe: Use for pipe sectioning)

(defun C:EP (/ A B MID R)
 (setq
A (getpoint "End of pipe\nFirst point: ")
B (getpoint A "\nSecond point: ")
R (/ (distance A B) 2.0)
MID (list
(/ (+ (car A) (car B)) 2.0)
(/
(+ (cadr A) (cadr B))
2.0
)
0.0
)
)
(command
"arc" MID "e" A "r" R "arc" MID "e" B "r" R "arc" B "e" MID
"r" R
)
(princ)
) ;end endpipe.lsp

; (Modify word by picking another word)

(defun c:mtx ()
(msgs "Select text entities to match word...")
(setq em (ssget))
(msgs "Select matching entity: ")
(setq me (entsel))
(setq kw "1")
(setq en (sslength em))
(setq cn 0)
(repeat en
(setq el (ssname em cn))
(setq etp (cdr (assoc 0 (entget el))))
(mtc 1)
(setq cn (+ cn 1))
)
(princ)
)
;
; (Change Lower case letter to Upper case letter)
(defun c:up ()
(prompt "\nSelect line of text:")
(setq e1 (entget (car (entsel))))
(setq d (assoc 1 e1))
(setq txt (cdr d))
(setq txt (strcase txt))
(setq e1 (subst (cons 1 txt) d e1))
(entmod e1)
)

; (Change Upper case letter to Lower case letter)

(defun c:low ()
(prompt "\nSelect line of text:")
(setq e1 (entget (car (entsel))))
(setq d (assoc 1 e1))
(setq txt (cdr d))
(setq txt (strcase txt 1))
 (setq e1 (subst (cons 1 txt) d e1))
(entmod e1)
)

; (Rectangular array)
(defun *error* (msg)
(setvar "osmode" 0)
(princ "\n you lost it - FERDJ")
(princ)
)
(defun C:AR1 ()
(setvar "cmdecho" 0)
(setq SSET (ssget))
(setq CHOOSE (getstring "\n polar array? <P = polar / return = rectangular>:"))
(if (or (equal CHOOSE "p") (equal CHOOSE "P"))
(progn
(setq CTRPT (getpoint "\n center point of array :"))
(if (not *NOIT)(setq *NOIT 30))
(princ "\n number of items :<")
(princ *NOIT)
(setq NOIT (getint "> "))
(if (not NOIT)(setq NOIT *NOIT)(Setq *NOIT NOIT))
(if (not *ANGF)(setq *ANGF 360))
(princ "\n angle to fill:<")
(princ *ANGF)
(setq ANGF (getint "> "))
(if (not ANGF)(setq ANGF *ANGF)(setq *ANGF ANGF))
(if (not *ROCO)(setq *ROCO y))
(princ "\n rotate objects as copied?<")
(princ *ROCO)
(setq ROCO (getstring "> "))
(if (not ROCO)(setq ROCO *ROCO)(Setq *ROCO ROCO))
(command "array" SSET "" "P" CTRPT NOIT ANGF ROCO)
)
(progn
(if (not *RONU)(setq *RONU 1))
(princ "\n number of rows <---->:<")
(princ *RONU)
(setq RONU (getint "> "))
(if (not RONU)(setq RONU *RONU)(setq *RONU RONU))
(if (not *CONU)(setq *CONU 1))
(princ "\n number of columns <||||>:<")
(princ *CONU)
(setq CONU (getint "> "))
(if (not CONU)(setq CONU *CONU)(setq *CONU CONU))
(if (not *RODI)(setq *RODI 1))
(princ "\n row distance <- - - ->:<")
(princ *RODI)
(setq RODI (getint "> "))
(if (not RODI)(setq RODI *RODI)(setq *RODI RODI))
(if (not *CODI)(setq *CODI 1))
(princ "\n column distance <| | | |>:<")
(princ *CODI)
(setq CODI (getint "> "))
(if (not CODI)(setq CODI *CODI)(setq *CODI CODI))
(command "array" SSET "" "R" RONU CONU RODI CODI)
)
)
); end
;
; (Polar array)
(Defun rtd (y)
(* 180.0 (/ y pi))
)

(defun C:AR2 (/ DIRANG CENT OBJ NUM); ANG1 ANG2 ROTANG)

(setq DIRANG (getvar "angdir"))
(setvar "angdir" 0)
(setq CENT (getpoint "\nCenter of array:")
OBJ (ssget)
)
(initget 7)
(setq NUM (getint "\nNumber of objects in array:")
ANG1 (getangle CENT "\nFirst angle point:")
ANG2 (getangle CENT "\nSecond angle point:")
)
(if (= ANG1 0.0)(setq ANG1 (* pi 2)))
(if (= ANG2 0.0)(setq ANG2 (* pi 2)))
(setq ROTANG (* (1- NUM)(rtd(- ANG2 ANG1))))
(command "array" OBJ "" "P" CENT NUM ROTANG "y")
(setvar "angdir" DIRANG)
)

; (Draw line using perpedicular osnap)

(Defun C:Lp (/ SA SB SNP OM OS PT1 PT2)
(setvar "cmdecho" 0)
(setq
SA (getvar "snapang")
SB (getvar "snapbase")
SNP (getvar "snapmode")
OM (getvar "orthomode")
OS (getvar "osmode")
PT1 (osnap (getpoint
"\nPick point on line to draw perpendicular from: "
)
"nea"
)
)
(setvar "osmode" 0)
(setq PT2 (osnap PT1 "end"))
(if (equal PT1 PT2)
(setq PT2 (osnap PT1 "MID"))
)
(command ".snap" "r" PT1 PT2)
(setvar "snapmode" 0)
(setvar "orthomodE" 1)
(prompt "\nto point:")
(command ".line" PT1 pause "")
(setvar "snapang" SA)
(setvar "snapbase" SB)
(setvar "snapmode" SNP)
(setvar "orthomode" OM)
(setvar "osmode" OS)
(setvar "cmdecho" 1)
(princ)
)
;
; (Arrange numbers randomly)
(defun *error* (MSG)
(princ MSG)
(princ "\nFunction cancelled")
(princ)
)
(prompt "\nLoading SEQN...")
(defun C:34 (/ SEQN ENT)
(if (not *SEQN) (setq *SEQN 1)) ;set default
(setvar "cmdecho" 0)
(princ "\nStarting Number <")
(princ *SEQN)
(setq SEQN (getint ">: "))
(if (not SEQN)
(setq SEQN *SEQN)
(setq *SEQN SEQN)
)
(graphscr)
(setq
ENT (entget
(car
(entsel
"\nSelect Text to Sequentially Number: "
)
)
)
)
(while ENT
(progn
(if (= (cdr (assoc 0 ENT)) "TEXT")
(progn
(entmod
(subst
(cons 1 (itoa SEQN))
(assoc 1 ENT)
ENT
)
)
(setq SEQN (1+ SEQN)) ;advance default
)
(princ "\nEntity must be TEXT")
)
(princ "\n")
(princ SEQN)
(setq
ENT (entget (car (entsel " - Select Text: ")))
)
) ;end progn
(setq *SEQN (1+ SEQN)) ;set for next use
) ;end if (princ)
)
;
; (SAME TEXT)
(defun c:mtx ()
(msgs "Select text entities to match word...")
(setq em (ssget))
(msgs "Select matching entity: ")
 (setq me (entsel))
(setq kw "1")
(setq en (sslength em))
(setq cn 0)
(repeat en
(setq el (ssname em cn))
(setq etp (cdr (assoc 0 (entget el))))
(mtc 1)
(setq cn (+ cn 1))
)
(princ)
)

; (TOGGLE ON/OFF EXTENSION LINE)

(DEFUN C:TE (/ EL1 EL2 ENT)
(setq OLDERR *error*
*error* CLER)
(COMMAND "_.UNDO" "_GROUP")
(setq EL1 (getvar "DIMSE1"))
(setq EL2 (getvar "DIMSE2"))
(setq ENT nil)
(setq ENT (entsel))
(while ENT
(if ENT
(progn
(conv1 EL1)
(command "dim" "upd" ENT "" "e")
(setq ENT (entsel))
(if ENT
(progn
(conv1 EL1)
(conv2 EL2)
(command "dim" "upd" ENT "" "e")
(setq ENT (entsel))
(if ENT
(progn
(conv1 EL1)
(command "dim" "upd" ENT "" "e")
(setq ENT (entsel))
(if ENT
(progn
(conv1 EL1)
(conv2 EL2)
(command "dim" "upd" ENT "" "e")
(setq ENT (entsel))
)
)
)
)
)
)
)
)
)
(setvar "DIMSE1" EL1)
(setvar "DIMSE2" EL2)
(setq *error* OLDERR) ; Restore old *error* handler
(command "_.UNDO" "_end")
 (prin1)
); end te.lsp
;
;(SAME WIDTH)
(defun c:mw ()
(msgs "Select text entities to match width...")
(setq em (ssget))
(msgs "Select matching entity: ")
(setq me (entsel))
(setq kw "41")
(setq en (sslength em))
(setq cn 0)
(repeat en
(setq el (ssname em cn))
(setq etp (cdr (assoc 0 (entget el))))
(mtc 41)
(setq cn (+ cn 1))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(defun c:crt (/ st1 pt1)
(msgs "Copy then Rotate....")
(setq st1 (ssget))
(msgs "Basepoint: ")
(setq pt1 (getpoint))
(command ".copy" st1 "" pt1 pt1)
(msgs "Second point displacement: ")
(command ".move" st1 "" pt1 pause)
(msgs "Rotation angle: ")
(command ".rotate" st1 "" (getvar "lastpoint") pause)
(princ)
)
(defun c:rtc (/ st1 pt1)
(msgs "Rotate then Copy....")
(setq st1 (ssget))
(msgs "Basepoint: ")
(setq pt1 (getpoint))
(command ".copy" st1 "" pt1 pt1)
(msgs "Rotation angle: ")
(command ".rotate" st1 "" pt1 pause)
(msgs "Second point displacement: ")
(command ".move" st1 "" pt1 pause)
(princ)
)
(defun c:rtm (/ st1 pt1)
(msgs "Rotate then Move....")
(setq st1 (ssget))
(msgs "Basepoint: ")
(setq pt1 (getpoint))
(msgs "Rotation angle: ")
(command ".rotate" st1 "" pt1 pause)
(msgs "Second point displacement: ")
(command ".move" st1 "" pt1 pause)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;
(defun c:up ()
(prompt "\nSelect line of text:")
(setq e1 (entget (car (entsel))))
(setq d (assoc 1 e1))
(setq txt (cdr d))
(setq txt (strcase txt))
(setq e1 (subst (cons 1 txt) d e1))
(entmod e1)
)
;;;;;
(defun c:low ()
(prompt "\nSelect line of text:")
(setq e1 (entget (car (entsel))))
(setq d (assoc 1 e1))
(setq txt (cdr d))
(setq txt (strcase txt 1))
(setq e1 (subst (cons 1 txt) d e1))
(entmod e1)
)
;;;;;;;;;;
;;;;;;;;;;