Jump to content

Learning DCL


spiker7221

Recommended Posts

I've just started to learn DCL. Very cool. But I'm stuck. I can't seem to get my tile value to re-calculate itself via my formulas when the user enters their new choices. I may just have something in the wrong order.

 

LISP below:

 

(defun C:testdcl (/ lu lp)

(setq lu (getvar "LUNITS"))
(setq lp  (getvar "LUPREC"))

 (setq dcl_id (load_dialog "ConcTO.dcl"))
 (if (not (new_dialog "ConcTO" dcl_id))
   (exit)
 );if

;------------------- set up dialogue box default settings ----------------------

   (if (not b_depth)
       (setq b_depth "18.0")
   );end if

   (if (not s_thick)
       (setq s_thick "6.0")
   );end if
   
;------------------- set dialogue box default values ----------------------

   (set_tile "beam_depth" b_depth)
   (set_tile "slab_thick" s_thick)

   (set_tile "beam_area" (rtos (/ fBeamArea 144.0) 2 lp))
   (set_tile "slab_area" (rtos (/ fSlabArea 144.0) 2 lp))

   (setq tBeamDepth (get_tile "beam_depth"))
   (setq BeamDepth (atoi tBeamDepth))

   (setq tSlabThick (get_tile "slab_thick"))
   (setq SlabThick (atoi tSlabThick))
   
   (set_tile "beam_volume" (rtos (setq BeamVolume (/ (* fBeamArea BeamDepth) 1728.0 27.0)) 2 lp))
   (set_tile "slab_volume" (rtos (setq SlabVolume (/ (* fSlabArea SlabThick) 1728.0 27.0) 2 lp)))

;------------------- retrieve dialogue box values ----------------------

   (action_tile "beam_depth" "(setq beam_depth $value)")
   (action_tile "s_thick" "(setq slab_thick $value)")

   (action_tile "beam_area" "(setq beam_area $value)")
   (action_tile "beam volume" "(setq beam_volume $value)")

   (action_tile "s_area" "(setq slab_area $value)")
   (action_tile "slab volume" "(setq slab_vol $value)")
   
   (action_tile "ok" "(done_dialog 1)")
   (action_tile "cancel"  "(done_dialog 0)")
(start_dialog)
(unload_dialog dcl_id)
 
(princ)
);defun

DCL below:

ConcTO : dialog {
label = "CES Concrete takeoff calculator";
: boxed_column{
label ="Dimensions";
: edit_box {
key = "beam_depth";
label = "Beam depth (inches)";
edit_width = 8;
edit_limit = 8;
allow_accept = true;
}
: edit_box {
key = "slab_thick";
label = "Slab thickness (inches)";
edit_width = 8;
edit_limit = 8;
allow_accept = true;
}
}
: row{
label ="Area / Volume computations";
: boxed_column{
: text_part{
label ="Beam Area (sq.ft)";
}
: text_part{
label ="Beam Volume (cu.yards)";
}
spacer_1;
: text_part{
label ="Slab Area (sq.ft)";
}
: text_part{
label ="Slab Volume (cu.yards)";
}
spacer_1;
}
: boxed_column{
: text_part{
key ="beam_area";
width=20;
}
: text_part{
key ="beam_volume";
width=20;
}
spacer_1;
: text_part{
key ="slab_area";
width=20;
}
: text_part{
key ="slab_volume";
width=20;
}
spacer_1;
}
}
ok_cancel ;
:text_part {
label = "Designed and Created";
}
:text_part {
label = "by Mike Bronson: Copyright (C) CES Global 2014";
}
}

Any help would be much appreciated.

Thanks,

Mike in Dallas

Link to comment
Share on other sites

If you want things to update as user enters data, then you need to do another "set_tile" for the updated values within the "action_tile".

 

Additionally all values returned at the "action_tile" are returned as a string, you must translate them to an integer or real number prior to performing any mathematical operations with them.

 

example;

 

(action_tile "test" "(setq testval (atoi ($value)) newval (* testval 2)) (set_tile \"newval\" (itoa testval))")

 

Also notice any quotes required in the body of the action_tile" must be preceded by \.

Link to comment
Share on other sites

(action_tile "test" "(setq testval (atoi ($value)) newval (* testval 2)) (set_tile \"newval\" (itoa testval))")

 

Also notice any quotes required in the body of the action_tile" must be preceded by \.

 

Except the first argument? This is an area of uncertainty for many persons (myself included), not trying to nitpick.

Link to comment
Share on other sites

Sorry it took me so long to get back. Below is a DCL simple calculator that I created from the start of one by pBe and posted http://www.cadtutor.net/forum/showthread.php?67490-calculator-using-dcl-amp-lisp&p=463910&viewfull=1#post463910

 

, I trust pBe will not have any issues with the parts I borrowed.

 

This can be a great learning tool for any would be DCL programmers, as there are quite a few examples of just how the DCL works contained within.

 

Feel free to play with it, I tried to keep it faily straightforward so as not to scare off anyone.

 

