home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
graphics
/
weld12.zip
/
WELD12.LSP
< prev
next >
Wrap
Text File
|
1993-01-30
|
21KB
|
463 lines
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;▓▓ ▓▓
;▓▓ WRITTEN BY JIM COX 1-1-92 ▓▓
;▓▓ ▓▓
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;REMEMBER -- OSMODE & ORTHOMODE MUST BE TURNED OFF TO RUN PROGRAM.............
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
(defun dtr(ang)
(* pi (/ ang 180.0))
);end of dtr
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun err(s)
(setq *error* olderr olderr nil) ;restore original error function
(if (not (member s '("" "console break" "Function cancelled")))
(princ (strcat "\nError: " s))
)
(REDRAW)
(RESET)
(setq *error* OLD_ERR)
(princ)
);err
(defun set_var()
(setq OLD_ERR *error* *error* err)
(setq old_cmdecho(getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq old_dimasz (getvar"dimasz"))
(setq old_blip (getvar "blipmode"))
(setvar "blipmode" 0)
(setq old_osmode(getvar"osmode"))
(setvar"osmode" 0);<--------------must be 0 or program will crash
(setq old_ortho (getvar"orthomode"))
(setvar"orthomode" 0);<-----------must be 0
(setq plwd(getvar"plinewid"))
(setvar"plinewid" 0)
);set_var
(defun reset()
(setvar"orthomode" old_ortho)
(setvar"dimasz" old_dimasz)
(setvar"osmode" old_osmode)
(setvar "cmdecho" old_cmdecho)
(setvar "blipmode" old_blip)
(setvar"plinewid" plwd)
(setq *error* OLD_ERR)
);reset
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
(defun c:weld12 (/ pt x y sz ct ydex ypnt ylist xdex xpnt xlist icon_no
old_cmdecho old_blip P1 P2 P2A P3 P4 P5 P6 P7 P8 P9
P10 P11 P12 P13 P14 P15 P16 P17 RAD START_CROW_FT
END_CROW_FT B ANS W_SYM P4FBS1 P4FBS2
P4FBS3 P4BWS1 P4BWS1A P4BWS2 P4BWS3 P4BWS4 P4BWS5
P4BWS6 BV1 BV2 BV3 CP1 CP2 TX_LOC TX_LOC1 IN_LINE
JUST_TXT TX_FT TX_HGT OLD_ERR old_ortho old_osmode
plwd a_r_c a_r_c_1 TEST);add more
;get popslide
(set_var)
(command"vslide" "weld12.sld")
; Select choice
(setq y (getvar "viewsize")
ct (getvar"viewctr")
x (* y 1.3752265)
pt (getpoint "\nSelect Icon Choice: ")
ylist (- (cadr ct) (/ y 2.0))
ypnt (- (cadr pt) ylist)
ydex (fix (/ ypnt (/ y 6.0)));number of squares y direction
xlist (- (car ct) (/ x 2.0))
xpnt (- (car pt) xlist)
xdex (fix (/ xpnt (/ x 8.0)));number of squares x direction
)
(setq icon_no (+ xdex (* (+ ydex 7) ydex)));<----- call function or
;<--------------command at this point
(cond
((<= icon_no 7)(acad_helpdlg "weld12" "")(setq W_SYM "HELP"))
((= icon_no 8 )(setq W_SYM "FS"))
((= icon_no 9)(setq W_SYM "FS"))
((= icon_no 10)(setq W_SYM "FD"))
((= icon_no 11)(setq W_SYM "FSA"))
((= icon_no 12)(setq W_SYM "FDA"))
((= icon_no 13)(setq W_SYM "FSAF"))
((= icon_no 14)(setq W_SYM "FDAF"))
((= icon_no 15)(setq W_SYM "STITCHA"))
((= icon_no 18)(setq W_SYM "FBS"))
((= icon_no 19)(setq W_SYM "FBS"))
((= icon_no 20)(setq W_SYM "FBD"))
((= icon_no 21)(setq W_SYM "FBSA"))
((= icon_no 22)(setq W_SYM "FBDA"))
((= icon_no 23)(setq W_SYM "FBSAF"))
((= icon_no 24)(setq W_SYM "FBDAF"))
((= icon_no 25)(setq W_SYM "C:WTEXT")(setq TEST "end"))
((= icon_no 30)(setq W_SYM "BVS"))
((= icon_no 31)(setq W_SYM "BVS"))
((= icon_no 32)(setq W_SYM "BVD"))
((= icon_no 33)(setq W_SYM "BVSA"))
((= icon_no 34)(setq W_SYM "BVDA"))
((= icon_no 35)(setq W_SYM "BVSAF"))
((= icon_no 36)(setq W_SYM "BVDAF"))
((= icon_no 37)(setq W_SYM "A"))
((= icon_no 44)(setq W_SYM "BVVS"))
((= icon_no 45)(setq W_SYM "BVVS"))
((= icon_no 46)(setq W_SYM "BVVD"))
((= icon_no 47)(setq W_SYM "BVVSA"))
((= icon_no 48)(setq W_SYM "BVVDA"))
((= icon_no 49)(setq W_SYM "BVVSAF"))
((= icon_no 50)(setq W_SYM "BVVDAF"))
((= icon_no 51)(setq W_SYM "AF"))
((= icon_no 60)(setq W_SYM "BWS"))
((= icon_no 61)(setq W_SYM "BWS"))
((= icon_no 62)(setq W_SYM "BWD"))
((= icon_no 63)(setq W_SYM "BWSA"))
((= icon_no 64)(setq W_SYM "BWDA"))
((= icon_no 65)(setq W_SYM "BWSAF"))
((= icon_no 66)(setq W_SYM "BWDAF"))
((= icon_no 67)(setq W_SYM "Q"))<-------leader only
);cond
(princ "\nYou choose icon ")(princ W_SYM)
;(princ icon_no)<---------------------------for my info only
(redraw);<--------------------clears slide from screen.
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
; ****MAIN****
(if (= W_SYM "C:WTEXT")(C:WTEXT))
(if (/= TEST "end")(progn
(if (> icon_no 7)(progn
(setq DS(getvar"dimscale"))
(setq DT(getvar"dimtxt"))
(if (> DT DS)(progn(setq DS (/ DT 0.18))
(setvar "dimasz" DT )));<--set arrow & symbol size
(setq P1(getpoint"\nFrom point "))
(setq P2(getpoint P1 "\nTo point "))
(command"dim1" "leader" P1 P2 ^c^c)
(if (= W_SYM "Q")
(progn ;<--------leader only
(while
(setq P2A(getpoint P2))(command"line" P2 P2A "")
(setq P2(getvar"lastpoint"))))
(progn ;<--------runs rest of program
(while(setq P2A(getpoint P2))(setq P1 P2)(command"line" P2 P2A "")
(setq P2(getvar"lastpoint")))
(if(<= (car P2)(car P1))(setq B(* -1.5 DS))
(setq B(* 1.5 DS)));if
(setq P3 (list (+ (car P2) B) (cadr P2)));end point of leader
(setq P4 (list (+ (car P2) (/ B 2))(cadr P2)));mid point of leader
(command"line" P2 P3 "")
;***************weld12 sym drawing points********************
(setq P5 (polar P4 (dtr 270) (* DS 0.25)));fs,bws,bvs
(setq P6 (polar P5 (dtr 45) (* DS 0.353)));fs,
(setq P7 (polar p4 (dtr 315)(* DS 0.353)));fs,fbs,bws,bvs,bvvs
(setq P8 (polar p4 (dtr 270)(* DS 0.75)));fbs
(setq P9 (polar P8 (dtr 45)(* DS 0.353)));fbs
(setq P10(polar P9 (dtr 180)(* DS 0.25)));fbs
(setq P11(polar P4 (dtr 0.0)(* DS 0.125)));bws
(setq P12(polar P11 (dtr 270) (* DS 0.25)));bws
(setq P13(polar P2 (dtr 90)(* DS 0.75)));field weld start
(setq P14(polar P13(dtr 315)(* DS 0.176)));field weld
(setq P15(polar P14(dtr 180)(* DS 0.125)));field weld end
(setq P16(polar P4 (dtr 307.5)(* DS 0.353)));bvvs
(setq P17(polar p4 (dtr 232.5)(* DS 0.353)));bvvs
(setq RAD(* DS 0.09375));all around symbol, circle
;****************************arcs***************************
(setq P4FBS1(polar P4 (dtr 180)(* DS 0.0625)));<-- fbs,bvs,bvvs,start arc
(setq P4FBS2(polar P4 (dtr 90)(* DS 0.0625)));<----fbs,bvs,bvvs,mid arc
(setq P4FBS3(polar P4 (dtr 0.0)(* DS 0.0625)));<-- fbs,bvs,bvvs,end arc
(setq P4BWS1(polar P4 (dtr 180)(* DS 0.0625)))
(setq P4BWS1A(polar P4 (dtr 0.0)(* DS 0.125)))
(setq P4BWS2(polar P4BWS1A (dtr 90)(* DS 0.125)))
(setq P4BWS3 (polar P4(dtr 0.0)(* DS 0.1875)))
(setq P4BWS4 (polar P4BWS1(dtr 270)(* DS 0.25)))
(setq P4BWS5 (polar P4BWS3(dtr 270)(* DS 0.3125)))
(setq P4BWS6 (polar P4BWS3(dtr 270)(* DS 0.25)))
(setq BV1(polar P4 (dtr 270)(* DS 0.375)));<-------- bvs,bvvs arc
(setq BV2(polar P4 (dtr 310)(* DS 0.4)));<-------bvs,bvvs arc
(setq BV3(polar P4 (dtr 230)(* DS 0.4)));<-------bvs,bvvs arc
(setq CP1(polar P4 (dtr 128)(* DS 0.5)));<------mirror window
(setq CP2(polar P4 (dtr 308)(* DS 1.0)));<------mirror window
;**************************draw weld symbols***************************
(cond
((= (substr W_SYM 1 2) "FS") (command"pline" P4 P5 P6 ""))
((= (substr W_SYM 1 2) "FD") (command"pline" P4 P5 P6 "")
(command"mirror" "w" CP1 CP2 "" P2 P3 "N"))
((= (substr W_SYM 1 7) "STITCHA") (command"pline" P4 P5 P6 "")
(command"mirror" "w" CP1 CP2 "" P2 P3 "N")
(command"move" P5 "" P4 P6 ))
((= (substr W_SYM 1 3) "FBS")(command"pline" P7 P4 P8 P9 P10 "")
(command"arc" P4FBS1 P4FBS2 P4FBS3)
(setq a_r_c(entlast)));arc
((= (substr W_SYM 1 3) "FBD")(command"pline" P7 P4 P8 P9 P10 "")
(command"mirror" "w" CP1 CP2 "" P2 P3 "N"))
((= (substr W_SYM 1 3) "BWS")(command"pline" P5 P4 P11 P12 "")
(command"arc" P4BWS1 P4BWS2 P4BWS3);*arc
(setq a_r_c(entlast))
(command"arc" P4BWS4 P4BWS5 P4BWS6));*arc
((= (substr W_SYM 1 3) "BWD")(command"pline" P5 P4 P11 P12 "")
(command"arc" P4BWS4 P4BWS5 P4BWS6);*arc
(command"mirror" "w" CP1 CP2 "" P2 P3 "N"))
((= (substr W_SYM 1 3) "BVS")(command"pline" P7 P4 P5 "")
(command"arc" P4FBS1 P4FBS2 P4FBS3);*arc
(setq a_r_c(entlast))
(command"arc" "c" P4 BV1 BV2));*arc
((= (substr W_SYM 1 3) "BVD")(command"pline" P7 P4 P5 "")
(command"arc" "c" P4 BV1 BV2);*arc
(command"mirror" "w" CP1 CP2 "" P2 P3 "N"))
((= (substr W_SYM 1 4) "BVVS")(command"pline" P16 P4 P17 "")
(command"arc" "c" P4 BV3 BV2);arc
(command"arc" P4FBS1 P4FBS2 P4FBS3)
(setq a_r_c(entlast)));arc
((= (substr W_SYM 1 4) "BVVD")(command"pline" P16 P4 P17 "")
(command"arc" "c" P4 BV3 BV2)
(command"mirror" "w" CP1 CP2 "" P2 P3 "N"))
);cond
;********************crows foot**************************
(if(<=(car P2)(car P1))
(progn
(setq START_CROW_FT (polar P3(dtr 120)(* 0.375 DS)))
(setq END_CROW_FT (polar P3(dtr 240)(* 0.375 DS)))
(command"pline" START_CROW_FT P3 END_CROW_FT ""));progn
(progn
(setq START_CROW_FT(polar P3(dtr 60)(* 0.375 DS)))
(setq END_CROW_FT(polar P3(dtr 300)(* 0.375 DS)))
(command"pline" START_CROW_FT P3 END_CROW_FT "")));progn,if
;*******************all around weld sym & field sym************************
(if(wcmatch W_SYM "*A*")(command"circle" P2 RAD));if
(if(wcmatch W_SYM "*AF*")(progn
(command"circle" P2 RAD)
(command"pline" P2 P13 P14 P15 "")
(command"solid" P15 P14 P13 "" "")));progn,if
(if(= (substr W_SYM(strlen W_SYM))"F")(progn
(command"pline" P2 P13 P14 P15 "")
(command"solid" P15 P14 P13 "" "")));progn,if
;*********************weld sym on far side question********************
(if(wcmatch W_SYM "*S*")
(setq ANS(strcase(getstring "\nLocate weld on far side < N >: "))));if
(if (= ANS "Y")
(progn
(command"mirror" "w" CP1 CP2 "" P2 P3 "Y")<----mirror all
(if (/= W_SYM "STITCHA")(progn
(command"vslide" "weld12.sld")
(prompt"\nEnter FS FBS BWS BVS BVVS to add another weld to the near side. ")
(setq W_SYM (strcase(getstring"\nEnter one of the above or < cr > : ")))
(if (and (/= W_SYM "")(/= W_SYM "N")(/= a_r_c nil))(progn
(entdel a_r_c)(setq a_r_c nil)));if,progn,small arc
(cond
((= (substr W_SYM 1 2) "FS") (command"pline" P4 P5 P6 ""))
((= (substr W_SYM 1 3) "FBS")(command"pline" P7 P4 P8 P9 P10 ""))
((= (substr W_SYM 1 3) "BWS")(command"pline" P5 P4 P11 P12 "")
(command"arc" P4BWS4 P4BWS5 P4BWS6)
(setq a_r_c_1(entlast)));*arc
((= (substr W_SYM 1 3) "BVS")(command"pline" P7 P4 P5 "")
(command"arc" "c" P4 BV1 BV2)
(setq a_r_c_1(entlast)));*arc
((= (substr W_SYM 1 4) "BVVS")(command"pline" P16 P4 P17 "")
(command"arc" "c" P4 BV3 BV2)
(setq a_r_c_1(entlast)));arc
);cond
(redraw)
));if,progn /=stitcha
));progn,if ans = Y
<------------------------melt thru************************************
(if (/= a_r_c nil)
(progn
(setq MELT_THRU(strcase(getstring"\nDo you wish a melt thru < N > ")))
(if (= MELT_THRU "Y")
(progn
(setq sz(* DS 0.08))
(command"pedit" a_r_c "y" "w" sz "")
));if progn
));if progn
(setq TXT(strcase(getstring"\nEnter Y for weld size or < cr >to cancel ")))
(if(= TXT "Y")
(progn
(if(<= (car P2)(car P1))
(progn
(setq TX_FT(polar P3(dtr 135)(* DS 0.5)))
(setq JUST_TXT "R")
);progn
(progn
(setq TX_FT(polar P3(dtr 45)(* DS 0.5)))
(setq JUST_TXT "L")
)
);if
(setq TX_HGT(* DS 0.125))
(setq TX_LOC (polar P4(dtr 180)(* DS 0.0625)))
(setq IN_LINE(getstring 1 "\nEnter ns weld #1 or < cr > "))
(setq TX_LOC1(polar TX_LOC(dtr 270)(* DS 0.25)))
(command "text" "J" "R" TX_LOC1 TX_HGT 0 IN_LINE)
(setq IN_LINE(getstring 1 "\nEnter ns weld #2 or < cr > "))
(setq TX_LOC1(polar TX_LOC(dtr 270)(* DS 0.75)))
(command "text" "J" "R" TX_LOC1 TX_HGT 0 IN_LINE)
(setq IN_LINE(getstring 1 "\nEnter fs weld #1 or < cr > "))
(setq TX_LOC1(polar TX_LOC(dtr 90)(* DS 0.0625)))
(command "text" "J" "R" TX_LOC1 TX_HGT 0 IN_LINE)
(setq IN_LINE(getstring 1 "\nEnter fs weld #2 or < cr > "))
(setq TX_LOC1(polar TX_LOC(dtr 90)(* DS 0.5)))
(command "text" "J" "R" TX_LOC1 TX_HGT 0 IN_LINE)
(prompt"\rEnter text for crows foot or < cr > ")
(if (= JUST_TXT "R")
(command"dtext" "J" JUST_TXT TX_FT TX_HGT 0 "")
(command"dtext" TX_FT TX_HGT 0)
);if
);progn
);if
));if,progn /= "Q";<-------------leader only
));ends if and progn for /= 0
));progn if /= end
(reset);reset all functions
(princ)
);* end weld12 function
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓END OF WELD12 PROGRAM▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
;code lock=┘ô2*ö« rem setq codelock for 30 day demos.
;* CHGERR restores the original function of the keys if the program aborts.
(defun chgerr (s)
(setq *error* olderr olderr nil) ;restore original error function
(if (not (member s '("" "console break" "Function cancelled")))
(princ (strcat "\nError: " s))
)
(setvar "BLIPMODE" blip)
(textscr)
(setvar "CMDECHO" cmdech)
(prompt "\e[0;75;0;75p") ;restore left arrow
(prompt "\e[0;77;0;77p") ;restore right arrow
(prompt "\e[0;59;0;59p") ;restore <F1>
(prompt "\e[0;82;0;82p") ;restore <INS>
(prompt "\e[0;71;0;71p") ;restore <HOME>
(prompt "\e[0;79;0;79p") ;restore <END>
(prompt "\e[0;73;0;73p") ;restore <PG UP>
(prompt "\e[0;81;0;81p") ;restore <PG DN>
(prompt "\e[0;72;0;72p") ;restore <UP>
(prompt "\e[0;80;0;80p") ;restore <DN>
(graphscr)
(if (/= "" s)
(foreach s '(entity txt test txtlen curpos key blip cmdech) (set s nil))
)
(princ)
);defun chgerr
(defun C:WTEXT (/ entity txt test txtlen curpos key)
(setq olderr *error* ;initialize variables
*error* chgerr
key 0 ;zero out key
cmdech (getvar "CMDECHO")
blip (getvar "BLIPMODE")
)
(setvar "CMDECHO" 0) ;turn echo off
(setvar "BLIPMODE" 0) ;turn blips off
(setq entity ;gets edata
(entget (car (while (not entity) (setq entity ;while ensures entity selection
(entsel "\nPick text to edit: ")
) ) ) ) )
(if (= "TEXT" (setq test (cdr (assoc 0 entity)))) ;test if text was selected
(progn ;then
(setq txt (cdr (assoc 1 entity)) ;get text string
txtlen (1+ (strlen txt)) ;get text length
curpos 1 ;initial cursor position=length
)
(textscr) ;go to text screen
(prompt "\e[0;75;0;115p") ;change left arrow key to <ctrl left>
(prompt "\e[0;77;0;116p") ;change right arrow key to <ctrl right>
(prompt "\e[0;59;0;3p") ;change <F1> to nul
(prompt "\e[0;82;0;3p") ;change <INS> to nul
(prompt "\e[0;71;0;3p") ;change <HOME> to nul
(prompt "\e[0;79;0;3p") ;change <END> to nul
(prompt "\e[0;73;0;3p") ;change <PG UP> to nul
(prompt "\e[0;81;0;3p") ;change <PG DN> to nul
(prompt "\e[0;72;0;3p") ;change <UP> to nul
(prompt "\e[0;80;0;3p") ;change <DN> to nul
(prompt "\e[2J") ;clear screen and place header
(prompt
"\e[7;1;37;44m Weld Symbol Editor "
)
(prompt
"\e[2;1H "
)
(prompt
"\e[3;1H use <LEFT> <RIGHT> <DEL> <BACKSPACE> or type to insert text "
)
(prompt "\e[0;37;40m") ;sets ansi screen to normal
(prompt "\e[8;1HEdit text:") ;print title
(prompt "\e[1m") ;bold
(prompt "\e[m") ;normal
(prompt (strcat "\e[10;1H" txt))
(prompt "\r")
(while (/= key 13) ;while key is not return <enter> key
(prompt (strcat "\e[10;" (itoa curpos) "H")) ;initial cursor position
(setq key (last (grread)))
(cond
( (= key 243) ;<ctrl left> arrow
(setq curpos (1- curpos))
(if (< curpos 1) (setq curpos txtlen))
)
( (= key 244) ;<ctrl right> arrow
(setq curpos (1+ curpos))
(if (> curpos txtlen) (setq curpos 1))
)
( (= key 211) ;if key was del
(setq txt (strcat (substr txt 1 (1- curpos)) (substr txt (1+ curpos))))
(setq txtlen (1+ (strlen txt))) ;get new text length
(prompt (strcat "\e[10;1H" txt " ")) ;display txt string
)
( (and (= key 8) (> curpos 1)) ;delete back arrow key
(setq curpos (1- curpos))
(setq txt (strcat (substr txt 1 (1- curpos)) (substr txt (1+ curpos))))
(setq txtlen (1+ (strlen txt))) ;get new text length
(prompt (strcat "\e[10;1H" txt " ")) ; display txt string
)
( (and (> key 31) (< key 127)) ;if valid char key . . .
;create new text string including the new character at the cursor position
(setq txt (strcat (substr txt 1 (1- curpos)) (chr key) (substr txt curpos)))
(setq txtlen (1+ (strlen txt))) ;get new text length
(setq curpos (1+ curpos)) ;get new cursor position
(prompt (strcat "\e[10;1H" txt " ")) ;display new text string
)
(t nil)
);cond
);while
(chgerr "")
(prompt "\e[2J")
(prompt "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n") ;clear screen
(setq entity (subst (cons 1 txt) (assoc 1 entity) entity)) ;change entity list
(entmod entity) ;update entity
);progn
(prompt "\nEntity was not text.") ;print bad pick message
);if
(if (= "TEXT" test)
(prompt "\n\t\n\t\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n") ;clear screen
);if text
(princ)
);defun C:WTEXT
(princ)
;*end of WTEXT.LSP file
;▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓END OF PROGRAM▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