Author Topic: ( CHALLENGE ) Remembering Variables.  (Read 8963 times)

0 Members and 1 Guest are viewing this topic.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
( CHALLENGE ) Remembering Variables.
« on: April 18, 2006, 10:16:57 AM »
This is a variation of a system I use to "remember" variable values between successive uses of a routine/application.

It can be applied to simple routines as shown here, but its best use is with DCL files.

The values can be written to disk, registry, .CFG, or global Variable and restored as required.
If the Variable names used are the same as the dcl key names the reading and writing from the DCL is simplified,
and controlled by one global variable per application.


Challenge :

Create library routines to read and write from DCL fields, saving to the global Variable.
Create library routines to read and write the variable to disk.
Each application would use a unique prefix for the Global Variable.



There is no correct answer as such to this challenge .. I'd thought it would make a good community project.
Lurkers get a black jellybean for each post :-)

Enjoy !
/// kwb

Main Sample File :
Code: [Select]
(DEFUN C:test130 (/ 130-VarNames v11 v12 v13)
   ;;
   ;; Check for a Global Variable gsw:130:VarValues containing presaved Values.
   ;;
   (OR gsw:130:VarValues
       (SETQ gsw:130:VarValues (kb:SetGlobalPairsList
                                  (SETQ 130-VarNames '("V11" "V12" "V13"))
                               )
       )
   )
   ;;
   ;; If the values have been saved previously, restore them, else nil.
   (kb:RestoreVariables gsw:130:VarValues)
   ;;
   ;; debug print values
   (kb:princDottedList gsw:130:VarValues)
   ;;
   ;;
   ;;
   ;; Prompt the user
   (SETQ v11 (kb:getint "How many spaces "
                        (IF v11
                           v11
                           (SETQ v11 10)
                        )
                        (+ 1 2 4)
                        '("oneDozen" "BakersDozen")
             )
         v11 (COND ((= v11 "oneDozen") 12)
                   ((= v11 "BakersDozen") 13)
                   ((NOT v11) 0)
                   (t v11)
             )
   )
   (SETQ v12 (kb:getpoint "Pick Work Point"
                          (IF v12
                             v12
                             (SETQ v12 (LIST 0 0 0))
                          )
                          (+ 1 8 32)
                          nil
                          v12
             )
   )
   (SETQ v13 (kb:getString "Project Name"
                           (IF v13
                              v13
                              (SETQ v13 "Test Project")
                           )
                           (+ 1)
                           T
             )
   )
   (SETQ gsw:130:VarValues '()
         gsw:130:VarValues (kb:SetGlobalPairsList 130-VarNames)
   )
   ;;
   ;; debug print values
   (PRINC "\nRoutine Closing")
   (kb:princDottedList gsw:130:VarValues)
   ;;
   ;;
   ;;
   (PRINC)
)

Library Routines :

Code: [Select]
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:GetAss <dottedPairKey> <dottedPairData>
 (setq ent (car (nentsel)))   < select line >
 (kb:GetAss 10 (entget ent))  < line startpoint : value of DXF dotted-pair 10 >
 => (17.3073 729.017 0.0)      < Point List >
|;

(DEFUN kb:GetAss (key                             ;dottedPair key
                  data                            ;dottedPair List
                  /
                 )
   (CDR (ASSOC key data))
)


;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:PointToString (<pt><xmode><xprec>)

Revised Library : kwb 20051031
Build 2.0 :

|;
(DEFUN kb:PointToString (pt                       ;  point list ... assumed valid 3D Point
                         xmode                    ;  Units to use , default to "LUNITS" if nil
                         xprec                    ;  Display precision , default to "LUPREC" if nil
                        )
   (OR xmode (SETQ xmode (GETVAR "LUNITS")))
   (OR xprec (SETQ xprec (GETVAR "LUPREC")))
   (IF pt
      (STRCAT (RTOS (CAR pt) xmode xprec)
              ","
              (RTOS (CADR pt) xmode xprec)
              ","
              (RTOS (CADDR pt) xmode xprec)
      )
   )
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;; (kb:princDottedList <DottedPairList> )

(DEFUN kb:princDottedList (PairsList)
   (PRINC "\n")
   (FOREACH Pair PairsList
      (PRINC
         (STRCAT (CAR Pair) " :: " (VL-PRIN1-TO-STRING (CADR Pair)) "\n")
      )
   )
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;; (kb:SetGlobalPairsList <VariableNamesList>)

(DEFUN kb:SetGlobalPairsList (VarNames / tmp)
   (MAPCAR '(LAMBDA (varname)
               (SETQ tmp
                       (CONS (LIST varname (VL-SYMBOL-VALUE (READ varname))) tmp)
               )
            )
           VarNames
   )
   (REVERSE tmp)
)




;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;; (kb:RestoreVariable "V1" sw:125:VarValues)
(DEFUN kb:RestoreVariable (Var VarList /)
   (CAR (SET (READ Var) (kb:getass Var VarList)))
)

;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;; (kb:RestoreVariables <DottedPairList>)
(DEFUN kb:RestoreVariables (VarList /)
   (MAPCAR '(LAMBDA (var) (SET (READ (CAR var)) (CADR var))) VarList)
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;; (kb:AssertSavedVariables sw:125:VarValues)
(DEFUN kb:AssertSavedVariables (VarList /)
   (MAPCAR '(LAMBDA (var)
               (OR (VL-SYMBOL-VALUE (READ (CAR var)))
                   (SET (READ (CAR var)) (CADR var))
               )
            )
           VarList
   )
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
Code: [Select]
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:getString (<Promptmsg><Default><InitBit><AllowSpaces>)

Revised Library : kwb 20051031
20051101 kwb : ESC test added.
Build 2.0 :

(SETQ tmpVal (kb:getString "Lot Description" nil (+ 1 ) T))
(SETQ tmpVal (kb:getString "Name" "Me" (+ 1 ) Nil))
(SETQ tmpVal (kb:getString nil nil nil Nil))
|;

(DEFUN kb:getString (Promptmsg                    ; The prompt string.
                     Default                      ; Value to return if response is <enter>
                     InitBit                      ; Initget bit
                     AllowSpaces                  ; spaces Flag < T or nil )
                                                  ;
                     / returnvalue)
   ;;------------------------------
   (OR InitBit (SETQ InitBit 0))
   ;;------------------------------
   (SETQ Promptmsg (STRCAT "\n"
                           (COND (Promptmsg)
                                 ("Specify String Value")
                           )
                   )
   )
   ;;------------------------------
   (IF (AND Default (= (TYPE Default) 'str) (/= Default ""))
      (PROGN
         (SETQ Promptmsg (STRCAT "\n" Promptmsg " << " Default " >>: "))
         (IF (VL-CATCH-ALL-ERROR-P
                (SETQ returnvalue (VL-CATCH-ALL-APPLY
                                     'GETSTRING
                                     (LIST AllowSpaces Promptmsg)
                                  )
                )
             )
            ;; ESC was pressed.
            (SETQ ReturnValue nil
                  Default nil
            )
         )
         (SETQ returnvalue (IF (= returnvalue "")
                              Default
                              returnvalue
                           )
         )
      )
      ;; Else no default, so don't accept ENTER or SPACEBAR
      ;;
      (PROGN (SETQ Promptmsg (STRCAT "\n" Promptmsg ": "))
             (IF (= InitBit 1)
                (WHILE (= ""
                          (SETQ returnvalue (VL-CATCH-ALL-APPLY
                                               'GETSTRING
                                               (LIST AllowSpaces Promptmsg)
                                            )
                          )
                       )
                )
                ;;
                (SETQ returnvalue
                        (VL-CATCH-ALL-APPLY 'GETSTRING
                                            (LIST AllowSpaces Promptmsg)
                        )
                )
             )
             (IF (VL-CATCH-ALL-ERROR-P returnvalue)
                ;; ESC was pressed.
                (SETQ ReturnValue nil)
             )
      )
   )
   ;;------------------------------
   returnvalue
)

;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:getReal (<Promptmsg><Default><InitBit><KeyWordList>)

Revised Library : kwb 20051031
20051101 kwb : ESC test added.
Build 2.0 :

(SETQ tmpVal (kb:getReal "Percentage of Load" 75.0 (+ 1 2 4) '("Default" "To-suit")))
(SETQ tmpVal (kb:getReal nil nil nil nil))
|;

(DEFUN kb:getReal (Promptmsg                      ; The prompt string.
                   Default                        ; Value to return if response is <enter>
                   InitBit                        ; Initget bit
                   KeyWordList                    ; Initget keywords List of strings
                                                  ;
                   /              InitString
                   KeyWordString  returnvalue
                  )
   ;;------------------------------
   (OR InitBit (SETQ InitBit 0))
   ;;------------------------------
   (IF KeyWordList
      (SETQ InitString    (SUBSTR
                             (APPLY 'STRCAT
                                    (MAPCAR '(LAMBDA (item) (STRCAT " " item))
                                            KeyWordList
                                    )
                             )
                             2
                          )
            KeyWordString (STRCAT " ["
                                  (VL-STRING-TRANSLATE " " "/" InitString)
                                  "]"
                          )
      )
      (SETQ InitString ""
            KeyWordString ""
      )
   )
   ;;------------------------------
   (SETQ
      Promptmsg (STRCAT "\n"
                        (COND (Promptmsg)
                              ("Specify Real Value")
                        )
                        KeyWordString
                        (IF (AND Default (NUMBERP Default))
                           (PROGN (SETQ InitBit (LOGAND InitBit (~ 1)))
                                  (STRCAT " << " (RTOS Default 2) " >>")
                           )
                           ""
                        )
                        ": "
                )
   )
   ;;------------------------------
   (INITGET InitBit InitString)
   (IF
      (VL-CATCH-ALL-ERROR-P
         (SETQ returnvalue (VL-CATCH-ALL-APPLY 'GETREAL (LIST Promptmsg)))
      ) ;; ESC was pressed.
        (SETQ ReturnValue nil
              Default nil
        )
   )
   (IF returnvalue
      returnvalue
      def
   )
)

;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:getInt (<Promptmsg><Default><InitBit><KeyWordList>)

Revised Library : kwb 20051031
20051101 kwb : ESC test added.
Build 2.0 :

(SETQ tmpVal (kb:getInt "How many" 1 (+ 1 2 4) '("Default" "To-suit")))
(SETQ tmpVal (kb:getInt nil nil nil nil))
|;

(DEFUN kb:getInt (Promptmsg                       ; The prompt string.
                  Default                         ; Value to return if response is <enter>
                  InitBit                         ; Initget bit
                  KeyWordList                     ; Initget keywords List of strings
                                                  ;
                  /              InitString
                  KeyWordString  returnvalue
                 )
   ;;------------------------------
   (OR InitBit (SETQ InitBit 0))
   ;;------------------------------
   (IF KeyWordList
      (SETQ InitString    (SUBSTR
                             (APPLY 'STRCAT
                                    (MAPCAR '(LAMBDA (item) (STRCAT " " item))
                                            KeyWordList
                                    )
                             )
                             2
                          )
            KeyWordString (STRCAT " ["
                                  (VL-STRING-TRANSLATE " " "/" InitString)
                                  "]"
                          )
      )
      (SETQ InitString ""
            KeyWordString ""
      )
   )
   ;;------------------------------
   (SETQ
      Promptmsg (STRCAT "\n"
                        (COND (Promptmsg)
                              ("Specify Integer Value")
                        )
                        KeyWordString
                        (IF (AND Default (= (TYPE Default) 'int))
                           (PROGN (SETQ InitBit (LOGAND InitBit (~ 1)))
                                  (STRCAT " << " (ITOA Default) " >>")
                           )
                           ""
                        )
                        ": "
                )
   )
   ;;------------------------------
   (INITGET InitBit InitString)
   (IF (VL-CATCH-ALL-ERROR-P
          (SETQ returnvalue (VL-CATCH-ALL-APPLY 'GETINT (LIST Promptmsg)))
       )
      ;; ESC was pressed.
      (SETQ ReturnValue nil
            Default nil
      )
   )
   (IF returnvalue
      returnvalue
      Default
   )
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;| #lib.
kb:getpoint (<Promptmsg><Default><InitBit><KeyWordList><BasePoint>)

Revised Library : kwb 20051031
20051101 kwb : ESC test added.
Build 2.0 :

(SETQ tmpVal (kb:getpoint "WorkPoint"
                          '(200 100 0)
                          (+ 1 8)
                          '("BasePoint" "Apex")
                          '(0 0 0)
             )
)
|;

(DEFUN kb:getpoint (Promptmsg                     ; The prompt string.
                    Default                       ; return Value if <user enter>
                    InitBit                       ; Initget bit
                    KeyWordList                   ; Initget keywords List of strings
                    BasePoint                     ; Base point < or nil >
                                                  ;
                    /               PromptMessage
                    InitString      KeyWordString
                    ReturnValue     ParameterList
                   )
   ;;------------------------------
   (OR InitBit (SETQ InitBit 0))
   ;;------------------------------
   (IF KeyWordList
      (SETQ InitString    (SUBSTR
                             (APPLY 'STRCAT
                                    (MAPCAR '(LAMBDA (item) (STRCAT " " item))
                                            KeyWordList
                                    )
                             )
                             2
                          )
            KeyWordString (STRCAT " ["
                                  (VL-STRING-TRANSLATE " " "/" InitString)
                                  "]"
                          )
      )
      (SETQ InitString ""
            KeyWordString ""
      )
   )
   ;;------------------------------
   (SETQ PromptMessage
           (STRCAT
              "\n"
              (COND (Promptmsg)
                    ("Specify Point")
              )
              KeyWordString
              (IF Default
                 (PROGN
                    (SETQ InitBit (LOGAND InitBit (~ 1)))
                    (IF (= (TYPE Default) 'str)
                       (STRCAT " <<" Default ">>")
                       ;;
                       ;; else, assume it is a point .. user beware
                       (STRCAT " <<"
                               (kb:PointToString Default nil nil)
                               ">>"
                       )
                    )
                 )
                 ""
              )
              ": "
           )
   )
   ;;------------------------------
   (INITGET InitBit InitString)
   (IF (VL-CATCH-ALL-ERROR-P
          (SETQ ReturnValue (VL-CATCH-ALL-APPLY
                               'GETPOINT
                               (IF BasePoint
                                  (LIST PromptMessage BasePoint)
                                  (LIST PromptMessage)
                               )
                            )
          )
       )
      ;; ESC was pressed.
      (SETQ ReturnValue nil
            Default nil
      )
   )
   (IF ReturnValue
      ReturnValue
      Default
   )
)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
« Last Edit: April 30, 2006, 12:37:26 AM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

ronjonp

  • Needs a day job
  • Posts: 7527
Re: ( CHALLENGE ) Remembering Variables.
« Reply #1 on: April 18, 2006, 10:40:58 AM »
Quote
(DEFUN kb:GetAss
  :lmao:

Sorry...I just thought this was hilarious. Back to the regularly scheduled program.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ( CHALLENGE ) Remembering Variables.
« Reply #2 on: April 18, 2006, 08:22:06 PM »
yep, and no animals were injured during it's development.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

LE

  • Guest
Re: ( CHALLENGE ) Remembering Variables.
« Reply #3 on: April 18, 2006, 10:24:37 PM »
I used normally an INI file, that can be portable between stations.... also on some of my old ODCL routines, I did the following:

Code: [Select]
;;; (dtt-write-dialog-data "Iwin" "Window Width" iwin_window_width)
(defun dtt-write-dialog-data  (cmd_name key value)
  ;; salvar el dato solo si esta presente y sea string
  (if (and value (eq (type value) 'str))
    (vl-registry-write
      (strcat
"HKEY_CURRENT_USER\\Software\\AxisCADD Software\\Draftteam\\Data\\"
cmd_name)
      key
      value)))

;;;---------------------------------------------------------

(defun dtt-read-dialog-data  (cmd_name key)
  (vl-registry-read
    (strcat
      "HKEY_CURRENT_USER\\Software\\AxisCADD Software\\Draftteam\\Data\\"
      cmd_name)
    key))

Then inside of one of the routine command:

Code: [Select]
(defun idoor-read-dialog-data
       (/ door_types frame_values wall_position)

  (setq idoor_door_width (dtt-read-dialog-data "Idoor" "Door Width"))

  (setq idoor_doorname (dtt-read-dialog-data "Idoor" "Door Name"))

  (setq idoor_pos_scrollbar1
(atoi (dtt-read-dialog-data
"Idoor"
"Door Image")))

  (if (eq (dtt-read-dialog-data "Idoor" "Door Opening") "0")
    (setq idoor_opening nil)
    (setq idoor_opening t))

  (setq door_types
(mapcar 'read
(rcmd-string-to-list
   (dtt-read-dialog-data "Idoor" "Door Types")
   ",")))

  (setq idoor_new_Value (car door_types))
  (setq idoor_demo_Value (cadr door_types))
  (setq idoor_exist_Value (caddr door_types))

  (setq frame_values
(mapcar 'read
(rcmd-string-to-list
   (dtt-read-dialog-data "Idoor" "Door Frame")
   ",")))

  (setq idoor_none_value (car frame_values))
  (setq idoor_2_value (cadr frame_values))
  (setq idoor_4_value (caddr frame_values))

  (setq wall_position
(mapcar
   'read
   (rcmd-string-to-list
     (dtt-read-dialog-data "Idoor" "Wall Position")
     ",")))

  (setq idoor_centered_value (car wall_position))
  (setq idoor_pointx_value (cadr wall_position))

  (setq idoor_corner_ref
(dtt-read-dialog-data "Idoor" "Corner Reference")))

Code: [Select]
(defun idoor-write-dialog-data ()

  ;; salvar el dato del ancho de la puerta
  (dtt-write-dialog-data
    "Idoor"
    "Door Width"
    idoor_door_width)

  ;; door name
  (dtt-write-dialog-data "Idoor" "Door Name" idoor_doorname)

  ;; numero de posicion de la imagen
  (dtt-write-dialog-data
    "Idoor"
    "Door Image"
    (itoa idoor_pos_scrollbar1))

  ;; ya que "idoor_opening" es T o nil usar "1" "0"
  ;; despues cambiarlo al leerlo por T o nil
  (dtt-write-dialog-data
    "Idoor"
    "Door Opening"
    (if idoor_opening
      "1"
      "0"))

  ;; opciones NEW-DEMO-EXIST
  (cond
    ;; new
    ((eq idoor_new_Value 0)
     (dtt-write-dialog-data "Idoor" "Door Types" "0,-1,-1"))

    ;; demo
    ((eq idoor_demo_Value 0)
     (dtt-write-dialog-data "Idoor" "Door Types" "-1,0,-1"))

    ;; exist
    ((eq idoor_exist_Value 0)
     (dtt-write-dialog-data "Idoor" "Door Types" "-1,-1,0")))

  ;; opciones NONE-2-4
  (cond
    ;; none
    ((eq idoor_none_value 0)
     (dtt-write-dialog-data "Idoor" "Door Frame" "0,-1,-1"))

    ;; 2"
    ((eq idoor_2_value 0)
     (dtt-write-dialog-data "Idoor" "Door Frame" "-1,0,-1"))

    ;; 4"
    ((eq idoor_4_value 0)
     (dtt-write-dialog-data "Idoor" "Door Frame" "-1,-1,0")))

  ;; opciones CENTERED-POINTX
  (cond
    ;; centered
    ((eq idoor_centered_value 0)
     (dtt-write-dialog-data "Idoor" "Wall Position" "0,-1"))

    ;; point-x
    ((eq idoor_pointx_value 0)
     (dtt-write-dialog-data "Idoor" "Wall Position" "-1,0")))

  ;; distancia a la esquina de un muro
  (dtt-write-dialog-data
    "Idoor"
    "Corner Reference"
    idoor_corner_ref))

And on the exit button or apply or as part of reactor just do something:

Code: [Select]
;;; boton exit
(defun c:idoorForm_TextButton1_OnClicked  ()

  (Setq idoor_door_width
(Odcl_Control_GetText
   (vl-doc-ref 'draftteam_idoorForm_ComboBox2)))

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

  (Setq idoor_doorname
(Odcl_Control_GetText
   (vl-doc-ref 'draftteam_idoorForm_ComboBox1)))

;;;=========================================================
;;; type

  (setq idoor_new_Value
(Odcl_OptionList_getCurSel
   (vl-doc-ref 'draftteam_idoorForm_OptionList1)))
  (setq idoor_demo_Value
(Odcl_OptionList_getCurSel
   (vl-doc-ref 'draftteam_idoorForm_OptionList2)))
  (setq idoor_exist_Value
(Odcl_OptionList_getCurSel
   (vl-doc-ref 'draftteam_idoorForm_OptionList3)))

  ;; generar la variable global para saber que tipo de puerta
  ;; se va instalar
  (setq idoor_door_type
(cond
   (idoor_new_value "NEW-")
   (idoor_demo_value "DEMO-")
   (idoor_exist_value "EXIST-")))
. . .
(idoor-write-dialog-data)
  )

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ( CHALLENGE ) Remembering Variables.
« Reply #4 on: April 19, 2006, 06:15:34 AM »
So that everyone is on the same page, here's a dialog and some control code.
.... I'd forgotten how long it's been since I've done DCL stuff  :lol:

The driver Code stuff
Code: [Select]
(DEFUN c:test05 (/
                 ;; Local Variables
                 dcl_id dcl_status tabNames
                 ;; Local Functions
                 Initialise CollectValues)
   ;; Global Variable Gd12_TestVariables
   ;;-------------
   ;;-------------
   (DEFUN Initialise (/)
      (SETQ tabNames '("d12-label1"       "d12-label2"
                       "d12-label3"       "d12-layerdefault"
                       "d12-layer"        "d12-textdefault"
                       "d12-text"         "d12-blockname"
                       "d12-toggle1"      "d12-toggle2"
                       "d12-toggle3"      "d12-toggle4"
                       "d12-o1"           "d12-o2"
                       "d12-o3"
                      )
      )
      ;; collect layer names etc
      ;; .. and do other stuff
      ;;
      (IF (NOT d12-label3)
         (SET_TILE "d12-label3" "Stuff goes here .. perhaps")
      )
   )
   ;;-------------
   (DEFUN CollectValues (/ tmp)
      ;;
      (SETQ Gd12_TestVariables '())
      (MAPCAR
         '(LAMBDA (tab) (SETQ tmp (CONS (LIST tab (GET_TILE tab)) tmp)))
         tabNames
      )
      (SETQ Gd12_TestVariables (REVERSE tmp))
      (DONE_DIALOG 1)
   )
   ;;-------------
   (IF (OR (MINUSP (SETQ dcl_id (LOAD_DIALOG "d12_Test")))
           (NOT (NEW_DIALOG "d12_test_main" dcl_id))
       )
      (PROGN (ALERT "Unable to load/display dialog 'd12_Test' ") (EXIT))
   )
   (SETQ dcl_status 10)
   ;;-------------
   (Initialise)
   (WHILE (= dcl_status 10)     
      (ACTION_TILE "accept" "(CollectValues)")
      (ACTION_TILE "cancel" "(done_dialog 0)")
      (SETQ dcl_status (START_DIALOG))
   )
   ;;-------------
   (COND ((= dcl_status 0) (ALERT "Time to go Home ?? "))
         ((= dcl_status 1) (ALERT "Soldier on ...  "))
   )
   (PRINC)
)
(princ)

The DCL code :
Code: [Select]
//  d12_test.DCL
//  general dcl settings
//  kwb@theSwamp

dcl_settings : default_dcl_settings

{ audit_level = 3; }

//
//  sub-assembly definitions
//

d_edit_box40 : edit_box { edit_width = 45; edit_limit = 40; }
d_edit_box20 : edit_box { edit_width = 25; edit_limit = 20; }
d_edit_box15 : edit_box { edit_width = 20; edit_limit = 15; }

d_command : button { width = 20; fixed_width = true; }
d_edit_box_numbers : edit_box { edit_width = 10; edit_limit = 20;}

d_pop_list   : popup_list { edit_width = 30;}


//
// Test dialog
//
d12_test_main : dialog { label = "Testing Dialog Stuff  ";
: boxed_row {
label = " Saving Value Sample Development exercise at the Swamp ...  kwb 20060419:v01.1";
: boxed_column {
label = "Title Fields";
: d_edit_box40 { key = "d12-label1"; label = "Label Line 1"; }
: d_edit_box40 { key = "d12-label2"; label = "Label Line 2"; }
: d_edit_box20 { key = "d12-label3"; label = "Label Line 3"; }     
spacer_1;

: boxed_column {
label = "Default Properties";
: row {
: toggle { key = "d12-layerdefault"; label = "Use Current Layer"; value = "0"; }
: d_pop_list { key = "d12-layer";  }
}
: row {
: toggle { key = "d12-textdefault"; label = "Use Current TextStyle"; value = "1"; }
: d_pop_list { key = "d12-text"; is_enabled = false; }       
}       
}
}

: boxed_column {
label = "Insertion Location Control";
: d_pop_list { key = "d12-blockname"; label = "Block Name "; }       
: row {
: boxed_column {
alignment = centered ;
: toggle { key = "d12-toggle1" ; label = "Toggle 01" ;}
: toggle { key = "d12-toggle2" ; label = "Toggle 02" ;}
: toggle { key = "d12-toggle3" ; label = "Toggle 03" ;}
: toggle { key = "d12-toggle4" ; label = "Toggle 04" ;}
}
spacer;
:column {
width = 25 ;
fixed_width = true ;       
: d_command { key = "d12-insert"; label = "Insert Point ..."; is_enabled = false; }
: d_edit_box_numbers { key = "d12-xorigin"; label = "&XOrigin "; is_enabled = false; }
: d_edit_box_numbers { key = "d12-yorigin"; label = "&YOrigin "; is_enabled = false; }
: d_edit_box_numbers { key = "d12-zorigin"; label = "&ZOrigin "; is_enabled = false; }
}
}
: boxed_radio_row {
key = "d12-option" ;
label = "Choose Quantity";
: radio_button { key = "d12-o1"; label = "One"; value = "1";}
: radio_button { key = "d12-o2"; label = "Two"; }
: radio_button { key = "d12-o3"; label = "Three"; }
}
}
}
spacer_1;
ok_cancel;
}
// end d12_test_main   

This is the Global Variable value  after the first run sucessful through ..
Quote
(("d12-label1" "")
 ("d12-label2" "")
 ("d12-label3" "Stuff goes here .. perhaps")
 ("d12-layerdefault" "0")
 ("d12-layer" "")
 ("d12-textdefault" "1")
 ("d12-text" "")
 ("d12-blockname" "")
 ("d12-toggle1" "0")
 ("d12-toggle2" "0")
 ("d12-toggle3" "0")
 ("d12-toggle4" "0")
 ("d12-o1" "1")
 ("d12-o2" "0")
 ("d12-o3" "0")
)



... and a Piccy ..
« Last Edit: April 19, 2006, 07:32:07 AM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

jbuzbee

  • Swamp Rat
  • Posts: 851
Re: ( CHALLENGE ) Remembering Variables.
« Reply #5 on: April 19, 2006, 12:46:05 PM »
Luis - I use the registry pretty extensively as well - and not just for ODCL!

jb
James Buzbee
Windows 8

GDF

  • Water Moccasin
  • Posts: 2081
Re: ( CHALLENGE ) Remembering Variables.
« Reply #6 on: April 19, 2006, 02:17:00 PM »
Luis - I use the registry pretty extensively as well - and not just for ODCL!

jb

Here is how I store globals...

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: ( CHALLENGE ) Remembering Variables.
« Reply #7 on: April 20, 2006, 07:28:00 AM »
I've used files and the registry. If I were to share one here I'd probably write a new one that harvested code from the "Globals, oh my ..." post (localizing thusly) and use a structured ini file type scheme as it's more portable.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ( CHALLENGE ) Remembering Variables.
« Reply #8 on: April 20, 2006, 08:13:43 AM »
Oh, my goodness .. that was only a year ago and I'd forgotten about it ... at least my pholospohy hasn't altered much .. should be thankfull for small mercies I s'pose.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ( CHALLENGE ) Remembering Variables.
« Reply #9 on: April 21, 2006, 06:37:20 AM »
For anyone following along, here's a possible next step ..

Read and load the Layer Names, TextStyle Names and Block Names into their combo-lists

Run the modified Routine and Save the variable list at completion .. in this case into the ACAD.CFG file, just to show one option.


Restore the saved variable List as proof of concept.

edit : MODIFIED as noted kwb 20060423

Code: [Select]
(DEFUN c:test06 (/
                 ;; Local Variables
                 dcl_id               dcl_status
                 tabNames             ld12-LayerList
                 ld12-TextStyleList   ld12-BlockNameList
                 ;; Local Functions
                 d12:Initialise       d12:CollectValues
                 d12:initialise-Lists
                )
   ;; Global Variable Gd12_TestVariables
   ;;-------------
   ;;--------------------------
   (DEFUN d12:Initialise (/)
      (SETQ tabNames '("d12-label1"       "d12-label2"
                       "d12-label3"       "d12-layerdefault"
                       "d12-layer"        "d12-textdefault"
                       "d12-text"         "d12-blockname"
                       "d12-toggle1"      "d12-toggle2"
                       "d12-toggle3"      "d12-toggle4"
                       "d12-option"       "d12-o1"
                       "d12-o2"           "d12-o3"
                      )
      )
      ;;
      ;;------------- Confirm global document variables
      ;;
      (OR kg:IAcadApplication
          (SETQ kg:IAcadApplication (VLAX-GET-ACAD-OBJECT))
      )
      (OR kg:IAcadDocument
          (SETQ kg:IAcadDocument  (VLA-GET-ACTIVEDOCUMENT kg:IAcadApplication))      ;;<  modified kwb 20060423  
      )
      ;;
      ;;------------- collect layer names and load into dcl combo
      ;;
      (SETQ ld12-LayerList
              (REVERSE (VLAX-FOR each
                                 (VLA-GET-LAYERS kg:IAcadDocument)
                          (SETQ itemname       (VLA-GET-NAME each)
                                ld12-LayerList (CONS itemname
                                                     ld12-LayerList
                                               )
                          )
                       )
              )
      )
      (START_LIST "d12-layer")
      (MAPCAR 'ADD_LIST ld12-LayerList)
      (END_LIST)
      ;;
      ;;------------- collect TextStyle names and load into dcl combo
      ;;
      (SETQ ld12-TextStyleList
              (REVERSE (VLAX-FOR each (VLA-GET-TEXTSTYLES
                                         kg:IAcadDocument
                                      )
                          (SETQ itemname           (VLA-GET-NAME each)
                                ld12-TextStyleList (CONS
                                                      itemname
                                                      ld12-TextStyleList
                                                   )
                          )
                       )
              )
      )
      (START_LIST "d12-text")
      (MAPCAR 'ADD_LIST ld12-TextStyleList)
      (END_LIST)
      ;;
      ;;------------- collect Block names and load into dcl combo
      ;;
      (SETQ ld12-BlockNameList
              (REVERSE
                 (VL-REMOVE-IF
                    ;; remove anonomous and **space blocks
                    ;;
                    '
                     (LAMBDA (x) (= "*" (SUBSTR x 1 1)))
                    (VLAX-FOR each
                              (VLA-GET-BLOCKS kg:IAcadDocument
                              )
                       (SETQ
                          itemname           (VLA-GET-NAME each)
                          ld12-BlockNameList (CONS
                                                itemname
                                                ld12-BlockNameList
                                             )
                       )
                    )
                 )
              )
      )
      (START_LIST "d12-blockname")
      (MAPCAR 'ADD_LIST ld12-BlockNameList)
      (END_LIST)
      ;;
      ;;-------------
      ;;
      ;; .. and do other stuff
      ;;
      (IF (NOT d12-label3)
         (SET_TILE "d12-label3" "Stuff goes here .. perhaps")
      )
   )
   ;;--------------------------
   ;;
   ;;--------------------------
   (DEFUN d12:CollectValues (/ tmp)
      ;;
      (SETQ Gd12_TestVariables '())
      (MAPCAR
         '(LAMBDA (tab) (SETQ tmp (CONS (LIST tab (GET_TILE tab)) tmp)))
         tabNames
      )
      (SETQ Gd12_TestVariables (REVERSE tmp))
      ;;
      ;; save the values to the .CFG file
      (SETCFG "appdata/kwb/SavedVariables/d12TestApp"
              (VL-PRIN1-TO-STRING Gd12_TestVariables)
      )
      ;;
      (DONE_DIALOG 1)
   )
   ;;--------------------------
   ;;
   ;;--------------------------   
   (IF (OR (MINUSP (SETQ dcl_id (LOAD_DIALOG "d12_Test")))
           (NOT (NEW_DIALOG "d12_test_main" dcl_id))
       )
      (PROGN (ALERT "Unable to load/display dialog 'd12_Test' ") (EXIT))
   )
   (SETQ dcl_status 10)
   ;;-------------
   (d12:Initialise)
   (WHILE (= dcl_status 10)
      ;; (Initialise)
      (ACTION_TILE "accept" "(d12:CollectValues)")
      (ACTION_TILE "cancel" "(done_dialog 0)")
      (SETQ dcl_status (START_DIALOG))
   )
   ;;-------------
   ;;
   ;;-------------   
   (COND ((= dcl_status 0) (ALERT "Time to go Home ?? "))
         ((= dcl_status 1) (ALERT "Soldier on ...  "))
   )
   (PRINC)
)
(princ)

Check the Application Global Variable ...
(kb:princDottedList Gd12_TestVariables )
;; returns
d12-label1 :: "Line ONE"
d12-label2 :: "Line TWO"
d12-label3 :: "Line THREE"
d12-layerdefault :: "0"
d12-layer :: "7"
d12-textdefault :: "1"
d12-text :: "0"
d12-blockname :: "0"
d12-toggle1 :: "0"
d12-toggle2 :: "0"
d12-toggle3 :: "1"
d12-toggle4 :: "0"
d12-option :: "d12-o2"
d12-o1 :: "0"
d12-o2 :: "1"
d12-o3 :: "0"


... and lets check the saved CFG values
(kb:princDottedList (READ (GETCFG "appdata/kwb/SavedVariables/d12TestApp")) )
;; returns
d12-label1 :: "Line ONE"
d12-label2 :: "Line TWO"
d12-label3 :: "Line THREE"
d12-layerdefault :: "0"
d12-layer :: "7"
d12-textdefault :: "1"
d12-text :: "0"
d12-blockname :: "0"
d12-toggle1 :: "0"
d12-toggle2 :: "0"
d12-toggle3 :: "1"
d12-toggle4 :: "0"
d12-option :: "d12-o2"
d12-o1 :: "0"
d12-o2 :: "1"
d12-o3 :: "0"



... and a piccy of the data as entered ...
« Last Edit: April 22, 2006, 07:39:09 PM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Jim Yadon

  • Guest
Re: ( CHALLENGE ) Remembering Variables.
« Reply #10 on: April 21, 2006, 06:50:04 AM »
Hey Kerry.

I just wanted to thank you for this shiny object you've posted. I never really got into LISP or DCL as far as I wanted to. The VBAIDE was just so shiny it called me from afar. I may drop back and punt with VLISP now that I am finding more time to work on my coding projects.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: ( CHALLENGE ) Remembering Variables.
« Reply #11 on: April 21, 2006, 06:50:18 AM »
My pleasure Jim.
This may turn into a reasonable resource :-)




Anyone have  comments or questions ? ?
« Last Edit: April 21, 2006, 06:53:38 AM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

DEVITG

  • Bull Frog
  • Posts: 479
Re: ( CHALLENGE ) Remembering Variables.
« Reply #12 on: April 22, 2006, 11:31:09 AM »
Hi Kelly
I did a test on c:test06

but it ask for this  defun

KDUB:IACADAPPLICATION

located here

Code: [Select]
;;------------- Confirm global document variables
      ;;
      (OR kg:IAcadApplication
          (SETQ kg:IAcadApplication (VLAX-GET-ACAD-OBJECT))
      )
      (OR kg:IAcadDocument
          (SETQ kg:IAcadDocument
                  (VLA-GET-ACTIVEDOCUMENT (kdub:iacadapplication)
                  )
          )
      )
      ;;



Am I doing, some thing wrong??? :oops:
Location @ Córdoba Argentina Using ACAD 2019  at Window 10

Tom

  • Guest
Re: ( CHALLENGE ) Remembering Variables.
« Reply #13 on: April 22, 2006, 12:02:00 PM »
Quote
Am I doing, some thing wrong???


Could it be calling Kerry Kelly

LE

  • Guest
Re: ( CHALLENGE ) Remembering Variables.
« Reply #14 on: April 22, 2006, 12:05:56 PM »
Code: [Select]
;;------------- Confirm global document variables
      ;;
      (OR kg:IAcadApplication
          (SETQ kg:IAcadApplication (VLAX-GET-ACAD-OBJECT))
      )
      (OR kg:IAcadDocument
          (SETQ kg:IAcadDocument
                  (VLA-GET-ACTIVEDOCUMENT (kg:IAcadApplication) ;; <<<<<<change to this
                  )
          )
      )
      ;;

It is just a minor typing.....