;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;                                        ;
;    Original Code created by pBe and posted on CADTutor March 2012        ;
;                                        ;
;    Code overhauled to actually function March 2014 by FBF            ;
;                                        ;
;    I completed this code to be used as a learning tool for would be DCL    ;
;    programers.  I tried to keep the functions simple and straight forward    ;
;    the use of lambda/mapcar was avoided due to its advanced nature.    ;
;                                        ;
;    Feel free to use as a learning tool and expand as you see fit.        ;
;                                        ;
;_______________________________________________________________________________;


(defun c:SCalc ( / ActDoc    tmp    dcl_id    vls    lst     sTotal    V-SetL
          V-NameL    str    nmbr    nmbr2    lst2    nmbrs    nmbrs2    )  
 (vl-load-com)

 ; place whatever system variables you will be adjusting here
 ; to be sure they are reset properly, always leave the users
 ; system as it was before your function started.
 (setq V-NameL '(ctab clayer osmode trimmode attdia cecolor celtype texteval)    
   V-SetL   (mapcar 'getvar V-NameL)                    
   ActDoc   (vla-get-ActiveDocument (vlax-get-Acad-Object))        
   )

 ; if for some reason the system freaks out for any reason the
 ; user can always perform an undo to get back to where your
 ; function started.
 (vla-EndUndoMark ActDoc)
 (vla-StartUndoMark ActDoc)                            
                                         

;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;                                        ;
;    This ERROR Function Unloads DCL should the user hit cancel or escape    ;
;                                        ;
;        You also need to complete any unfinished business        ;
;            (for example deleting the DCL file            ;
;             and reseting system variables)                ;
;                                        ;

 (defun *error* ( msg )
   (and dcl_id (unload_dialog dcl_id))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   (princ (strcat "\n** Error: " msg " **"))
   )
   (mapcar 'setvar V-NameL V-SetL) 
   (vl-file-delete tmp)
   (princ "\n- Function Cancelled -")
   (princ)
   );defun
 
;                                        ;
;                END of ERROR Function                ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;                                        ;
;    This Function Writes/Creates the DCL Dialog in the Temp Folder        ;
;                                        ;
;    (the file gets created each time the function is run, the benefit    ;
;    of doing it this way is all related files are in the LISP function    ;
;    no extra files to move around.  Additionally the user cannot mess    ;
;    with the DCL file if LISP is encrypted.                    ;

 (defun writeCalCdcl (/ des tmp)            
   (setq tmp (vl-filename-mktemp nil nil ".dcl")
     des (open tmp "w")
     )
   (foreach line
      '("btn: button {  width = 6; height = 1.75; color= -1; }"
        "scalc"
        "  : dialog { label = \"\"; key = \"Title\";"
        "    spacer;"
        "    : boxed_column {"
        "      : text {key = \"Total\"; }"
        "    }"
        "    : boxed_column {"
        "      : row {"
        "        : btn { label = \"7\" ; key = \"7\" ; }"
        "        : btn { label = \"8\" ; key = \"8\" ; }"
        "        : btn { label = \"9\" ; key = \"9\";}"
        "        : btn { label = \"/\" ; key = \"idivide\";}"
        "      }"
        "      : row {"
        "        : btn { label = \"4\" ; key = \"4\";}"
        "        : btn { label = \"5\" ; key = \"5\";}"
        "        : btn { label = \"6\" ; key = \"6\";}"
        "        : btn { label = \"*\" ; key = \"imultiply\";}"
        "      }"
        "      : row {"
        "        : btn { label = \"1\" ; key = \"1\";}"
        "        : btn { label = \"2\" ; key = \"2\";}"
        "        : btn { label = \"3\" ; key = \"3\";}"
        "        : btn { label = \"-\" ; key = \"iminus\";}"
        "      }"
        "      : row {"
        "        : btn { label = \"0\" ; key = \"0\";}"
        "        : btn { label = \".\" ; key = \"idot\";}"
        "        : btn { label = \"C\" ; key = \"iCan\";}"
        "        : btn { label = \"+\" ; key = \"iplus\";}"
        "      }"
        "      spacer;"
        "    }"
        "    : boxed_column {"
        "      : row {"
        "        : btn { label = \"=\" ; key = \"iequal\";}"
        "        : text {key = \"T\"; label = \"\"; width = 20; alignment = right;}"
        "    }"
        "   spacer;"
        "  }"
        "  ok_only;"
        "  : errtile { width= 40; alignment = centered; }"         
        " }"
        )
     (write-line line des)
     );foreach
   (not (setq des (close des)))
   tmp
   );defun (writeCalCdcl)
 
;                                        ;
;            END of Write DCL Function                ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;    This Function "_values" contains a sub function "cnvrt-strglst-nmbr"    ;
;                                        ;
;    I put the subfunction here because I do not need it anywhere else.      ;
;                                        ;

 (defun Values (lst / )    
   (defun cnvrt-strglst-nmbr (lst / llst nmbr)
     (foreach x  lst
   (setq llst (append llst(vl-string->list x)))
   )
     (setq nmbr (vl-list->string llst))
     )
   
   (cond(
     (/=(vl-position "." lst)nil)
     (setq nmbr   (distof(cnvrt-strglst-nmbr lst))
       nmbrs  (Real->String nmbr)
       )
     )
    (
     (setq nmbr  (atoi (cnvrt-strglst-nmbr lst))
       nmbrs (itoa nmbr)
       )
     )
    )
   );defun (_values)

;                                        ;
;            END of values Function                    ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;        Since the MINUS sign can be used to signify a negative        ;
;        number or be an operator it requires special attention        ;
;        I am allowing it to be used to signify a negative number    ;
;        only if is th e1st element of the number list.            ;
;                                        ;

 (defun iminus ( / )
   (cond
     (
      (= lst nil)
      (setq lst  '("-"))
      )
     (
      (setq sy "-")
      (Mk_str sy)   
      )
     )
   );defun

;                                        ;
;            END of iminus Function                    ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;        Construct the string shown on the Total Text Line        ;
;                                        ;
;                                        ;

 (defun Mk_str (sy / )
   (setq lst nil      
     nmbr2 nmbr
     nmbr nil
     nmbrs2 nmbrs
     nmbrs nil
     str (strcat nmbrs2 " " sy " ")
     )
   (set_tile "Total" str)
   );defun

;                                        ;
;            END of Mk_str Function                    ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;        Reset All Values to nil if "C" Clear Button is selected        ;
;                                        ;
;                                        ;

 (defun ican ( )
   (setq lst nil
     nmbrs ""
     nmbr nil
     nmbr2 nil
     nmbrs2 nil
     str ""
     )
   (set_tile "Total" nmbrs)
   );defun

;                                        ;
;            END of ican Function                    ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;            Finally the calculate function                ;
;                                        ;
;    There is an errorutility built into this in case the user decides    ;
;    to test the programming ability of the programer and tries to divide    ;
;    by zero.                                ;
;                                        ;
 
 (defun calculate ( /  al)
   (cond
     (
      (/= nmbr 0)
      (setq sTotal (Real->String ((eval(read sy)) nmbr2 nmbr ))         
        al     (strcat nmbrs2 " " sy " " nmbrs " = " sTotal)
        nmbrs sTotal
        nmbr (distof sTotal)
        str    ""
        lst    nil
        nmbr2  nil
        nmbrs2 nil        
        )
      (set_tile "Total" al)
      (set_tile "error" " ")
      )
     (
      (set_tile "error" "You Cannot Divide by ZERO, Please try again !")
      (mode_tile "7" 2)
      )
     )      
   );defun

;                                        ;
;            END of calculate Function                ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;            Real->String function                    ;
;                                        ;
;        The suppress trainling zeros in the display area         ;
;                                        ;
;converts a real (up to 8 decimal places) into a string without trailing zero's    ;
;                                        ;

 (defun Real->String (nmbr / cnt nmbrT nmbrs)
   (setq  nmbrT (reverse(vl-string->list (rtos nmbr 2 ))
      cnt 0
      )
   (while (=(car nmbrT) 48)
     (setq nmbrT (cdr nmbrT)
       cnt (1+ cnt))
     )
   (setq nmbrs (rtos nmbr 2 (- 8 cnt)))
   );defun

;                                        ;
;            END of calculate Function                ;
;                                        ;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^;
;            And Lastly the actual Dialog Calling Area        ;
;                                        ;
;    Except for the 1st couple of lines of code this is the first        ;
;    code being called, all the previous functions are fired off        ;
;    from here.                                ;
;                                        ;

 (setq tmp (writeCalCdcl)
   dcl_id (load_dialog tmp)
   str ""
   )
 (if (not(new_dialog "scalc" dcl_id))
   (progn
     (alert "\nUnable to load dialog.")
     (exit)
     );progn
   );end if
 
 (set_tile "Title" " pBe / FBF Calculator")
 
 (foreach dgt '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" )
   (action_tile dgt       "(setq lst (append lst (list $key)))(values lst)
                           (set_tile \"Total\" (strcat str nmbrs))")
   )
 (action_tile "idot"      "(setq lst (append lst '(\".\")))   (values lst)
                           (set_tile \"Total\" (strcat str nmbrs))")  
 (action_tile "iminus"    "(iminus)")
 (action_tile "imultiply" "(setq sy \"*\")(Mk_str sy) ")
 (action_tile "idivide"   "(setq sy \"/\")(Mk_str sy) ")
 (action_tile "iplus"     "(setq sy \"+\")(Mk_str sy) ")
 (action_tile "iequal"    "(calculate)")
 (action_tile "iCan"      "(ican)")
 (action_tile "accept" "(done_dialog 1)")
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)  
 (vla-EndUndoMark ActDoc)
 (mapcar 'setvar V-NameL V-SetL)
 sTotal ;feeds answer to calculation  ie; (setq answer (c:SCalc))
 );defun end of function

This LSP has a built in self extracting DCL file within it, so no need for the additional DCL.

simple-calculator.lsp

Link to comment
Share on other sites

spiker7721 I hope it helps you as much as a similar program that I can no longer locate helped me. Let me know if you have any questions.

 

Bruce

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...