;------------------------------------------------------------------------------- ; Program Name: Dcl_Tiles.lsp [Dcl_Tiles R13] ; Created By: Terry Miller (Email: terrycadd@yahoo.com) ; (URL: http://web2.airmail.net/terrycad) ; Date Created: 2-26-01 ; Function: Utilities and functions for AutoLISP and DCL dialog control ; based upon the Dcl_Tiles dialog control method. ; Note: Dcl_Tiles requires functions inside of GetIcon.lsp. ;------------------------------------------------------------------------------- ; Revision History ; Rev By Date Description ;------------------------------------------------------------------------------- ; 1 TM 2-26-01 Initial version ; 2 TM 3-5-01 Added ArchReal for entering Architectural numbers. ; 3 TM 10-10-01 Revised ArchReal to accept "" as "0" value. ; 4 TM 4-10-02 Added IsItMM for entering Millimeters. ; 5 TM 7-21-03 Added EditBox for entering string values. ; 6 TM 2-4-04 Added EditArchOrReal to return an Arch or Real number ; and EditArchToReal which returns a Real number. ; 7 TM 6-20-04 Added Speed, delay and Progress_Bar function. ; 8 TM 2-20-05 Added Edit_Dialog, List_Dialog, and Misc_Dialog examples. ; 9 TM 3-20-05 Added Tabs_Dialog record examples and Dcl_Renum function. ; 10 TM 1-20-06 Added TitleBar$ variable to customize lists with an Other. ; Revised ListArch to return a real number string. Revised ; List functions to ignore blanks if included in a list. ; 11 TM 11-30-07 Added runapp function for DOS applications. ; 12 TM 6-20-08 Added GetTiles to returns a list of tiles in a dialog definition. ; 13 TM 9-20-09 Added ArchPrecReal and ArchPrec for precision edit boxes. ;------------------------------------------------------------------------------- ; Dcl_Tiles is a set of utilities and functions for AutoLISP and DCL dialog control ; based upon the Dcl_Tiles dialog control method. Dcl_Tiles utilizes a unique naming ; convention for variables and dialog key names. The naming convention consist of a ; numbering system of three digits ranging from 000 to 999. It's very easy to cut and ; paste code from the following examples in Dcl_Tiles into your own programs and be up ; and running in a short time. ; ; Set_Value is the main control function inside of Dcl_Tiles. It determines which ; sub-function to execute based upon the dialog key name that was activated, and ; sets the appropriate variable based upon the three digit number part of the ; dialog key name. All dialog functions contain their own sub-function Chk_Value:, ; which calls Set_Value and then allows you to make changes in the "Exceptions to ; Set_Value" area. Here you can customize it as needed, such as graying out tiles, ; or alerting that a value is incorrect based upon the values of other tiles. You ; may then reset a variable to it's previous value, or change other variables in ; other tiles as required. ; ; Following are the dialog key names recognized by Set_Value and their returns. ; Edit### string ; EditCaps### uppercase string ; EditInt### integer string ; EditReal### real number string ; EditArch### real number string to nearest 32th ; EditArchOrReal### real number string to nearest 32th or real ; EditArchToReal### real number string to nearest 32th ; List### string of item selected ; ListInt### integer string of item selected ; ListReal### real number string of item selected ; ListArch### real number string of item selected to nearest 32th ; MultiList### list of strings of the items selected ; Image### list of the integer X and Y pixel location selected ; Radio### string of the first part of the dialog key name before ###'s ; Slider### integer string of the slider position number ; Toggle### integer string of "1" for selected or "0" for not selected ; ; The Dcl_Tiles dialog control method requires that variables associated with ; dialog key names, be named according to the convention of Var###$, List###@ and ; Other###@. Adding an "Other" as the last item in a list, allows the user to add ; to the list. The dialog key names ListInt###, ListReal### and ListArch###, ; associated with a list with an "Other", will determine which type of value is ; allowed to be added to the list. If you add an "Other" to a list, you must setq ; an Other###@ list to the original List###@. ; ; Dcl_Tiles includes the function tabs_tile, which displays tabs in an image tile. ; Syntax example: (tabs_tile "Image001" '("One" "Two" "Three") 2) ; The function vector_text displays text in an image tile. ; Syntax example: (vector_text "M" 110 25 0 5 "Hello World") ; Also included with Dcl_Tiles is the Progress_Bar function. ; Syntax example: (Progress_Bar "Program Message" "Processing information..." 0.25) ;------------------------------------------------------------------------------- ; c:Dcl_Tiles - Dcl Tiles Examples ;------------------------------------------------------------------------------- (defun c:DclT ()(c:Dcl_Tiles));Shortcut (defun c:Dcl_Tiles (/ Dialog# Item) (princ "\nDcl_Tiles\n")(princ) (Dcl_Tiles_Support) (if (not *Speed#) (Speed)) (setq Dialog# 1) (while (/= Dialog# 99) (cond ((= Dialog# 1) (Edit_Dialog) (setq Dialog# (nth 0 *Edit_Dialog@))) ((= Dialog# 2) (List_Dialog) (setq Dialog# (nth 0 *List_Dialog@))) ((= Dialog# 3) (Misc_Dialog) (setq Dialog# (nth 0 *Misc_Dialog@))) ((= Dialog# 4) (Tabs_Dialog) (setq Dialog# (nth 0 *Tabs_Dialog@))) );cond );while (princ "\n*Edit_Dialog@ = ")(princ *Edit_Dialog@) (princ "\n*List_Dialog@ = ")(princ *List_Dialog@) (princ "\n*Misc_Dialog@ = ")(princ *Misc_Dialog@) (princ "\n*Tabs_Dialog@ = ") (foreach Item *Tabs_Dialog@ (princ Item)(princ "\n") );foreach (textscr) (princ) );defun c:Dcl_Tiles ;------------------------------------------------------------------------------- ; Logo - Logo image ;------------------------------------------------------------------------------- (defun Logo (/ X# Y#) (start_image "Logo") (setq X# (/ (dimx_tile "Logo") 2)) (setq Y# (/ (dimy_tile "Logo") 2)) (vector_text "M" X# (1+ Y#) 0 252 "Dcl _Tiles") (vector_text "M" (1- X#) (1+ Y#) 0 252 "Dcl _Tiles") (vector_text "M" (1- X#) Y# 0 252 "Dcl _Tiles") (vector_text "M" X# Y# 0 255 "Dcl _Tiles") (end_image) );defun Logo ;------------------------------------------------------------------------------- ; Edit_Dialog - Dcl_Tiles Edit Examples ;------------------------------------------------------------------------------- (defun Edit_Dialog (/ Chk_Value: Dcl_Id% Return# Var101$ Var102$ Var103$ Var104$ Var105$ Var106$ Var107$) ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ VarNum$) (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (Set_Value $key $value) ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- );defun Chk_Value: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (if (not *Edit_Dialog@);a unique global variable name to store dialog info (setq *Edit_Dialog@ (list nil "edit" "CAPS" "1" "1.0626" "1.0625" "1.0626" "1.0625")) );if (setq Var101$ (nth 1 *Edit_Dialog@) Var102$ (nth 2 *Edit_Dialog@) Var103$ (nth 3 *Edit_Dialog@) Var104$ (nth 4 *Edit_Dialog@) Var105$ (nth 5 *Edit_Dialog@) Var106$ (nth 6 *Edit_Dialog@) Var107$ (nth 7 *Edit_Dialog@) );setq ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "Dcl_Tiles.dcl")) (new_dialog "Edit_Dialog" Dcl_Id%) (GetTiles "Dcl_Tiles.dcl" "Edit_Dialog") ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" " Dcl_Tiles Edit Examples") (set_tile "Text101" "Edit") (set_tile "Edit101" Var101$) (set_tile "Text102" "EditCaps") (set_tile "EditCaps102" Var102$) (set_tile "Text103" "EditInt") (set_tile "EditInt103" Var103$) (set_tile "Text104" "EditReal") (set_tile "EditReal104" Var104$) (set_tile "Text105" "EditArch") (set_tile "EditArch105" (Arch Var105$));Arch required for EditArch (set_tile "Text106" "EditArchOrReal") (set_tile "EditArchOrReal106" (ArchOrReal Var106$));ArchOrReal required for EditArchOrReal (set_tile "Text107" "EditArchToReal") (set_tile "EditArchToReal107" (ArchToReal Var107$));ArchToReal required for EditArchToReal (Logo) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "Edit101" "(Chk_Value: $key $value)") (action_tile "EditCaps102" "(Chk_Value: $key $value)") (action_tile "EditInt103" "(Chk_Value: $key $value)") (action_tile "EditReal104" "(Chk_Value: $key $value)") (action_tile "EditArch105" "(Chk_Value: $key $value)") (action_tile "EditArchOrReal106" "(Chk_Value: $key $value)") (action_tile "EditArchToReal107" "(Chk_Value: $key $value)") (action_tile "accept" "(done_dialog 2)");return to dialog #2 (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq *Edit_Dialog@ (list Return# Var101$ Var102$ Var103$ Var104$ Var105$ Var106$ Var107$) );setq );defun Edit_Dialog ;------------------------------------------------------------------------------- ; List_Dialog - Dcl_Tiles List Examples ;------------------------------------------------------------------------------- (defun List_Dialog (/ Chk_Value: Dcl_Id% List201@ List202@ List203@ List204@ List205@ Num# Other202@ Other203@ Other204@ Return# Text$ Var201$ Var202$ Var203$ Var204$ Var205$) ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ TitleBar$ VarNum$) (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (cond ((= NumKey$ "202")(setq TitleBar$ "Other ListInt"));Title Bar to display ((= NumKey$ "203")(setq TitleBar$ "Other ListReal")) ((= NumKey$ "204")(setq TitleBar$ "Other ListArch")) );cond (Set_Value $key $value) ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- );defun Chk_Value: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (setq Num# 32) (while (/= Num# 256) (setq Text$ (strcat (chr Num#) " = " (itoa (ascii (chr Num#))))) (setq List201@ (append List201@ (list Text$))) (setq Num# (1+ Num#)) );while (setq List202@ (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "" "Other");ListInt with Other List203@ (list "1.1" "2.2" "3.3" "4.4" "5.5" "6.6" "7.7" "8.8" "9.9" "" "Other");ListReal with Other List204@ (list "3'-0\"" "3'-6\"" "4'-0\"" "4'-6\"" "5'-0\"" "5'-6\"" "6'-0\"" "" "Other");ListArch with Other List205@ (list "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine" "Ten") Other202@ List202@ Other203@ List203@ Other204@ List204@ );setq (if (not *List_Dialog@);a unique global variable name to store dialog info (setq *List_Dialog@ (list nil (nth 33 List201@) (nth 0 List202@) (nth 0 List203@) (nth 1 (ArchReal (nth 0 List204@)));ListArch with Other (list "One" "Three") );list );setq );if (setq Var201$ (nth 1 *List_Dialog@) Var202$ (nth 2 *List_Dialog@) Var203$ (nth 3 *List_Dialog@) Var204$ (nth 4 *List_Dialog@) Var205$ (nth 5 *List_Dialog@) );setq (if (not (member Var202$ List202@));add item to list if not a member of a list with Other (setq List202@ (Insert_nth (1- (length List202@)) Var202$ List202@)) );if (if (not (member Var203$ List203@));add item to list if not a member of a list with Other (setq List203@ (Insert_nth (1- (length List203@)) Var203$ List203@)) );if (if (and (/= Var204$ "")(not (member (Arch Var204$) List204@)));add item to list if not a member of a list with Other (setq List204@ (Insert_nth (1- (length List204@)) (Arch Var204$) List204@));Arch required for ListArch );if ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "Dcl_Tiles.dcl")) (new_dialog "List_Dialog" Dcl_Id%) (GetTiles "Dcl_Tiles.dcl" "List_Dialog") ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" " Dcl_Tiles List Examples") (set_tile "Text201" "List") (set_tile_list "List201" List201@ Var201$) (set_tile "Text202" "ListInt with Other") (set_tile_list "ListInt202" List202@ Var202$) (set_tile "Text203" "ListReal with Other") (set_tile_list "ListReal203" List203@ Var203$) (set_tile "Text204" "ListArch with Other") (if (/= Var204$ "") (set_tile_list "ListArch204" List204@ (Arch Var204$));Arch required for ListArch (set_tile_list "ListArch204" List204@ "") );if (set_tile "Text205" "MultiList") (set_tile_list "MultiList205" List205@ Var205$) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "List201" "(Chk_Value: $key $value)") (action_tile "ListInt202" "(Chk_Value: $key $value)") (action_tile "ListReal203" "(Chk_Value: $key $value)") (action_tile "ListArch204" "(Chk_Value: $key $value)") (action_tile "MultiList205" "(Chk_Value: $key $value)") (action_tile "Back" "(done_dialog 1)");return to dialog #1 (action_tile "Next" "(done_dialog 3)");return to dialog #3 (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq *List_Dialog@ (list Return# Var201$ Var202$ Var203$ Var204$ Var205$) );setq );defun List_Dialog ;------------------------------------------------------------------------------- ; Misc_Dialog - Dcl_Tiles Misc. Examples ;------------------------------------------------------------------------------- (defun Misc_Dialog (/ Chk_Value: Dcl_Id% Return# TabNames@ Text303$ Var301$ Var302$ Var303$ Var304$ Var305$ XTabs@) ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ VarNum$ Index# Xpt#);add Index# & Xpt# for tabs_tile (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (Set_Value $key $value) ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- (if (= NumKey$ "301") (progn (setq Index# 1 Xpt# (nth 0 Var301$) Var301$ 3) (repeat (length TabNames@) (if (and (>= Xpt# (nth (1- Index#) XTabs@))(<= Xpt# (nth Index# XTabs@))) (progn (setq Return# Index#) (tabs_tile "Image301" TabNames@ Index#) );progn );if (setq Index# (1+ Index#)) );repeat (if (or (= Return# 1)(= Return# 2)(= Return# 4)) (progn (delay 5) (cond ((= Return# 1) (done_dialog 1));return to dialog #1 ((= Return# 2) (done_dialog 2));return to dialog #2 ((= Return# 4) (done_dialog 4));return to dialog #4 );cond );progn );if );progn );if );defun Chk_Value: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (if (not *Misc_Dialog@);a unique global variable name to store dialog info (setq *Misc_Dialog@ (list nil 3 "Two" "5" "0" "1")) );if (setq Var301$ (nth 1 *Misc_Dialog@) Var302$ (nth 2 *Misc_Dialog@) Var303$ (nth 3 *Misc_Dialog@) Var304$ (nth 4 *Misc_Dialog@) Var305$ (nth 5 *Misc_Dialog@) Text303$ "Slider = ";optional slider text );setq (setq TabNames@ (list "Edit" "List" "Misc." "Tabs")) ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "Dcl_Tiles.dcl")) (new_dialog "Misc_Dialog" Dcl_Id%) (GetTiles "Dcl_Tiles.dcl" "Misc_Dialog") ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" " Dcl_Tiles Misc. Examples") (tabs_tile "Image301" TabNames@ Var301$) (set_tile "Radio302" (strcat Var302$ "302")) (set_tile "Text303" (strcat Text303$ Var303$));optional slider text (set_tile "Slider303" Var303$) (set_tile "Toggle304" Var304$) (set_tile "Toggle305" Var305$) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "Image301" "(Chk_Value: $key $value)") (action_tile "Radio302" "(Chk_Value: $key $value)") (action_tile "Slider303" "(Chk_Value: $key $value)") (action_tile "Toggle304" "(Chk_Value: $key $value)") (action_tile "Toggle305" "(Chk_Value: $key $value)") (action_tile "Back" "(done_dialog 2)");return to dialog #2 (action_tile "Next" "(done_dialog 4)");return to dialog #4 (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq *Misc_Dialog@ (list Return# Var301$ Var302$ Var303$ Var304$ Var305$) );setq );defun Misc_Dialog ;------------------------------------------------------------------------------- ; Tabs_Dialog - Dcl_Tiles Tabs Record Examples ;------------------------------------------------------------------------------- (defun Tabs_Dialog (/ Chk_Value: Current@ Dcl_Id% List@ List402@ List404@ Num# Return# SaveTab@ Tab# TabNames@ Var400$ Var401$ Var402$ Var403$ Var404$ Var405$ XTabs@) ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ VarNum$ Index# Xpt#);add Index# & Xpt# for tabs_tile (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (Set_Value $key $value) ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- (if (= NumKey$ "400") (progn (setq Current@ (list Tab# Var401$ Var402$ Var403$ Var404$ Var405$)) (setq *Tabs_Dialog@ (change_nth Tab# Current@ *Tabs_Dialog@)) (setq Index# 1 Xpt# (nth 0 Var400$)) (repeat (length TabNames@) (if (and (>= Xpt# (nth (1- Index#) XTabs@))(<= Xpt# (nth Index# XTabs@))) (progn (setq Tab# Index# Var400$ Index# );setq (tabs_tile "Image400" TabNames@ Tab#) );progn );if (setq Index# (1+ Index#)) );repeat (setq Var401$ (nth 1 (nth Tab# *Tabs_Dialog@)) Var402$ (nth 2 (nth Tab# *Tabs_Dialog@)) Var403$ (nth 3 (nth Tab# *Tabs_Dialog@)) Var404$ (nth 4 (nth Tab# *Tabs_Dialog@)) Var405$ (nth 5 (nth Tab# *Tabs_Dialog@)) );setq (set_tile "Title" (strcat " Dcl_Tiles Tabs Record " (itoa Tab#) " of " (itoa (length TabNames@)))) (tabs_tile "Image400" TabNames@ Var400$) (set_tile "Edit401" Var401$) (set_tile_list "List402" List402@ Var402$) (set_tile "Edit403" Var403$) (set_tile_list "List404" List404@ Var404$) (set_tile "Edit405" Var405$) );progn );if );defun Chk_Value: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (setq List402@ (list "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine" "Ten") List404@ (list "Ten" "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety") );setq (setq TabNames@ (list "1" "2" "3" "4" "5" "6")) (if (not *Tabs_Dialog@);a unique global variable name to store dialog info (progn (setq Num# 1) (setq *Tabs_Dialog@ (list nil)) (repeat (length TabNames@) (setq List@ (list Num# (itoa Num#) (nth (1- Num#) List402@) (itoa (* Num# 10)) (nth (1- Num#) List404@) (itoa (* Num# 100)))) (setq *Tabs_Dialog@ (append *Tabs_Dialog@ (list List@))) (setq Num# (1+ Num#)) );repeat );progn );if (setq Tab# (nth 0 (nth 1 *Tabs_Dialog@)) Var400$ Tab# Var401$ (nth 1 (nth Tab# *Tabs_Dialog@)) Var402$ (nth 2 (nth Tab# *Tabs_Dialog@)) Var403$ (nth 3 (nth Tab# *Tabs_Dialog@)) Var404$ (nth 4 (nth Tab# *Tabs_Dialog@)) Var405$ (nth 5 (nth Tab# *Tabs_Dialog@)) );setq ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "Dcl_Tiles.dcl")) (new_dialog "Tabs_Dialog" Dcl_Id%) (GetTiles "Dcl_Tiles.dcl" "Tabs_Dialog") ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" (strcat " Dcl_Tiles Tabs Record " (itoa Tab#) " of " (itoa (length TabNames@)))) (tabs_tile "Image400" TabNames@ Var400$) (set_tile "Text401" "Edit Item 1") (set_tile "Edit401" Var401$) (set_tile "Text402" "List Item 2") (set_tile_list "List402" List402@ Var402$) (set_tile "Text403" "Edit Item 3") (set_tile "Edit403" Var403$) (set_tile "Text404" "List Item 4") (set_tile_list "List404" List404@ Var404$) (set_tile "Text405" "Edit Item 5") (set_tile "Edit405" Var405$) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "Image400" "(Chk_Value: $key $value)") (action_tile "Edit401" "(Chk_Value: $key $value)") (action_tile "List402" "(Chk_Value: $key $value)") (action_tile "Edit403" "(Chk_Value: $key $value)") (action_tile "List404" "(Chk_Value: $key $value)") (action_tile "Edit405" "(Chk_Value: $key $value)") (action_tile "Back" "(done_dialog 3)");return to dialog #3 (action_tile "accept" "(done_dialog 99)");exit dialogs (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq Current@ (list Tab# Var401$ Var402$ Var403$ Var404$ Var405$)) (setq *Tabs_Dialog@ (change_nth Tab# Current@ *Tabs_Dialog@)) (setq SaveTab@ (nth 1 *Tabs_Dialog@)) (setq SaveTab@ (change_nth 0 Tab# SaveTab@)) (setq *Tabs_Dialog@ (change_nth 1 SaveTab@ *Tabs_Dialog@)) (setq *Tabs_Dialog@ (change_nth 0 Return# *Tabs_Dialog@)) );defun Tabs_Dialog ;------------------------------------------------------------------------------- ; Set_Value - Dialog control function ; Arguments: 2 ; $key = Dialog key selected ; $value = Value of the dialog key selected ; Returns: Sets variables from dialog action tiles based upon the Dcl_Tiles ; dialog control method ;------------------------------------------------------------------------------- (defun Set_Value ($key $value / ArchList@ IsItArch: IsItArchReal: IsItInt: IsItReal: Item ListNum$ Other$ OtherFlag OtherList$ Q TextKey$ TextNum$ TypeKey$) ;----------------------------------------------------------------------------- ; Set_Value subfunctions = IsItArch:, IsItArchPrec:, IsItArchReal:, IsItInt:, IsItReal: ;----------------------------------------------------------------------------- ; IsItArch: ;----------------------------------------------------------------------------- (defun IsItArch: (/ Return@) (if (not (setq Return@ (ArchReal $value))) (progn (GetOK "Invalid Value" (strcat "Value entered must be a real number or in" "\none of the following Architectural formats:" "\n5'-6 7/8" Q ", 5', 5'-6" Q ", 5'-7/8" Q ", 6" Q ", 6 7/8" Q ", 7/8" Q );strcat "exclam" );GetOK (set_tile $key (Arch (eval (read (strcat "Var" NumKey$ "$")))) );set_tile (mode_tile $key 2) );progn );if Return@;list or nil );defun IsItArch: ;----------------------------------------------------------------------------- ; IsItArchPrec: ;----------------------------------------------------------------------------- (defun IsItArchPrec: (/ Return@) (if (not (setq Return@ (ArchPrecReal $value))) (progn (GetOK "Invalid Value" (strcat "Value entered must be a real number or in" "\none of the following Architectural formats:" "\n5'-6 7/8" Q ", 5', 5'-6" Q ", 5'-7/8" Q ", 6" Q ", 6 7/8" Q ", 7/8" Q );strcat "exclam" );GetOK (set_tile $key (ArchPrec (eval (read (strcat "Var" NumKey$ "$")))) );set_tile (mode_tile $key 2) );progn );if Return@;list or nil );defun IsItArchPrec: ;----------------------------------------------------------------------------- ; IsItArchReal: ;----------------------------------------------------------------------------- (defun IsItArchReal: (/ Return) (if (ArchReal $value) (if (= (stor $value) (atof (nth 1 (ArchReal $value)))) (setq Return (Arch $value)) (setq Return (strcat (rtosr (stor $value)) Q)) );if (progn (GetOK "Invalid Value" (strcat "Value entered must be a real number or in" "\none of the following Architectural formats:" "\n5'-6 7/8" Q ", 5', 5'-6" Q ", 5'-7/8" Q ", 6" Q ", 6 7/8" Q ", 7/8" Q );strcat "exclam" );GetOK (set_tile $key (eval (read (strcat "Var" NumKey$ "$")))) (mode_tile $key 2) );progn );if Return;value or nil );defun IsItArchReal: ;----------------------------------------------------------------------------- ; IsItInt: ;----------------------------------------------------------------------------- (defun IsItInt: (/ Return) (setq Return t) (if (not (IsItInt $value)) (progn (setq Return nil) (GetOK "Invalid Value" "Value entered must be an integer!" "exclam" );GetOK (set_tile $key (eval (read (strcat "Var" NumKey$ "$")))) (mode_tile $key 2) );progn (setq $value (itoa (atoi $value))) );if Return;t or nil );defun IsItInt: ;----------------------------------------------------------------------------- ; IsItReal: ;----------------------------------------------------------------------------- (defun IsItReal: (/ Return) (setq Return t) (if (not (IsItReal $value)) (progn (setq Return nil) (GetOK "Invalid Value" "Value entered must be a real number!" "exclam") (set_tile $key (eval (read (strcat "Var" NumKey$ "$")))) (mode_tile $key 2) );progn );if Return;t or nil );defun IsItReal: ;----------------------------------------------------------------------------- ; Set_Value - Start Main Function ;----------------------------------------------------------------------------- (setq TypeKey$ (substr $key 1 (- (strlen $key) 3)); Type of Key NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits ListNum$ (strcat "List" NumKey$ "@") ; List variable name OtherList$ (strcat "Other" NumKey$ "@") ; Other List name VarNum$ (strcat "Var" NumKey$ "$") ; Variable name TextNum$ (strcat "Text" NumKey$ "$") ; Text variable name TextKey$ (strcat "Text" NumKey$) ; Text in dialog name Q (chr 34) );setq ;----------------------------------------------------------------------------- ; Edit, EditCaps or EditInt ;----------------------------------------------------------------------------- (if (or (= TypeKey$ "Edit") (if (= TypeKey$ "EditCaps") (setq $value (strcase $value))) (if (= TypeKey$ "EditInt") (IsItInt:) nil) );or (progn (setq $value (FindReplace (NoSpaces $value) " " " ")) (set (read VarNum$) $value) (set_tile $key $value) );progn );if Edit, EditCaps or EditInt ;----------------------------------------------------------------------------- ; EditReal ;----------------------------------------------------------------------------- (if (= TypeKey$ "EditReal") (progn (if (IsItReal:) (progn (setq $value (FindReplace (NoSpaces $value) " " " ")) (setq $value (rtosr (atof $value))) (if (IsItInt $value) (setq $value (strcat $value ".0")) );if (set (read VarNum$) $value) (set_tile $key $value) );progn );if );if );if EditReal ;----------------------------------------------------------------------------- ; EditArch ;----------------------------------------------------------------------------- (if (= TypeKey$ "EditArch") (if (setq $value (IsItArch:)) (progn (set (read VarNum$) (nth 1 $value)) (set_tile $key (nth 0 $value)) );progn );if );if EditArch ;----------------------------------------------------------------------------- ; EditArchPrec ;----------------------------------------------------------------------------- (if (= TypeKey$ "EditArchPrec") (if (setq $value (IsItArchPrec:)) (progn (set (read VarNum$) (nth 1 $value)) (set_tile $key (nth 0 $value)) );progn );if );if EditArchPrec ;----------------------------------------------------------------------------- ; EditArchOrReal ;----------------------------------------------------------------------------- (if (= TypeKey$ "EditArchOrReal") (if (setq $value (IsItArchReal:)) (progn (set_tile $key $value) (set (read VarNum$) (rtosr (stor $value))) );progn );if );if EditArchOrReal ;----------------------------------------------------------------------------- ; EditArchToReal ;----------------------------------------------------------------------------- (if (= TypeKey$ "EditArchToReal") (if (setq $value (IsItArchReal:)) (progn (setq $value (nth 1 (ArchReal $value))) (set (read VarNum$) $value) (set_tile $key $value) );progn );if );if EditArchToReal ;----------------------------------------------------------------------------- ; Image ;----------------------------------------------------------------------------- (if (= TypeKey$ "Image") (set (read VarNum$) (list $x $y)) );if Image ;----------------------------------------------------------------------------- ; List, ListInt or ListReal ;----------------------------------------------------------------------------- (if (or (= TypeKey$ "List")(= TypeKey$ "ListInt")(= TypeKey$ "ListReal")) (progn (if (= (nth (atoi $value) (eval (read ListNum$))) "") (setq $value (itoa (- (length (eval (read ListNum$))) (length (member SaveVar$ (eval (read ListNum$)))))) );setq );if (if (= (nth (atoi $value) (eval (read ListNum$))) "Other") (progn (if (not TitleBar$) (setq TitleBar$ "Enter Other Value") );if (setq Other$ (EditBox TitleBar$ "Value" SaveVar$ 28.59)) (if (not Other$) (setq Other$ "")) (setq Other$ (FindReplace (NoSpaces Other$) " " " ")) (if (= (strcase Other$) "OTHER") (setq Other$ "")) (if (/= Other$ "") (setq OtherFlag t)) (if (= TypeKey$ "ListReal") (if (not (IsItReal Other$)) (progn (if (/= Other$ "") (GetOK "Invalid Value" "Value entered must be a real number!" "exclam" );GetOK );if (setq Other$ SaveVar$) );progn );if );if (if (= TypeKey$ "ListInt") (if (not (IsItInt Other$)) (progn (if (/= Other$ "") (GetOK "Invalid Value" "Value entered must be an integer number!" "exclam" );GetOK );if (setq Other$ SaveVar$) );progn );if );if (if OtherFlag (progn (foreach Item (eval (read ListNum$)) (if (= (strcase Other$) (strcase Item)) (setq $value (itoa (- (length (eval (read ListNum$))) (length (member Item (eval (read ListNum$)))))) OtherFlag nil );setq );if );foreach (if OtherFlag (if (/= Other$ "") (progn (set (read ListNum$) (Insert_nth (1- (length (eval (read OtherList$)))) Other$ (eval (read OtherList$)) );Insert_nth );set (setq $value (itoa (1- (length (eval (read OtherList$)))))) );progn (setq $value (itoa (- (length (eval (read ListNum$))) (length (member (eval (read VarNum$)) (eval (read ListNum$)))))) );setq );if );if );progn (setq $value (itoa (- (length (eval (read ListNum$))) (length (member (eval (read VarNum$)) (eval (read ListNum$)))))) );setq );if );progn );if Other (set (read VarNum$) (nth (atoi $value) (eval (read ListNum$)))) (start_list $key) (mapcar 'add_list (eval (read ListNum$))) (end_list) (set_tile $key $value) );progn );if List, ListInt or ListReal ;----------------------------------------------------------------------------- ; ListArch ;----------------------------------------------------------------------------- (if (= TypeKey$ "ListArch") (progn (if (= (nth (atoi $value) (eval (read ListNum$))) "") (if (member (Arch SaveVar$) (eval (read ListNum$))) (setq $value (itoa (- (length (eval (read ListNum$))) (length (member (Arch SaveVar$) (eval (read ListNum$)))))) );setq );if );if (if (= (nth (atoi $value) (eval (read ListNum$))) "Other") (progn (if (not TitleBar$) (setq TitleBar$ "Enter Other Value") );if (setq Other$ (EditBox TitleBar$ "Value" (Arch SaveVar$) 28.26)) (if (not Other$) (setq Other$ "")) (if (= (strcase Other$) "OTHER") (setq Other$ "")) (if (/= Other$ "") (setq OtherFlag t)) (if (not (setq ArchList@ (ArchReal Other$))) (progn (if (/= Other$ "") (GetOK "Invalid Value" (strcat "Value entered must be a real number or in" "\none of the following Architectural formats:" "\n5'-6 7/8" Q ", 5', 5'-6" Q ", 5'-7/8" Q ", 6" Q ", 6 7/8" Q ", 7/8" Q );strcat "exclam" );GetOK );if (setq Other$ (Arch SaveVar$)) );progn (setq Other$ (nth 0 ArchList@)) );if (if OtherFlag (if (member Other$ (eval (read ListNum$))) (setq $value (itoa (- (length (eval (read ListNum$))) (length (member Other$ (eval (read ListNum$)))))) );setq (if (/= Other$ "") (progn (set (read ListNum$) (Insert_nth (1- (length (eval (read OtherList$)))) Other$ (eval (read OtherList$)) );Insert_nth );set (setq $value (itoa (1- (length (eval (read OtherList$)))))) );progn (setq $value (itoa (- (length (eval (read ListNum$))) (length (member (Arch (eval (read VarNum$))) (eval (read ListNum$)))))) );setq );if );if (setq $value (itoa (- (length (eval (read ListNum$))) (length (member (Arch (eval (read VarNum$))) (eval (read ListNum$)))))) );setq );if );progn );if Other (if (/= Other$ "") (if (/= (nth (atoi $value) (eval (read ListNum$))) "") (set (read VarNum$) (nth 1 (ArchReal (nth (atoi $value) (eval (read ListNum$))))) );set (set (read VarNum$) "") );if );if (start_list $key) (mapcar 'add_list (eval (read ListNum$))) (end_list) (set_tile $key $value) );progn );if ListArch ;----------------------------------------------------------------------------- ; MultiList ;----------------------------------------------------------------------------- (if (= TypeKey$ "MultiList") (progn (set (read VarNum$) (list (nth (atoi $value) (eval (read ListNum$))))) (setq $value (substr $value (+ (strlen (itoa (atoi $value))) 2))) (while (/= $value "") (set (read VarNum$) (append (eval (read VarNum$)) (list (nth (atoi $value) (eval (read ListNum$))))) );set (setq $value (substr $value (+ (strlen (itoa (atoi $value))) 2))) );while );progn );if MultiList ;----------------------------------------------------------------------------- ; Radio ;----------------------------------------------------------------------------- (if (= TypeKey$ "Radio") (set (read VarNum$) (substr $value 1 (- (strlen $value) 3))) );if Radio ;----------------------------------------------------------------------------- ; Slider ;----------------------------------------------------------------------------- (if (= TypeKey$ "Slider") (progn (if (eval (read TextNum$)) (set_tile (eval TextKey$) (strcat (eval (read TextNum$)) $value)) );if (set (read VarNum$) $value) (set_tile $key $value) );progn );if Slider ;----------------------------------------------------------------------------- ; Toggle ;----------------------------------------------------------------------------- (if (= TypeKey$ "Toggle") (set (read VarNum$) $value) );if Toggle (if (and (member $key *Tiles@)(= $reason 1)) (mode_tile (cadr (member $key *Tiles@)) 2) );if );defun Set_Value ;------------------------------------------------------------------------------- ; Arch - String number to an architectural number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number converted to an architectural number. ;------------------------------------------------------------------------------- (defun Arch (Str$) (if (or (= (type Str$) 'REAL)(= (type Str$) 'INT)) (setq Str$ (rtos Str$ 2 8)) );if (if (ArchReal Str$) (nth 0 (ArchReal Str$)) "0'-0\"" );if );defun Arch ;------------------------------------------------------------------------------- ; ArchReal - String to a list of an architectural and real number ; Arguments: 1 ; Str$ = String of an architectural or real number ; Returns: List of an architectural and real number else nil ;------------------------------------------------------------------------------- (defun ArchReal (Str$ / Arch$ Number~ Prec# Real$ Return@) (if (setq Number~ (stor Str$)) (progn (setq Prec# 5 ; Precision to Architectural 32ths Arch$ (rtos Number~ 4 Prec#) Real$ (rtosr (distof Arch$ 4)) );setq (if (= Number~ 0) (setq Arch$ "0'-0\"") );if (setq Return@ (list Arch$ Real$)) );progn ) Return@;list or nil );defun ArchReal ;------------------------------------------------------------------------------- ; ArchPrec - String number to an architectural number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number converted to an architectural number. ;------------------------------------------------------------------------------- (defun ArchPrec (Str$) (if (or (= (type Str$) 'REAL)(= (type Str$) 'INT)) (setq Str$ (rtos Str$ 2 8)) );if (if (ArchPrecReal Str$) (nth 0 (ArchReal Str$)) "0'-0\"" );if );defun ArchPrec ;------------------------------------------------------------------------------- ; ArchPrecReal - String to a list of an architectural and real number ; Arguments: 1 ; Str$ = String of an architectural or real number ; Returns: List of an architectural and real number else nil ;------------------------------------------------------------------------------- (defun ArchPrecReal (Str$ / Arch$ Number~ Prec# Real$ Return@) (if (setq Number~ (stor Str$)) (progn (setq Prec# 7 ; Precision to Architectural 128ths Arch$ (rtos Number~ 4 Prec#) Real$ (rtosr (distof Arch$ 4)) );setq (if (= Number~ 0) (setq Arch$ "0'-0\"") );if (setq Return@ (list Arch$ Real$)) );progn ) Return@;list or nil );defun ArchPrecReal ;------------------------------------------------------------------------------- ; ArchOrReal - String number to an architectural or real number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number converted to an architectural or real number. ;------------------------------------------------------------------------------- (defun ArchOrReal (Str$) (if (ArchReal Str$) (if (= (stor Str$) (atof (nth 1 (ArchReal Str$)))) (Arch Str$) (strcat (rtosr (stor Str$)) "\"") );if "0'-0\"" );if );defun ArchOrReal ;------------------------------------------------------------------------------- ; ArchToReal - Architectural or string number to a string real number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number rounded Architecturally to a string real number. ;------------------------------------------------------------------------------- (defun ArchToReal (Str$) (if (ArchReal Str$) (nth 1 (ArchReal Str$)) "0.0" );if );defun ArchToReal ;------------------------------------------------------------------------------- ; InchMark - Adds an inch mark to a numbered string if needed ; Arguments: 1 ; Str$ = Number in any string format ; Returns: Adds an inch mark to end of string ;------------------------------------------------------------------------------- (defun InchMark (Str$) (if (/= (substr Str$ (strlen Str$)) "\"") (strcat Str$ "\"") Str$ );if );defun InchMark ;------------------------------------------------------------------------------- ; IsItInt - Checks if string is a positive integer ; Arguments: 1 ; Str$ = String of integer number ; Returns: t if positive integer else nil ;------------------------------------------------------------------------------- (defun IsItInt (Str$) (and (not (= "." (substr Str$ 1 1))) (or (= Str$ "")(= (type (read Str$)) 'INT)) );and );defun IsItInt ;------------------------------------------------------------------------------- ; IsItReal - Checks if string is a real number ; Arguments: 1 ; Str$ = String of real number ; Returns: t if real else nil ;------------------------------------------------------------------------------- (defun IsItReal (Str$) (if (= (substr Str$ 1 1) ".") (setq Str$ (strcat "0" Str$)) );if (if (= (substr Str$ 1 2) "-.") (setq Str$ (strcat "-0." (substr Str$ 3))) );if (or (= Str$ "")(= (type (read Str$)) 'REAL)(= (type (read Str$)) 'INT)) );defun IsItReal ;------------------------------------------------------------------------------- ; IsItMM - Metric to list of decimal inches and metric number ; Arguments: 1 ; MM$ = String of metric number ; Returns: List of decimal inches and metric number else nil ;------------------------------------------------------------------------------- (defun IsItMM (MM$ / DecimalInch$ MM$ Return@) (if (= (type MM$) 'STR) (progn (setq MM$ (NoSpaces MM$)) (if (IsItReal MM$) (setq MM$ (rtosr (atof MM$)) DecimalInch$ (rtosr (/ (atof MM$) 25.4)) Return@ (list DecimalInch$ MM$) );setq );if );progn );if Return@;list or nil );defun IsItMM ;------------------------------------------------------------------------------- ; NoSpaces - Truncates left and right spaces from a string. ; Arguments: 1 ; Str$ = String ; Returns: String with the left and right spaces truncated. ;------------------------------------------------------------------------------- (defun NoSpaces (Str$) (vl-string-trim " " Str$) );defun NoSpaces ;------------------------------------------------------------------------------- ; rtosr - Changes a real number into a short real number string. ; stripping off all trailing 0's. ; Arguments: 1 ; RealNum~ = Real number to convert to a short string real number ; Returns: ShortReal$ the short string real number value of the real number. ;------------------------------------------------------------------------------- (defun rtosr (RealNum~ / DimZin# ShortReal$) (setq DimZin# (getvar "DIMZIN")) (setvar "DIMZIN" 8) (setq ShortReal$ (rtos RealNum~ 2 8)) (setvar "DIMZIN" DimZin#) ShortReal$ );defun rtosr ;------------------------------------------------------------------------------- ; stor - String number to a real number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number converted to a real number. ;------------------------------------------------------------------------------- (defun stor (Str$ / Feet$ Feet~ Inch$ Inch~ Index# Number~ PlusMinus#) (setq Str$ (vl-string-trim " " Str$)) (while (vl-string-search " " Str$) (setq Str$ (FindReplace Str$ " " " ")) );while (setq Str$ (FindReplace Str$ "- " "-")) (setq Str$ (FindReplace Str$ " -" "-")) (if (= (substr Str$ 1 1) "-") (setq PlusMinus# -1 Str$ (substr Str$ 2)) (setq PlusMinus# 1) );if (if (and (= Str$ "")(= PlusMinus# 1)) (setq Str$ "0") );if (cond ((setq Number~ (distof Str$ 2)));Decimal ((setq Number~ (distof Str$ 4)));Architectural ((setq Index# (vl-string-search "'" Str$)) (setq Feet$ (substr Str$ 1 Index#)) (cond ((setq Feet~ (distof Feet$ 2))) ((setq Feet~ (distof Feet$ 4))) );cond (setq Inch$ (substr Str$ (+ Index# 2))) (cond ((setq Inch~ (distof Inch$ 2))) ((setq Inch~ (distof Inch$ 4))) );cond (if (not (wcmatch Inch$ "*'*")) (cond ((and Feet~ Inch~)(setq Number~ (+ (* (abs Feet~) 12) (abs Inch~)))) (Feet~ (setq Number~ (* (abs Feet~) 12))) (Inch~ (setq Number~ (abs Inch~))) );cond );if );case );cond (if Number~ (setq Number~ (* (abs Number~) PlusMinus#)) );if Number~ );defun stor ;------------------------------------------------------------------------------- ; set_tile_list - Sets a dialog popup_list or list_box tile to a list ; Arguments: 3 ; KeyName$ = Key name of tile ; ListName@ = The list to set in tile ; Selected = An item in the ListNames@ or a list of items selected ; Syntax: (set_tile_list "TileName" '("A" "B" "C") "B") ; (set_tile_list "TileName" '("A" "B" "C") '("A" "C")) ; Returns: Sets Selected items in dialog popup_list or list_box tiles. ;------------------------------------------------------------------------------- (defun set_tile_list (KeyName$ ListName@ Selected / Item) (start_list KeyName$ 3) (mapcar 'add_list ListName@) (end_list) (foreach Item (if (listp Selected) Selected (list Selected)) (if (member Item ListName@) (set_tile KeyName$ (itoa (- (length ListName@) (length (member Item ListName@))))) );if );foreach );defun set_tile_list ;------------------------------------------------------------------------------- ; Speed - Determines the approximate computer processing speed and sets the ; global variable *speed# which may be used in delay loops while in dialogs. ;------------------------------------------------------------------------------- (defun Speed (/ Cdate~ Cnt# NewSecond# OldSecond#) (setq Cdate~ (getvar "CDATE")) (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10))) (repeat 2 (setq Cnt# 0) (setq OldSecond# NewSecond#) (while (= NewSecond# OldSecond#) (setq Cdate~ (getvar "CDATE")) (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10))) (setq Cnt# (1+ Cnt#)) );while );repeat (setq *Speed# Cnt#) (princ) );defun Speed ;------------------------------------------------------------------------------- ; delay - time delay function ; Arguments: 1 ; Percent~ - Percentage of *Speed# variable ; Returns: time delay ;------------------------------------------------------------------------------- (defun delay (Percent~ / Number~) (if (not *Speed#) (Speed)) (repeat (fix (* *Speed# Percent~)) (setq Number~ pi)) (princ) );defun delay ;------------------------------------------------------------------------------- ; Progress_Bar - Progress Bar ; Arguments: 3 ; Title = Dialog title ; Message = Message to display ; Percent~ - Percentage of *Speed# variable ; Example: (Progress_Bar "Program Message" "Processing information..." 0.25) ;------------------------------------------------------------------------------- (defun Progress_Bar (Title Msg Percent~ / Dcl_Id% Height# Num# Width# X# Y#) (if (not *Speed#) (Speed)) (setq Dcl_Id% (load_dialog "Dcl_Tiles.dcl")) (new_dialog "Progress_Bar" Dcl_Id%) (if (= Title "")(setq Title "AutoCAD Message")) (if (= Msg "")(setq Msg "Processing information...")) (set_tile "Title" (strcat " " Title)) (set_tile "Msg" Msg) (setq X# (1- (dimx_tile "Progress_Bar"))) (setq Y# (1- (dimy_tile "Progress_Bar"))) (start_image "Progress_Bar") (vector_image 0 Y# X# Y# 255) (vector_image X# Y# X# 0 255) (vector_image X# 0 0 0 8) (vector_image 0 0 0 Y# 8) (end_image) (setq Num# 1) (repeat 100 (delay Percent~) (setq Height# (- Y# 5)) (setq Width# (* Num# 2)) (start_image "Progress_Bar") (fill_image 3 3 Width# Height# 164) (end_image) (setq Num# (1+ Num#)) );repeat (delay 4) (done_dialog) (start_dialog) (unload_dialog Dcl_Id%) (princ) );defun Progress_Bar ;------------------------------------------------------------------------------- ; vector_text - Draws text in a dialog image tile ; Arguments: 6 ; Justify$ = Justification option of "L" "ML" "TL" "C" "M" "TC" "R" "MR" or "TR" ; X# = Starting X location ; Y# = Starting Y location ; Rotation# = Rotation angle of 0 or 90 ; Color# = Color number of text ranging from 0 to 255 ; TextStr$ = Text string to draw ; Returns: Draws text string in a dialog image tile ; Note: Use this function between a start_image and an end_image command. ; Example: (vector_text "M" 110 25 0 5 "Hello World") ;------------------------------------------------------------------------------- (defun vector_text (Justify$ X# Y# Rotation# Color# TextStr$ / ChrList@ FontList@ Item Num# Width# XY# X1# X2# Y1# Y2#) (setq Justify$ (strcase Justify$)) (if (not (member Justify$ (list "L" "ML" "TL" "C" "M" "TC" "R" "MR" "TR"))) (progn (princ "\nvector_text syntax error:\nJustification options are L, ML, TL, C, M, TC, R, MR, and TR.")(exit)) );if (if (and (< Color# 0)(> Color# 255)) (progn (princ "\nvector_text syntax error:\nColor value ranges between 0 and 255.")(exit)) );if (if (or (< X# 0)(< Y# 0)) (progn (princ "\nvector_text syntax error:\nValues for X and Y must be a positive number.")(exit)) );if (if (not (or (= Rotation# 0)(= Rotation# 90))) (progn (princ "\nvector_text syntax error:\nRotation angle can only be 0 or 90 degrees.")(exit)) );if (setq FontList@ (GetFontList TextStr$)) (setq Width# 0) (if (= Rotation# 0) (progn (if (member Justify$ (list "TL" "TC" "TR")) (setq Y# (1- Y#)) );if (if (member Justify$ (list "ML" "M" "MR")) (setq Y# (- Y# 5)) );if (if (member Justify$ (list "L" "C" "R")) (setq Y# (- Y# 9)) );if (foreach Item FontList@ (setq Width# (+ Width# (nth 0 Item))) );foreach (if (member Justify$ (list "C" "M" "TC")) (setq X# (- X# (fix (+ (/ Width# 2.0) 0.5)))) );if (if (member Justify$ (list "R" "MR" "TR")) (setq X# (- X# Width#)) );if (foreach ChrList@ FontList@ (setq Num# 1) (while (< Num# (length ChrList@)) (setq XY# (nth Num# ChrList@) X1# (+ X# (nth Num# ChrList@)) Y1# (+ Y# (nth (1+ Num#) ChrList@)) X2# (+ X# (nth (+ Num# 2) ChrList@)) Y2# (+ Y# (nth (+ Num# 3) ChrList@)) );setq (if (and (/= XY# -1)(> X1# -1)(> Y1# -1)(> X2# -1)(> Y2# -1)) (vector_image X1# Y1# X2# Y2# Color#) );if (setq Num# (+ Num# 4)) );while (setq X# (+ X# (nth 0 ChrList@))) );foreach );progn (progn (if (member Justify$ (list "TL" "TC" "TR")) (setq X# (1- X#)) );if (if (member Justify$ (list "ML" "M" "MR")) (setq X# (- X# 5)) );if (if (member Justify$ (list "L" "C" "R")) (setq X# (- X# 9)) );if (foreach Item FontList@ (setq Width# (+ Width# (nth 0 Item))) );foreach (if (member Justify$ (list "C" "M" "TC")) (setq Y# (+ Y# (fix (+ (/ Width# 2.0) 0.5)))) );if (if (member Justify$ (list "R" "MR" "TR")) (setq Y# (+ Y# Width#)) );if (foreach ChrList@ FontList@ (setq Num# 1) (while (< Num# (length ChrList@)) (setq XY# (nth Num# ChrList@) X1# (+ X# (nth (1+ Num#) ChrList@)) Y1# (- Y# (nth Num# ChrList@)) X2# (+ X# (nth (+ Num# 3) ChrList@)) Y2# (- Y# (nth (+ Num# 2) ChrList@)) );setq (if (and (/= XY# -1)(> X1# -1)(> Y1# -1)(> X2# -1)(> Y2# -1)) (vector_image X1# Y1# X2# Y2# Color#) );if (setq Num# (+ Num# 4)) );while (setq Y# (- Y# (nth 0 ChrList@))) );foreach );progn );if );defun vector_text ;------------------------------------------------------------------------------- ; GetFontList - Gets vector points of font string ; Arguments: 1 ; Str$ = Text string ; Returns: List of vector points of font string ;------------------------------------------------------------------------------- (defun GetFontList (Str$ / C$ ChrList@ FontList@ Num# PercentPercent:) ;----------------------------------------------------------------------------- ; PercentPercent: - Replaces special characters begining with %%. ; Arguments: 1 ; Str$ = String ; Returns: String with %%d, %%c and %%p characters replaced. ;----------------------------------------------------------------------------- (defun PercentPercent: (Str$) (if (wcmatch Str$ "*%%D*") (setq Str$ (FindReplace Str$ "%%D" (chr 176)));degree );if (if (wcmatch Str$ "*%%d*") (setq Str$ (FindReplace Str$ "%%d" (chr 176)));degree );if (if (wcmatch Str$ "*%%P*") (setq Str$ (FindReplace Str$ "%%P" (chr 177)));plus/minus );if (if (wcmatch Str$ "*%%p*") (setq Str$ (FindReplace Str$ "%%p" (chr 177)));plus/minus );if (if (wcmatch Str$ "*%%C*") (setq Str$ (FindReplace Str$ "%%C" (chr 248)));diameter );if (if (wcmatch Str$ "*%%c*") (setq Str$ (FindReplace Str$ "%%c" (chr 248)));diameter );if (if (wcmatch Str$ "*Ø*") (setq Str$ (FindReplace Str$ (chr 216) (chr 248)));diameter );if Str$ );defun PercentPercent: ;----------------------------------------------------------------------------- ; Start of main function ;----------------------------------------------------------------------------- (setq Str$ (PercentPercent: Str$)) (setq Num# 1) (repeat (strlen Str$) (setq C$ (substr Str$ Num# 1)) (setq ChrList@ (cond ((= C$" ")'(3 -1 -1 -1 -1))((= C$"!")'(3 1 7 1 1 1 9 1 9))((= C$"\"")'(5 1 1 1 3 4 1 4 3))((= C$"#")'(7 1 7 6 7 1 3 6 3 2 1 2 9 5 1 5 9))((= C$"$")'(6 3 1 3 10 1 8 1 8 2 9 4 9 1 3 1 4 4 6 2 5 4 2 2 2 5 8 5 7 5 3 5 3))((= C$"%")'(8 1 8 7 2 4 8 4 8 1 2 1 2 2 3 3 3 2 1 3 1 4 2 4 2 5 7 6 7 5 9 6 9 7 8 7 8))((= C$"&")'(6 1 6 1 8 2 9 3 9 4 8 4 7 1 2 1 3 2 4 2 5 3 6 3 6 2 1 2 1 3 2 3 3 5 9 5 9 5 6 5 6))((= C$"'")'(2 1 1 1 3))((= C$"(")'(3 1 2 1 10 2 11 2 11 2 1 2 1))((= C$")")'(3 2 2 2 10 1 11 1 11 1 1 1 1))((= C$"*")'(4 1 4 3 2 1 2 3 4))((= C$"+")'(6 1 6 5 6 3 4 3 8))((= C$",")'(3 1 10 2 9))((= C$"-")'(3 1 6 2 6))((= C$".")'(3 1 9 1 9))((= C$"/")'(5 1 9 4 2 4 1 4 1))((= C$"0")'(6 1 2 1 8 2 9 4 9 2 1 4 1 5 2 5 8))((= C$"1")'(6 3 1 3 9 1 2 2 2))((= C$"2")'(6 5 9 1 9 1 8 4 5 1 2 1 2 2 1 4 1 5 2 5 4))((= C$"3")'(6 1 8 1 8 2 9 4 9 1 2 1 2 4 5 3 5 2 1 4 1 5 8 5 6 5 2 5 4))((= C$"4")'(6 5 7 1 7 4 1 4 9 3 2 1 7))((= C$"5")'(6 5 1 1 1 1 8 1 8 4 9 2 9 1 1 1 5 2 4 4 4 5 5 5 8)) ((= C$"6")'(6 1 8 1 2 2 9 4 9 4 5 2 5 2 1 4 1 5 8 5 6 5 2 5 2))((= C$"7")'(6 5 1 2 8 1 1 5 1 2 9 2 9))((= C$"8")'(6 1 6 1 8 2 9 4 9 1 2 1 4 2 5 4 5 2 1 4 1 5 6 5 8 5 2 5 4))((= C$"9")'(6 1 8 1 8 2 9 4 9 1 2 1 4 2 5 4 5 2 1 4 1 5 2 5 8))((= C$":")'(3 1 9 1 9 1 4 1 4))((= C$";")'(3 1 10 2 9 2 4 2 4))((= C$"<")'(6 1 6 4 9 1 6 4 3))((= C$"=")'(6 1 7 5 7 1 5 5 5))((= C$">")'(6 4 6 1 9 1 3 4 6))((= C$"?")'(6 3 6 3 7 3 9 3 9 1 2 1 2 4 5 4 5 2 1 4 1 5 2 5 4))((= C$"@")'(11 4 10 8 10 4 1 7 1 1 4 1 7 2 9 3 9 2 8 2 9 4 5 4 6 3 2 2 2 2 2 2 3 8 7 10 7 5 7 6 7 7 4 5 4 7 4 7 6 8 2 9 2 9 2 9 3 10 4 10 7))((= C$"A")'(7 3 1 5 6 1 7 5 7 0 9 0 8 1 6 3 1 6 8 6 9))((= C$"B")'(7 1 1 1 9 1 9 4 9 1 5 4 5 1 1 4 1 5 6 5 8 5 2 5 4))((= C$"C")'(7 2 9 5 9 2 1 5 1 1 2 1 8 6 8 6 8 6 2 6 2))((= C$"D")'(8 1 1 1 9 1 9 4 9 1 1 4 1 6 3 6 7 5 8 5 8 5 2 5 2))((= C$"E")'(7 1 9 5 9 1 1 5 1 1 1 1 9 1 5 4 5))((= C$"F")'(6 1 1 5 1 1 1 1 9 1 5 4 5))((= C$"G")'(8 4 5 6 5 2 1 5 1 1 2 1 8 4 9 2 9 6 5 6 9 5 8 5 8 6 2 6 2)) ((= C$"H")'(8 1 5 6 5 1 1 1 9 6 1 6 9))((= C$"I")'(3 1 1 1 9))((= C$"J")'(5 3 8 3 1 1 9 2 9 0 7 0 8))((= C$"K")'(7 2 5 6 9 5 1 2 4 1 1 1 9))((= C$"L")'(6 1 9 5 9 1 1 1 9))((= C$"M")'(9 4 8 6 3 1 9 1 1 4 8 2 3 7 1 7 9))((= C$"N")'(8 1 1 1 9 2 2 3 5 4 6 4 6 6 9 6 1 5 7 5 8))((= C$"O")'(8 2 9 5 9 2 1 5 1 1 2 1 8 6 2 6 8))((= C$"P")'(7 5 5 1 5 1 1 5 1 1 9 1 1 6 2 6 4))((= C$"Q")'(8 5 8 4 7 2 9 5 9 2 1 5 1 1 2 1 8 6 2 6 8 6 10 6 10))((= C$"R")'(8 1 1 5 1 5 5 1 5 1 9 1 1 6 6 6 9 6 2 6 4))((= C$"S")'(7 1 8 1 8 2 9 4 9 1 2 1 4 2 5 4 5 2 1 4 1 5 6 5 8 5 2 5 2))((= C$"T")'(7 1 1 5 1 3 1 3 9))((= C$"U")'(8 2 9 5 9 1 1 1 8 6 1 6 8))((= C$"V")'(7 5 4 3 9 1 4 3 9 0 1 1 4 6 1 5 4))((= C$"W")'(11 5 4 3 9 1 4 3 9 0 1 1 4 10 1 9 4 9 4 7 9 5 4 7 9 5 3 5 3))((= C$"X")'(7 1 3 5 7 1 7 5 3 0 9 0 8 0 1 0 2 6 8 6 9 6 1 6 2))((= C$"Y")'(7 3 5 5 3 3 6 3 9 1 3 3 5 0 1 0 2 6 1 6 2))((= C$"Z")'(7 0 8 6 2 0 9 6 9 0 1 6 1))((= C$"[")'(3 1 1 1 11 2 11 2 11 2 1 2 1))((= C$"\\")'(5 1 2 4 9 1 1 1 1)) ((= C$"]")'(3 2 1 2 11 1 11 1 11 1 1 1 1))((= C$"^")'(6 1 2 3 0 3 0 5 2))((= C$"_")'(6 0 11 5 11))((= C$"`")'(3 1 1 2 2))((= C$"a")'(6 2 6 5 6 5 9 2 9 1 8 1 7 4 4 2 4 5 9 5 5))((= C$"b")'(6 1 1 1 9 1 9 4 9 1 4 4 4 5 5 5 8))((= C$"c")'(6 1 5 1 8 2 9 4 9 2 4 4 4 5 8 5 8 5 5 5 5))((= C$"d")'(6 2 4 5 4 2 9 5 9 1 5 1 8 5 9 5 1))((= C$"e")'(6 1 6 5 6 1 5 1 8 2 9 4 9 2 4 4 4 5 8 5 8 5 5 5 5))((= C$"f")'(3 1 2 1 9 2 4 2 4 2 1 2 1))((= C$"g")'(6 2 4 5 4 2 9 5 9 1 5 1 8 4 11 1 11 5 4 5 10))((= C$"h")'(6 1 1 1 9 2 5 2 5 3 4 4 4 5 5 5 9))((= C$"i")'(2 1 9 1 4 1 1 1 1))((= C$"j")'(2 1 4 1 11 1 1 1 1))((= C$"k")'(6 5 9 2 6 1 1 1 9 2 6 4 4))((= C$"l")'(2 1 1 1 9))((= C$"m")'(8 1 9 1 4 4 9 4 5 3 4 2 4 7 9 7 5 5 4 6 4))((= C$"n")'(6 1 9 1 4 2 5 2 5 3 4 4 4 5 5 5 9))((= C$"o")'(6 1 5 1 8 2 9 4 9 2 4 4 4 5 8 5 5))((= C$"p")'(6 1 4 1 11 1 9 4 9 1 4 4 4 5 8 5 5))((= C$"q")'(6 5 9 2 9 5 4 2 4 1 8 1 5 5 4 5 11))((= C$"r")'(3 1 9 1 4 2 4 2 4))((= C$"s")'(5 1 5 4 8 1 8 1 8 2 9 3 9 2 4 3 4 4 5 4 5)) ((= C$"t")'(3 1 1 1 8 2 9 2 9 2 4 2 4))((= C$"u")'(6 1 4 1 8 2 9 3 9 4 8 4 8 5 9 5 4))((= C$"v")'(6 3 9 5 4 1 4 3 9))((= C$"w")'(8 6 9 4 4 1 4 1 7 2 9 4 4 7 4 7 7))((= C$"x")'(5 1 4 2 7 3 6 4 9 1 9 1 8 2 7 2 7 4 4 4 5))((= C$"y")'(5 4 4 4 7 1 4 1 7 1 11 0 11 2 8 2 10 3 8 3 8))((= C$"z")'(5 1 8 4 5 1 9 4 9 1 4 4 4))((= C$"{")'(4 2 6 2 9 3 10 3 10 1 5 1 5 2 4 2 1 3 0 3 0))((= C$"|")'(2 1 1 1 10))((= C$"}")'(4 2 6 2 9 1 10 1 10 2 4 2 1 3 5 3 5 1 0 1 0))((= C$"~")'(7 2 2 5 3 1 3 1 3 6 2 6 2))((= C$(chr 176))'(4 1 2 2 3 2 1 3 2))((= C$(chr 177))'(6 1 9 5 9 1 5 5 5 3 3 3 7))((= C$(chr 248))'(6 3 5 5 3 1 8 3 6 4 8 3 8 1 4 1 6 3 3 2 3 5 5 5 7)) );cond );setq (setq FontList@ (append FontList@ (list ChrList@))) (setq Num# (1+ Num#)) );repeat (if FontList@ FontList@ (list '(3 -1 -1 -1 -1))) );defun GetFontList ;------------------------------------------------------------------------------- ; tabs_tile - Draws tabs and tab names ; Arguments: 3 ; ImageName$ = Image key name ; TabNames@ = List of the tab names ; CurTab# = Number of the current tab ; Returns: Draws tabs and tab names and sets the global variable Xtabs@, ; which is a list of the x point dividers. ; Note: The dialog tile must be an image_button or an icon_image. ; Example: (tabs_tile "Image001" '("One" "Two" "Three") 2) ;------------------------------------------------------------------------------- (defun tabs_tile (ImageName$ TabNames@ CurTab# / CTabs@ Name$ Num# NumTabs# TextPts@ X# X1# X2# Xmax# XPts@ Ymax#) (if (or (> CurTab# (length TabNames@))(< CurTab# 1)) (setq CurTab# 1) );if (start_image ImageName$) (setq NumTabs# (length TabNames@) Xmax# (- (dimx_tile ImageName$) 2) Ymax# (- (dimy_tile ImageName$) 2) XTabs@ (list 1);global variable Num# 1 );setq (repeat (* NumTabs# 2) (setq X# (fix (+ (* Xmax# (/ Num# (float (* NumTabs# 2)))) 1.5))) (if (= (/ Num# 2)(/ Num# 2.0)) (setq XTabs@ (append XTabs@ (list X#))) (setq XPts@ (append XPts@ (list X#))) );if (setq Num# (1+ Num#)) );repeat (fill_image 1 1 (- (dimx_tile ImageName$) 2) (- (dimy_tile ImageName$) 2) -15) (setq Num# 0) (repeat NumTabs# (setq X1# (nth Num# XTabs@) X2# (nth (1+ Num#) XTabs@)) (vector_image X1# Ymax# X1# 5 255) (vector_image (1+ X1#) 4 (1+ X1#) 4 255) (vector_image (+ X1# 2) 3 (- X2# 3) 3 255) (vector_image (1- X2#) Ymax# (1- X2#) 5 250) (vector_image (- X2# 2) 4 (- X2# 2) 4 250) (vector_image (- X2# 2) Ymax# (- X2# 2) 5 8) (setq Num# (1+ Num#)) );repeat (setq Num# 1 CTabs@ (list (1+ (nth 0 XTabs@)))) (repeat (1- NumTabs#) (setq CTabs@ (append CTabs@ (list (nth Num# XTabs@)))) (setq Num# (1+ Num#)) );foreach (setq CTabs@ (append CTabs@ (list (1- (last XTabs@))))) (setq X1# (nth (1- CurTab#) CTabs@) X2# (nth CurTab# CTabs@)) (vector_image X1# Ymax# X1# 3 -15) (vector_image (1+ X1#) 4 (1+ X1#) 4 -15) (vector_image (1+ X1#) 3 (- X2# 3) 3 -15) (vector_image (- X2# 2) Ymax# (- X2# 2) 3 -15) (vector_image (1- X1#) Ymax# (1- X1#) 3 255) (vector_image X1# 2 X1# 2 255) (vector_image (1+ X1#) 1 (- X2# 2) 1 255) (vector_image X2# Ymax# X2# 3 250) (vector_image (1- X2#) 2 (1- X2#) 2 250) (vector_image (1- X2#) Ymax# (1- X2#) 3 8) (if (/= CurTab# 1) (progn (vector_image (- X1# 2) Ymax# (- X1# 2) 4 -15) (vector_image (- X1# 2) 3 (- X1# 2) 3 255) );progn );if (if (/= CurTab# (length TabNames@)) (progn (vector_image (1+ X2#) 4 (1+ X2#) 4 -15) (vector_image (1+ X2#) 3 (1+ X2#) 3 255) );progn );if (setq Num# 1) (foreach X# XPts@ (if (= Num# CurTab#) (setq TextPts@ (append TextPts@ (list (1- X#) 11))) (setq TextPts@ (append TextPts@ (list (1- X#) 13))) );if (setq Num# (1+ Num#)) );foreach (setq Num# 0) (foreach Name$ TabNames@ (if (= Name$ (nth (1- CurTab#) TabNames@)) (vector_text "M" (nth Num# TextPts@) (nth (1+ Num#) TextPts@) 0 162 Name$) (vector_text "M" (nth Num# TextPts@) (nth (1+ Num#) TextPts@) 0 0 Name$) );if (setq Num# (+ Num# 2)) );foreach (end_image) );defun tabs_tile ;------------------------------------------------------------------------------- ; Change_nth - Changes the nth item in a list with a new item value. ; Arguments: 3 ; Num# = Nth number in list to change ; Value = New item value to change to ; OldList@ = List to change item value ; Returns: A list with the nth item value changed. ;------------------------------------------------------------------------------- (defun Change_nth (Num# Value OldList@) (if (<= 0 Num# (1- (length OldList@))) (if (> Num# 0) (cons (car OldList@) (Change_nth (1- Num#) Value (cdr OldList@))) (cons Value (cdr OldList@)) );if OldList@ );if );defun Change_nth ;------------------------------------------------------------------------------- ; Delete_nth - Deletes the nth item from a list. ; Arguments: 2 ; Num# = Nth number in list to delete ; OldList@ = List to delete the nth item ; Returns: A list with the nth item deleted. ;------------------------------------------------------------------------------- (defun Delete_nth (Num# OldList@) (setq Num# (1+ Num#)) (vl-remove-if '(lambda (x) (zerop (setq Num# (1- Num#)))) OldList@) );defun Delete_nth ;------------------------------------------------------------------------------- ; Insert_nth - Inserts a new item value into the nth number in list. ; Arguments: 3 ; Num# = Nth number in list to insert item value ; Value = Item value to insert ; OldList@ = List to insert item value ; Returns: A list with the new item value inserted. ;------------------------------------------------------------------------------- (defun Insert_nth (Num# Value OldList@ / Temp@) (if (< -1 Num# (1+ (length OldList@))) (progn (repeat Num# (setq Temp@ (cons (car OldList@) Temp@) OldList@ (cdr OldList@) );setq );repeat (append (reverse Temp@) (list Value) OldList@) );progn OldList@ );if );defun Insert_nth ;------------------------------------------------------------------------------- ; Move_nth - Moves the nth Num1# item value to the nth Num2# location in a list. ; Arguments: 3 ; Num1# = Nth number in list to move item value ; Num2# = Nth number in list to move item value of nth Num1# into ; OldList@ = List to move item values ; Returns: A list with nth item value moved. ;------------------------------------------------------------------------------- (defun Move_nth (Num1# Num2# OldList@ / Move_nth:) (defun Move_nth: (Num1# Num2# OldList@ Nth# Item) (cond ((and (> Nth# Num1#) (> Nth# Num2#)) OldList@ );case ((= Nth# Num1#) (Move_nth: Num1# (1+ Num2#) (cdr OldList@) (1+ Nth#) Item) );case ((= Nth# Num2#) (cons Item (Move_nth: (1+ Num1#) Num2# OldList@ (1+ Nth#) Item)) );case ((cons (car OldList@) (Move_nth: Num1# Num2# (cdr OldList@) (1+ Nth#) Item)) );case );cond );defun Move_nth: (if (and (/= Num1# Num2#) (<= 0 Num1# (1- (length OldList@))) (<= 0 Num2# (1- (length OldList@)))) (Move_nth: Num1# Num2# OldList@ 0 (nth Num1# OldList@)) OldList@ );if );defun Move_nth ;------------------------------------------------------------------------------- ; Remove_nths - Removes the RemoveList@ of nths from a list. ; Arguments: 2 ; RemoveList@ = List of nths to remove ; OldList@ = List to remove the list of nths from ; Returns: A list with the list of nths removed. ;------------------------------------------------------------------------------- (defun Remove_nths (RemoveList@ OldList@) (if (and RemoveList@ OldList@) (if (zerop (car RemoveList@)) (Remove_nths (mapcar '1- (cdr RemoveList@)) (cdr OldList@)) (cons (car OldList@) (Remove_nths (mapcar '1- RemoveList@) (cdr OldList@))) );if OldList@ );if );defun Remove_nths ;------------------------------------------------------------------------------- ; Switch_nth - Switches the nth Num1# and Num2# item values in a list. ; Arguments: 3 ; Num1# = nth number in list to switch with nth Num2# ; Num2# = nth number in list to switch with nth Num1# ; OldList@ = List to switch item values ; Returns: A list with two item values switched. ;------------------------------------------------------------------------------- (defun Switch_nth (Num1# Num2# OldList@ / Index#) (setq Index# -1) (if (and (< -1 Num1# (length OldList@)) (< -1 Num2# (length OldList@))) (mapcar '(lambda (x) (setq Index# (1+ Index#)) (cond ((= Index# Num2#) (nth Num1# OldList@)) ((= Index# Num1#) (nth Num2# OldList@)) (x) )) OldList@ );mapcar OldList@ );if );defun Switch_nth ;------------------------------------------------------------------------------- ; Dcl_Renum - Renumbers the Dcl_Tiles variables ;------------------------------------------------------------------------------- (defun c:DclR ()(c:Dcl_Renum));Shortcut (defun c:Dcl_Renum (/ Change@ DCLfile$ DCLfile@ DosCommand$ FileName% FindReplace@ FindReplaceVarNum: GetPath: List@ LSPfile$ LSPfile@ Passed Text$ Text1$ Text2$) ;----------------------------------------------------------------------------- ; FindReplaceVarNum: - Returns Str$ with Find$ changed to Replace$ ; Arguments: 3 ; Str$ = Text string ; Find$ = Phrase string to find ; Replace$ = Phrase to replace Find$ with ; Syntax: (FindReplaceVarNum: "Var999$" "999" "101") ; Returns: Returns Str$ with Find$ changed to Replace$ ;----------------------------------------------------------------------------- (defun FindReplaceVarNum: (Str$ Find$ Replace$ / Chk$ Cnt# Loop Mid$ NewStr$ Num# Passed) (setq NewStr$ (FindReplace Str$ (strcat "\"" Find$ "\"") (strcat "\"" Replace$ "\""))) (setq Loop t Cnt# 4 Num# (strlen Find$)) (while Loop (setq Mid$ (substr NewStr$ Cnt# Num#)) (setq Chk$ (strcase (substr NewStr$ (- Cnt# 3) 3) t)) (if (member Chk$ (list "age" "aps" "der" "dio" "dit" "eal" "ext" "gle" "her" "int" "ist" "rch" "var")) (setq Passed t) (setq Passed nil) );if (if (and (= Mid$ Find$) Passed) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# Num#))) Cnt# (+ Cnt# Num# 1) );setq (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while NewStr$ );defun FindReplaceVarNum: ;----------------------------------------------------------------------------- ; GetPath: - Used to get the path from the path and filename. ; Arguments: 1 ; PathFilename$ = Path and filename string ; Returns: Pathname string. ;----------------------------------------------------------------------------- (defun GetPath: (PathFilename$) (strcat (vl-filename-directory PathFilename$) "\\") );defun GetPath: ;----------------------------------------------------------------------------- (if (= (GetOKCancel "Dcl_Renum" (strcat "Dcl_Renum renumbers variables in AutoLISP and\n" "Dialog files using the Dcl_Tiles dialog control method.\n" "In Notepad, add and edit each Find and Replace item\n" "number together on each line separated by a space.\n" " Example text line in Notepad: 235 148\n" "This will replace 235 with 148 in the AutoLISP and\n" "Dialog files selected. Add as many lines as needed.") "inform") "Cancel") (exit) );if (if (not *FilePath$) (if (findfile "AcadDoc.lsp") (setq *FilePath$ (GetPath: (findfile "AcadDoc.lsp"))) (setq *FilePath$ (getvar "DWGPREFIX")) );if );if (if (setq LSPfile$ (getfiled " Select an AutoLISP file for Dcl_Renum" *FilePath$ "lsp" 2)) (setq *FilePath$ (GetPath: LSPfile$)) );if (if (setq DCLfile$ (getfiled " Select a Dialog file for Dcl_Renum" *FilePath$ "dcl" 2)) (setq *FilePath$ (GetPath: DCLfile$)) );if (cond ((and LSPfile$ DCLfile$) (setq Text$ (strcat "Make sure that " LSPfile$ "\nand " DCLfile$ "\nare closed and not read-only.")) );case (LSPfile$ (setq Text$ (strcat "Make sure that " LSPfile$ "\nis closed and not read-only.")) );case (DCLfile$ (setq Text$ (strcat "Make sure that " DCLfile$ "\nis closed and not read-only.")) );case );cond (if (or LSPfile$ DCLfile$) (GetOk "Dcl_Renum" Text$ "exclam") (exit) );if (setq FileName% (open "C:\\Temp\\Temp.txt" "w")) (setq Text1$ "Add and edit each Find and Replace item number together on each line separated by a space.") (write-line Text1$ FileName%) (setq Text2$ "Add as many lines as needed, then save and exit Notepad. Erase these lines before you start!") (write-line Text2$ FileName%) (close FileName%) (setq DosCommand$ "Notepad C:\\Temp\\Temp.txt") (runapp DosCommand$ t) (setq FileName% (open "C:\\Temp\\Temp.txt" "r")) (setq Passed t) (while (setq Text$ (read-line FileName%)) (if (and (/= Text$ Text1$)(/= Text$ Text2$)(/= Text$ "")) (progn (setq List@ (WordList Text$)) (setq FindReplace@ (append FindReplace@ (list List@))) (if (/= (length List@) 2) (setq Passed nil)) );progn );if );while (close FileName%) (if (or (not FindReplace@)(not Passed)) (progn (GetOk "Dcl_Renum" (strcat "The Notepad file was not modified,\n" "or one of the lines does not have\n" "only the Find and Replace items!\n" "Only include two items per line.") "AlertX" );GetOK (exit) );progn );if (cond ((and LSPfile$ DCLfile$) (setq Text$ (strcat "The files " LSPfile$ "\nand " DCLfile$ "\nwere selected to renumber variables.")) );case (LSPfile$ (setq Text$ (strcat "The file " LSPfile$ "\nwas selected to renumber variables.")) );case (DCLfile$ (setq Text$ (strcat "The file " DCLfile$ "\nwas selected to renumber variables.")) );case );cond (if (= (GetOkCancel "Dcl_Renum" Text$ "Inform") "Cancel") (exit)) (if LSPfile$ (progn (princ (strcat "\nProcessing " LSPfile$ "...")) (setq FileName% (open LSPfile$ "r")) (while (setq Text$ (read-line FileName%)) (setq LSPfile@ (append LSPfile@ (list Text$))) );while (close FileName%) (foreach Change@ FindReplace@ (setq List@ nil) (foreach Text$ LSPfile@ (setq Text$ (FindReplaceVarNum: Text$ (nth 0 Change@) (nth 1 Change@))) (setq List@ (append List@ (list Text$))) );foreach (setq LSPfile@ List@) );foreach (setq FileName% (open LSPfile$ "w")) (foreach Text$ LSPfile@ (write-line Text$ FileName%) );foreach (close FileName%) );progn );if (if DCLfile$ (progn (princ (strcat "\nProcessing " DCLfile$ "...")) (setq FileName% (open DCLfile$ "r")) (while (setq Text$ (read-line FileName%)) (setq DCLfile@ (append DCLfile@ (list Text$))) );while (close FileName%) (foreach Change@ FindReplace@ (setq List@ nil) (foreach Text$ DCLfile@ (setq Text$ (FindReplaceVarNum: Text$ (nth 0 Change@) (nth 1 Change@))) (setq List@ (append List@ (list Text$))) );foreach (setq DCLfile@ List@) );foreach (setq FileName% (open DCLfile$ "w")) (foreach Text$ DCLfile@ (write-line Text$ FileName%) );foreach (close FileName%) );progn );if (if (or LSPfile$ DCLfile$) (progn (princ "\nDcl_Renum complete!")(princ) (GetOk "Dcl_Renum" "Dcl_Renum complete!" "") );progn );if (princ) );defun c:Dcl_Renum ;------------------------------------------------------------------------------- ; FindReplace - Returns Str$ with Find$ changed to Replace$ ; Arguments: 3 ; Str$ = Text string ; Find$ = Phrase string to find ; Replace$ = Phrase to replace Find$ with ; Syntax: (FindReplace "TO SCALE" "TO" "NOT TO") ; Returns: Returns Str$ with Find$ changed to Replace$ ;------------------------------------------------------------------------------- (defun FindReplace (Str$ Find$ Replace$ / Len# Num# Start#) (setq Len# (strlen Replace$)) (while (setq Num# (vl-string-search Find$ Str$ Start#)) (setq Str$ (vl-string-subst Replace$ Find$ Str$ Num#) Start# (+ Num# Len#) );setq );while Str$ );defun FindReplace ;------------------------------------------------------------------------------- ; WordList - Returns a list of words in a string ; Arguments: 1 ; Str$ = String to convert into a list strings ; Syntax: (WordList "VERIZON WIRELESS") = (list "VERIZON" "WIRELESS") ; Returns: List of words or strings that were seperated by spaces in a string ;------------------------------------------------------------------------------- (defun WordList (Str$ / List@ Num#) (while (setq Num# (vl-string-search " " Str$)) (setq List@ (cons (substr Str$ 1 Num#) List@) Str$ (substr Str$ (+ Num# 2)) );setq );while (reverse (cons Str$ List@)) );defun WordList ;------------------------------------------------------------------------------- ; NoExtraSpaces - Removes left and right spaces and extra spaces from a string. ; Arguments: 1 ; Str$ = String ; Syntax: (NoExtraSpaces " Remove extra spaces ") = "Remove extra spaces" ; Returns: String with the left and right spaces and extra spaces removed. ;------------------------------------------------------------------------------- (defun NoExtraSpaces (Str$ / Num#) (setq Str$ (vl-string-trim " " Str$)) (while (setq Num# (vl-string-search " " Str$ Num#)) (setq Str$ (vl-string-subst " " " " Str$ Num#)) );while Str$ );defun NoExtraSpaces ;------------------------------------------------------------------------------- ; runapp - Runs a DOS application with parameters ; Arguments: 2 ; Commands$ = String of DOS application with parameters ; Visible = t for visible else nil ; Syntax example: (runapp "Notepad.exe \"C:\\Temp\\Temp.txt\"" t) ; Returns: Runs a DOS application and waits for it to finish. ;------------------------------------------------------------------------------- (defun runapp (Commands$ Visible / WScript) (if (setq WScript (vlax-get-or-create-object "WScript.Shell")) (if Visible (vl-catch-all-apply 'vlax-invoke-method (list WScript "Run" Commands$ 1 :vlax-true)) (vl-catch-all-apply 'vlax-invoke-method (list WScript "Run" Commands$ 6 :vlax-true)) );if );if (princ) );defun runapp ;------------------------------------------------------------------------------- ; GetTiles - Returns a list of the tiles in a dialog definition ; Arguments: 2 ; DclFilename$ = Dcl filename.dcl ; Dialog = Dialog definition name ; Returns: Returns a list of the tiles in the dialog ;------------------------------------------------------------------------------- (defun GetTiles (DclFilename$ DialogName$ / FileName% ReadInfo Text$) (setq DialogName$ (strcat DialogName$ " : dialog {")) (setq *Tiles@ nil) (if (setq DclFilename$ (findfile DclFilename$)) (progn (setq FileName% (open DclFilename$ "r")) (while (setq Text$ (read-line FileName%)) (if (= Text$ DialogName$) (setq ReadInfo t) );if (if (and (wcmatch Text$ "* : dialog {*")(/= Text$ DialogName$)) (setq ReadInfo nil) );if (if ReadInfo (if (wcmatch Text$ "*key = *") (progn (setq Text$ (NoExtraSpaces Text$)) (setq Text$ (substr Text$ 8)) (setq Text$ (FindReplace Text$ "\";" "")) (if (= (substr Text$ 1 4) "Edit") (setq *Tiles@ (append *Tiles@ (list Text$))) );if );progn );if );if );while (close FileName%) );progn );if (setq *Tiles@ (append *Tiles@ (list "accept"))) );defun GetTiles ;------------------------------------------------------------------------------- ; Dcl_Tiles_Support - Checks to see if supporting functions are loaded ;------------------------------------------------------------------------------- (defun Dcl_Tiles_Support () (if (or (not GetOK)(not EditBox)) (progn (if (findfile "GetIcon.lsp") (load "GetIcon.lsp") (if (findfile "Blk_Lib.lsp") (load "Blk_Lib.lsp") );if );if (if (or (not GetOK)(not EditBox)) (progn (alert (strcat "Dcl_Tiles requires the functions inside of GetIcon.lsp." "\nDownload the latest version from AutoLISP Exchange," "\n(URL: http://web2.airmail.net/terrycad).") );alert (exit) );progn );if );progn );if );defun Dcl_Tiles_Support ;------------------------------------------------------------------------------- (if (not (findfile "C:\\Temp\\Temp.dcl")) (progn (vl-load-com)(vl-mkdir "C:\\Temp")) );if ;------------------------------------------------------------------------------- (princ);End of Dcl_Tiles.lsp