Jump to content

MINOR edits to a lisp? please help


dnovember99

Recommended Posts

hey all,

 

i found a lisp that i am totally digging. i wanted to try and tweak this a tad and see if i can make this better. this lisp was done by the one and only Lee Mac. (i first sent him an email regarding this to try and hit the source first.)

 

here is the code:

;;-------------------=={ Text Calculator }==------------------;;
;;                                                            ;;
;;  Allows the user to perform arithmetical operations on     ;;
;;  numerical data within text.                               ;;
;;                                                            ;;
;;  User is prompted to select text containing numerical data ;;
;;  then either choose an arithmetical operation or place     ;;
;;  the result of the current calculation in the form of an   ;;
;;  MText object in the drawing.                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    07-04-2011                            ;;
;;  First Release.                                            ;;
;;------------------------------------------------------------;;

(defun c:TC nil (c:TextCalc))

(defun c:TextCalc ( / *error* _StartUndo _EndUndo _Select _Str a acdoc dcf dch f file num ops pt regex str tmp ) (vl-load-com)

 (defun *error* ( msg )
   (if acdoc (_EndUndo acdoc))
   (if (< 0 dch)  (unload_dialog dch))
   (if (setq tmp  (findfile tmp)) (vl-file-delete tmp))
   (if (and regex (not (vlax-object-released-p regex))) (vlax-release-object regex))
   (if (and msg   (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )
 
 (defun _Select ( msg / entity num dtext mtext )
   (while
     (progn (setvar 'ERRNO 0) (setq entity (car (nentsel msg)))
       (cond
         (
           (= 7 (getvar 'ERRNO))

           (princ "\n--> Missed, Try again.")
         )
         (
           (eq 'ENAME (type entity))

           (if (wcmatch (cdr (assoc 0 (entget entity))) "*TEXT,ATTRIB,*LEADER,*DIMENSION")
             (if
               (and
                 (progn (LM:GetTrueContent regex entity 'dtext 'mtext) dtext)
                 (setq num (LM:ParseNumbers dtext))
               )
               (not
                 (or
                   (and (= 1 (length num)) (setq num (car num)))
                   (and (setq num (car (LM:ListBox "Select Number to Use" (mapcar 'vl-princ-to-string num) nil))) (setq num (read num)))
                 )
               )
               (princ "\n--> Text does not contain numerical data.")
             )
             (princ "\n--> Invalid Object Selected.")
           )
         )
       )
     )
   )
   num
 )

 (defun _str ( n )
   (cond
     ( (eq 'INT  (type n)) (itoa n))
     ( (eq 'REAL (type n)) (rtos n))
     ( (eq 'STR  (type n)) n)
     ( (vl-princ-to-string n))
   )
 )

 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       regex (vlax-create-object "VBScript.RegExp")
 )

 (cond             
   (
     (not
       (and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
         (foreach line
          '(
             "_button  : image_button { width = 8.33; height = 3.85; fixed_width = true; fixed_height = true; alignment = centered; color = -15; }"
             ""
             "textcalc : dialog { key = \"dcltitle\"; spacer;"
             "  : row {"
             "    : _button { label = \"+\"; key = \"+\"; }"
             "    : _button { label = \"-\"; key = \"-\"; }"
             "    : _button { label = \"×\"; key = \"*\"; }"
             "    : _button { label = \"÷\"; key = \"/\"; }"
             "  }"
             "  spacer;"
             "  : button { key = \"accept\"; label = \"Place Result >>\"; is_default = true; height = 2; fixed_height = true; }"
             "  : button { key = \"cancel\"; label = \"Cancel\";           is_cancel = true; }"
             "}"
           )
           (write-line line file)
         )
         (not (setq file (close file))) (< 0 (setq dch (load_dialog tmp)))
       )
     )

     (princ "\n--> Error Loading Dialog.")
   )
   ( (setq num (_Select "\nSelect Text Containing Numerical Data: "))

     (setq str (_str num) ops '(("+" . " + ") ("-" . " - ") ("*" . " × ") ("/" . " ÷ ")))

     (while (not (member dcf '(1 0)))
       (cond
         (
           (not (new_dialog "textcalc" dch))

           (setq dcf 0)
           (princ "\n--> Error Loading Dialog.")
         )
         (t           
           (foreach x
            '(
               ("+"
                 (033 032 031 030 029 028 028 028 027 026 025 024 023 022 022 022 021 020 019 018 017 016 015 014 013 012 011 010 009 041 040 039 038
                  037 036 035 034)
                 (027 027 027 027 027 011 027 041 041 041 041 041 041 011 027 041 027 027 027 027 027 027 027 027 027 027 028 029 029 029 029 028 027
                  027 027 027 027)
                 (023 023 023 023 023 009 023 039 009 009 009 009 009 009 023 039 023 023 023 023 023 023 023 023 023 023 022 021 021 021 021 022 023
                  023 023 023 023)
               )
               ("-"
                 (037 036 035 034 033 032 031 030 029 028 027 026 025 024 023 022 021 020 019 018 017 016 015 014 013 012 011 010 009 041 040 039 038)
                 (027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 027 028 029 029 029 029 028 027)
                 (023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 023 022 021 021 021 021 022 023)
               )
               ("/"
                 (027 026 026 026 025 025 025 024 024 024 023 023 023 022 022 022 021 020 019 018 017 016 015 014 013 012 011 010 009 041 040 039 038
                  037 036 035 034 033 032 031 030 029 028 028 028 027 027)
                 (041 016 027 041 016 027 041 016 027 041 015 027 040 014 027 039 027 027 027 027 027 027 027 027 027 027 028 029 029 029 029 028 027
                  027 027 027 027 027 027 027 027 027 014 027 039 015 027)
                 (035 009 023 034 009 023 034 009 023 034 009 023 035 011 023 036 023 023 023 023 023 023 023 023 023 023 022 021 021 021 021 022 023
                  023 023 023 023 023 023 023 023 023 011 023 036 009 023)
               )
               ("*"
                 (027 026 025 024 023 022 022 021 021 020 020 019 019 018 018 017 017 016 016 015 015 014 014 013 013 012 012 011 011 040 040 039 039
                  038 038 037 037 036 036 035 035 034 034 033 033 032 032 031 031 030 030 029 029 028)           
                 (030 029 028 029 030 025 031 024 032 023 033 022 034 021 035 020 036 019 039 018 040 017 039 016 038 016 037 016 036 015 035 016 036
                  016 037 016 038 017 039 018 040 019 037 020 036 021 035 022 034 023 033 024 032 031)           
                 (020 021 022 021 020 019 025 018 026 017 027 016 028 015 029 014 030 010 031 010 032 011 033 012 034 013 034 014 034 015 035 014 034
                  013 034 012 034 011 033 010 032 013 031 014 030 015 029 016 028 017 027 018 026 019)
               )
             )
             (start_image (car x))
             (apply 'mapcar (cons '(lambda ( x y z ) (vector_image x y x z 178)) (cdr x)))
             (end_image)
             (action_tile (car x) (strcat "(princ (strcat \"\n\" str (cdr (assoc (setq f $key) ops)))) (done_dialog 2)"))
           )
           (set_tile "dcltitle" "Text Calculator")
          
           (setq dcf (start_dialog))

           (if (and (= 2 dcf) (setq a (_Select "\nSelect Text Containing Numerical Data: ")))
             (cond
               (
                 (eq f "/")
                
                 (if (equal 0.0 (setq a (float a)) 1e-14)
                   (princ "\n--> Invalid Operation: Divide by Zero.")
                   (progn
                     (setq num ((eval (read f)) num a))
                     (princ (strcat "\n" str (cdr (assoc f ops)) (_str a) " = " (setq str (_str num))))
                   )
                 )
               )
               ( (setq num ((eval (read f)) num a))

                 (princ (strcat "\n" str (cdr (assoc f ops)) (_str a) " = " (setq str (_str num))))
               )
             )
           )
           (princ)
         )
       )
     )
    
     (if (and (= 1 dcf) (setq pt (getpoint "\nSpecify Point for Result: ")))
       (progn
         (_StartUndo acdoc)
         
         (vla-AddMtext
           (vlax-get-property acdoc
             (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
           )
           (vlax-3D-point (trans pt 1 0)) 0. (_str num)
         )

         (_EndUndo acdoc)
       )
     )          
   )
 )

 (*error* nil)
 (princ)
)

;;-------------------=={ Parse Numbers }==--------------------;;
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s  - String to process                                    ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;

(defun LM:ParseNumbers ( s )
 (
   (lambda ( l )
     (read
       (strcat "("
         (vl-list->string
           (mapcar
             (function
               (lambda ( a b c )
                 (if
                   (or
                     (< 47 b 58)
                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                     (and (= 46 b) (< 47 a 58))
                     (= 32 b)
                   )
                   b 32
                 )
               )
             )
             (cons nil l) l (append (cdr l) (list nil))
           )
         )
         ")"
       )
     )          
   )
   (vl-string->list s)
 )
)

;;-----------------------=={ List Box }==---------------------;;
;;                                                            ;;
;;  Displays a List Box allowing the user to make a selection ;;
;;  from the supplied data.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  title    - List Box Dialog title                          ;;
;;  data     - List of Strings to display in the List Box     ;;
;;  multiple - Boolean flag to determine whether the user     ;;
;;             may select multiple items (T=Allow Multiple)   ;;
;;------------------------------------------------------------;;
;;  Returns:  List of selected items, else nil.               ;;
;;------------------------------------------------------------;;

(defun LM:ListBox ( title data multiple / file tmp dch return )
 ;; © Lee Mac 2011
 
 (cond
   (
     (not
       (and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
         (write-line
           (strcat "listbox : dialog { label = \"" title
             "\"; spacer; : list_box { key = \"list\"; multiple_select = "
             (if multiple "true" "false") "; } spacer; ok_cancel;}"
           )
           file
         )
         (not (close file)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch)
       )
     )
   )
   (
     t     
     (start_list "list")
     (mapcar 'add_list data) (end_list)

     (setq return (set_tile "list" "0"))
     (action_tile "list" "(setq return $value)")

     (setq return
       (if (= 1 (start_dialog))
         (mapcar '(lambda ( x ) (nth x data)) (read (strcat "(" return ")")))
       )
     )          
   )
 )
 
 (if (< 0 dch) (unload_dialog dch))
 (if (setq tmp (findfile tmp)) (vl-file-delete tmp))

 return
)

;;------------------=={ Get True Content }==------------------;;
;;                                                            ;;
;;  Returns the unformatted string associated with the        ;;
;;  supplied entity, in formats compatible with Text & MText  ;;
;;  objects.                                                  ;;
;;                                                            ;;
;;  The arguments *dtextstring & *mtextstring should be       ;;
;;  supplied with quoted symbols (other than those symbols    ;;
;;  used by the arguments themselves). The unformatted        ;;
;;  strings suitable for Text & MText objects will henceforth ;;
;;  be bound to the supplied symbol arguments respectively.   ;;
;;                                                            ;;
;;  Note that it is the caller's responsibility to create and ;;
;;  release the RegularExpressions (RegExp) object. This      ;;
;;  object may be created using the                           ;;
;;  Programmatic Identifier: "VBScript.RegExp".               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  RegExp       - RegularExpressions (RegExp) Object         ;;
;;  entity       - Ename whose text content is to be returned ;;
;;  *dtextstring - (output) Unformatted string compatible     ;;
;;                 with Text entities                         ;;
;;  *mtextstring - (output) Unformatted string compatible     ;;
;;                 with MText entities                        ;;
;;------------------------------------------------------------;;
;;  Returns:    This function always returns nil              ;;
;;------------------------------------------------------------;;

(defun LM:GetTrueContent ( RegExp entity *dtextstring *mtextstring / _Replace _AllowsFormatting _GetTextString )

 (defun _Replace ( new old string )
   (vlax-put-property RegExp 'pattern old) (vlax-invoke RegExp 'replace string new)
 )

 (defun _AllowsFormatting ( entity / object )    
   (or (wcmatch (cdr (assoc 0 (entget entity))) "MTEXT,MULTILEADER,*DIMENSION")      
     (and
       (eq "ATTRIB" (cdr (assoc 0 (entget entity))))
       (vlax-property-available-p (setq object (vlax-ename->vla-object entity)) 'MTextAttribute)
       (eq :vlax-true (vla-get-MTextAttribute object))
     )
   )
 )

 (defun _GetTextString ( entity )
   (
     (lambda ( entity / _type elist db ds )
       (cond
         ( (eq (setq _type (cdr (assoc 0 (setq elist (entget entity))))) "TEXT")
          
           (cdr (assoc 1 (reverse elist)))
         )
         ( (wcmatch _type "*DIMENSION")

           (if (setq db (tblobjname "BLOCK" (cdr (assoc 2 elist))))
             (while (and (setq db (entnext db)) (not ds))
               (if (eq "MTEXT" (cdr (assoc 0 (setq elist (entget db)))))
                 (setq ds (cdr (assoc 1 elist)))
               )
             )
           )
           ds
         )          
         ( (eq "MULTILEADER" _type)

           (cdr (assoc 304 elist))
         )
         ( (wcmatch _type "ATTRIB,MTEXT")

           (
             (lambda ( string )
               (mapcar
                 (function
                   (lambda ( pair )
                     (if (member (car pair) '(1 3))
                       (setq string (strcat string (cdr pair)))
                     )
                   )
                 )
                 elist
               )
               string
             )
             ""
           )
         )
       )
     )
     entity
   )
 )

 (
   (lambda ( string )
     (if string
       (progn
         (mapcar
           (function
             (lambda ( x ) (vlax-put-property RegExp (car x) (cdr x)))
           )
           (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
         )
         (if (_AllowsFormatting entity)
           (mapcar
             (function
               (lambda ( x ) (setq string (_Replace (car x) (cdr x) string)))
             )
            '(
               ("Ð"       . "\\\\\\\\")
               (" "       . "\\\\P|\\n|\\t")
               ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
               ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
               ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
               ("$1"      . "[\\\\]({)|{")
             )
           )
           (setq string (_Replace "" "%%[OoUu]" (_Replace "Ð" "\\\\" string)))
         )
         (set *mtextstring (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" string)))
         (set *dtextstring (_Replace "\\"   "Ð" string))
       )
     )
   )
   (_GetTextString entity)
 )
 nil
)

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

(princ)
(princ "\n:: TextCalc.lsp | Version 1.0 | © Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Type \"TextCalc\" or \"TC\" to Invoke ::")
(princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

 

this is a text calculator. i am using this to calculate my inverts. here is the email that i sent to him regarding what i am looking to do with this code.

 

 

I work with plumbing drawings (2D) and I use all kinds of different math. But when I am working with the lisp of yours and let’s say I do 250/8 = 31.25 
or if the text was to read 250*.25 = 31.25. When I run your lisp with those numbers it is giving me a value of 31250 and that is it. 

Would it be possible to modify this to have a decimal be here 31.250? 

Here is what my calculation would need to look at to calculate slope. 250'/8 (this is for 1/8" slope and would be 4 if it is for 1/4" slope) 
= 31.250" + 24" (this would be my starting depth of piping) = 55.250"+ 6" (we use this for safety or as a just in case thing) = 61.250" 
or 5' 1.25" below finish floor. 

I have been searching for something to be able to enter the total length (250) have it prompt for 1/8 or 1/4 (4 or  and then ask for 
stating depth of pipe (starting invert) and then ask if we want to add the safety. (y/n) and then bingo you get either 61.250" or 5' 1.25" 
and I would just know that this would be below finished floor or if we are able to do this math to show this as negative (-61.250 or -5' 1.25") 

 

 

i am still learning code and i still have no clue how to word things nor where to place it within the code. attached are a few screen shots that i have taken to show you the results when running the lisp (plus steps within) i also created a very simple block to keep everything simple. let me know your thoughts!

 

thanks for looking.

math as code was wrote - and what i and trying to acchive.png

final numbers i am looking for..png

Edited by dnovember99
missed information
Link to comment
Share on other sites

  • Replies 64
  • Created
  • Last Reply

Top Posters In This Topic

  • dnovember99

    30

  • BIGAL

    25

  • Roy_043

    4

  • Grrr

    2

Top Posters In This Topic

Posted Images

The answer for you is a custom lisp this way the maths is done correctly. What you want is not that hard, the question is how do you want the output, looking at image it could be a block, a table or lines and text.

 

For me a block would be the easiest as you would answer 4 questions length, invert, depth, safety. The rest would be filled in. If you could create the block with the text style and height set then the code could follow. Make the lower left as insertion point start at 0,0.

 

Just make the attributes like len1 len2 inv1 inv2 etc

ScreenShot103.jpg

Edited by BIGAL
Link to comment
Share on other sites

I would agree with you! If I was able to put the starting invert (xx"BFF), Slab thickness, total length of the piping run, the safety factor and then last be the slope you want either 1/4" 1/8" or 1/16"

 

Problem is I don't know how to write that up. And have it actually work. If I tried my computer might laugh at me and then just show me the middle finger. Lmao

Link to comment
Share on other sites

Ok re read that and I see what you are saying. I am out for the weekend but I will create the block and on the side I can write the information you stated.

 

Thank you again

Link to comment
Share on other sites

@dnovember99:

The issue is caused by Lee Mac's ParseNumbers function that does not recognize ".25" type numerical strings.

Below is a replacement function that does.

; (KGA_String_ParseNumbers "12'3/4\" ABC 5.6D.7.8 -9-10.0") => (144.75 5.6 0.7 0.8 -9 -10.0)
(defun KGA_String_ParseNumbers (str / N_Str_To_Num ret sub)
 (defun N_Str_To_Num (str)
   ((if (not (wcmatch str "*[~-0-9]*,-,?*-*")) atoi distof) str)
 )
 (setq str (vl-string->list str))
 (repeat (1+ (length str)) ; 1+ to ensure processing of final sub.
   (cond
     ((<= 48 (car str) 57)
       (setq sub (cons (car str) sub))
     )
     ((vl-position (car str) '(34 39 45 46 47)) ; (vl-string->list "\"'-./")
       (if
         (or
           (vl-position (car str) sub)
           (and sub (= 45 (car str))) ; "-" has to be the first item in sub.
         )
         (progn
           (setq ret (cons (N_Str_To_Num (vl-list->string (reverse sub))) ret))
           (setq sub (list (car str)))
         )
         (setq sub (cons (car str) sub))
       )
     )
     (sub
       (setq ret (cons (N_Str_To_Num (vl-list->string (reverse sub))) ret))
       (setq sub nil)
     )
   )
   (setq str (cdr str))
 )
 (vl-remove nil (reverse ret))
)

Link to comment
Share on other sites

@dnovember99:

The issue is caused by Lee Mac's ParseNumbers function that does not recognize ".25" type numerical strings.

Below is a replacement function that does.

; (KGA_String_ParseNumbers "12'3/4\" ABC 5.6D.7.8 -9-10.0") => (144.75 5.6 0.7 0.8 -9 -10.0)
(defun KGA_String_ParseNumbers (str / N_Str_To_Num ret sub)
 (defun N_Str_To_Num (str)
   ((if (not (wcmatch str "*[~-0-9]*,-,?*-*")) atoi distof) str)
 )
 (setq str (vl-string->list str))
 (repeat (1+ (length str)) ; 1+ to ensure processing of final sub.
   (cond
     ((<= 48 (car str) 57)
       (setq sub (cons (car str) sub))
     )
     ((vl-position (car str) '(34 39 45 46 47)) ; (vl-string->list "\"'-./")
       (if
         (or
           (vl-position (car str) sub)
           (and sub (= 45 (car str))) ; "-" has to be the first item in sub.
         )
         (progn
           (setq ret (cons (N_Str_To_Num (vl-list->string (reverse sub))) ret))
           (setq sub (list (car str)))
         )
         (setq sub (cons (car str) sub))
       )
     )
     (sub
       (setq ret (cons (N_Str_To_Num (vl-list->string (reverse sub))) ret))
       (setq sub nil)
     )
   )
   (setq str (cdr str))
 )
 (vl-remove nil (reverse ret))
)

 

 

 

Thank you for this. I will put it all together and see how she performs. I will let you know how it goes.

 

Thanks again

Link to comment
Share on other sites

Just me but I still think your going down the wrong path and making life much harder for yourself.

 

If you type 1/4 1/2 1/8 as a string then its easy to convert it to the divisor required using a cond

 

(defun c:test ( / len ans div slabd inv safety tot totslope)
(setq ans (getstring  "Enter a value 1/4 1/8 1/16"))
(setq len (getreal "Enter length "))
(setq inv (getreal "Enter invert "))
(setq slabd (getreal "Enter slab depth "))
(setq safety (getreal "Enter safety "))
(cond
((= ans "1/4")(setq div 0.25))
((= ans "1/8")(setq div 0.125))
((= ans "1/16")(setq div 0.0625))
)
(setq totslope (* len div))
(setq tot (+ (+ (+ totslope inv) safety) slabd))
(alert (strcat "Value is " ans  "\nLength is " (rtos len 2 2) "\nTotal slope is " (rtos totslope 2 2) 
"\nInvert is " (rtos inv 2 2) "\nSlab depth is " (rtos slabd 2 2) "\n\nTotal overall is " (rtos tot 4 2))))
(c:test)

 

Thinking a bit more and making life easier using the library dcl I have that can be used by any program (posted above) I would make the message line say "Please enter a value 1/ 4 8 16 etc" then it would do the 1/number so no need for even a cond.

 

Plenty of us here can do the simple coding required like my example but you need to provide the answer about what you want the output to be something that is saved in the dwg or just like the example displays the answer on the screen.

GETVALS4.lsp

Edited by BIGAL
Link to comment
Share on other sites

BIGAL,

 

I wanted to say thank you again for this. i really like your idea of using the block. i have created this information into a block (i think that i was understanding what you are looking for.) if you think that there should be some modifications let me know. there are two there just for the fact to have what each one is used for. i am sure that you already know but thought that i would put there.

 

text style is set for romans

text height is 8"

 

just let me know if this works

 

 

thank you again

INVERT BLOCK.dwg

INVERT BLOCK-2.dwg

Link to comment
Share on other sites

You have changed the rules compared to the 1st post, I thought you wanted it to be a 1 entry but give the 3 answers. 1/4 1/8 1/16.

 

I dont understand the 3 entries now ?

 

Also your block does not have any attributes which is what the lisp would replace. looking at your block you would have ATTRIBUTES something like these tag names.

 

LV1 LV2 LV3

LV4 LV5 LV6

LV7 LV8 LV9

Link to comment
Share on other sites

You have changed the rules compared to the 1st post, I thought you wanted it to be a 1 entry but give the 3 answers. 1/4 1/8 1/16.

 

I dont understand the 3 entries now ?

 

Also your block does not have any attributes which is what the lisp would replace. looking at your block you would have ATTRIBUTES something like these tag names.

 

LV1 LV2 LV3

LV4 LV5 LV6

LV7 LV8 LV9

 

OMG! yup it is official! I feel like a total dumba $$! looking at this I totally did this backwards.

 

So keep all the same but in the first post change attributes to show "LV1, LV2 LV3 ETC" WOW I am sorry about that man! And no worri3s walking myself to give myself a swirly. Standby for updated info

Link to comment
Share on other sites

OK so i went a head and re did this. to match what i originally thought about and also took into account your suggestions in your first comment. let me know if i am still stuck on dumb over here. (i have a new born baby so i am not getting much sleep right now)

invert block 2.dwg

Link to comment
Share on other sites

Ok where I was heading it needs some extra stuff like error checking but its an example of how to solve your request. You need the block pipe calc in your normal dwt just copy and paste and save. Error check would insert it if required.

 

; simple example of filling in a block attributes with calcs
; by Alan H Dec 2017

(defun c:pipe-calc ( / len ans div slabd inv safety tot totslope)

(if (not ah:getval5) (load "getvals1-5"))

(ah:getval5 "Enter desired slope 1/x 4 8 16" 5 4  "4" "Enter length " 5 4  "50" "Enter inv " 5 4 "24" "Enter slab depth" 5 4 "4" "Enter safety " 5 4 "6")

(setq div (/ 1.0 (atof val1)))
(setq len (atof val2))
(setq inv (atof val3))
(setq slabd (atof val4))
(setq safety (atof val5))

(setq totslope (* len div))
(setq tot (+ (+ (+ totslope inv) safety) slabd))

;(alert (strcat "Value is " (rtos div 2 2)  "\nLength is " (rtos len 2 2) "\nTotal slope is " (rtos totslope 2 2) "\nInvert is " (rtos inv 2 2) "\nSlab depth is " (rtos slabd 2 2) "\n\nTotal overall is " (rtos tot 4 2)))))))

(command "-insert" "PIPE-CALC" (getpoint) 1 1 0  val2 val3 val4 val5  (strcat "1/" val1)  (rtos TOT 4 2))

)
(c:pipe-calc)

 

This is a generic library function which now supports up to 5 lines of user defined input and can be used in any lisp. Save it to where all your other lisps are must be in a supported path, just use the correct example for 1 2 3-5 lines. I have another that was provide by others and is only limited by the dcl line limit.

GETVALS1-5.lsp

Link to comment
Share on other sites

AMAZING WORK.

 

so i brought this up with a few guys that i work with and they love it! they did want to see if there is a way to add in 25% to the final number. i should have thought about this, but the reason is if we have a total length of pipe of 300' that is just the piping, the 25% would add in the fittings that would be there.

 

i was also thinking that i could change out the block and remove the 1/4" 1/8" and 1/16" text on top and the two columns to the right being that this doesnt calculate all three of them. which is fine by me. i like it this way.

 

so i tried to go in a tweek what i thought might help this work to take the length x 25% = xxx

 

i just thought i would give it a shot before i came back. let me know where i am going wrong? oh and to the block i added another row to have the fittings factor.

 

(defun c:pc ( / len ans div slabd inv safety fittings tot totslope)

(if (not c:pc)(load "pipe calc test")(vl-load-com))

(ah:getval5 "Enter desired slope 1/x 4 8 16" 5 4  "4" "Enter length " 5 4  "50" "Enter inv " 5 4 "24" "Enter slab depth" 5 4 "4" "Enter safety " 5 4 "6" "Fittings Factor " 5 4 "25%")

(setq div (/ 1 (atof val1)))
(setq len (atof val2))
(setq inv (atof val3))
(setq slabd (atof val4))
(setq safety (atof val5))
(setq fit (atof val6))

(setq totslope (* len div))
(setq totslope (* len (* fit))
(setq tot (+ (+ (+ totslope inv) safety) slabd))

;(alert (strcat "Value is " (rtos div 2 2) "\nLength is " (rtos len 2 2) "\nFittings factor is " (rtos fitm 2 2) "\nTotal slope is " (rtos totslope 2 2) "\nInvert is " (rtos inv 2 2) "\nSlab depth is " (rtos slabd 2 2) "\nTotal overall is " (rtos tot 4 2)))))))

(command "-insert" "PIPE CALC TEST" (getpoint) 1 1 0  val2 val3 val4 val5  (strcat "1/" val1)  (rtos TOT 4 2))

)
(c:pipe-calc)

 

 

i am sure that what i tried to change is totally off and wrong but i wanted to at least try. thank you again for your help with this

invert block 2.dwg

changes to slope calc.png

Link to comment
Share on other sites

A couple of things, the block was not well drawn regarding the line work so I would start again horizontal and vertical lines in the pattern required, the tot 0/all needs a wider box I found.

 

I would add back in the (if (not AH:getval5) line so it loads the dcl code when required.

 

The getvals1-5 I have just added more defuns so you would need to add the 6 line option just copy the 5 and add the lines make it ah:getval6.

 

Also you need to add the fiiting factor to the -insert ..... (strcat val6 "%") add an extra attribute "perc"

 

(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key6" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title6 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width6 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit6 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)


(mode_tile "key6" 3)
(set_tile "key6" (setq val6 def6))
(action_tile "key6" "(setq val6 $value)")

 

I will find the other dcl that allows for as many lines as you like.

Link to comment
Share on other sites

A couple of things, the block was not well drawn regarding the line work so I would start again horizontal and vertical lines in the pattern required, the totl 0/all needs a wider box I found.

 

I would add back in the if not AH:getval5 line so it loads the dcl code when required.

 

The getvals1-5 I have just added more defuns so you would need to add the 6 line option just copy the 5 and add the 4 lines make it ah:getval6.

 

(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key6" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title6 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width6 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit6 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)


(mode_tile "key6" 3)
(set_tile "key6" (setq val6 def6))
(action_tile "key6" "(setq val6 $value)")

i will find the other dcl that allowsfor as many lines as you like.

 

To be honest the block is fine and can be modified. The stuff that you have done with this is amazing. Can thank you enough.

 

I will add that stuff and let you know how it works.

 

Thank you again

Link to comment
Share on other sites

Good to hear that its working.

 

Well the original is working just fine it's trying to add in the additional information that that you suggested to put in. For some reason any time that I go and modify a lisp routine I always seem to get back some kind of error like a malfunction or something along those lines.

 

so it seems that so it seems that I'm either putting it in the wrong location or I am just one unlucky *******. I've already left work so I will have to send you the code that I input it from the information that you gave me tomorrow and we'll see what happens with it from there

 

oh and oh and the other funny thing with the block I recreated it. Technically I modified what you already sent and now when I type in the command to run the lisp the box that pops up is now like three times the size that you would had it. Now to explain a little bit on that I am not used to using the block editor so that's the reason why when you said attributes I was coming across this idiot. I very well could have done something to that modified something with inside that block that you had set that would cause that to happen I don't know but the size of the text box that pops up to me doesn't matter it's the actual Nuts and Bolts of the lisp I will follow up tomorrow and maybe you can tell me where I went wrong. But thank you again for everything

Link to comment
Share on other sites

ok so here is what i came up with. i have made a little changes to the block it self, however it doesnt seems to be working for me. when i try and insert it into a drawing it is telling me that i have to add the factors of the attributes in??

 

also i added a few extra lines for addtional factors.. And some designer notes on there. i can always remove them if it is needed. like finished floor elevation, the fittings factor (should be adding 25% of the overall length prior to adding in the rest of the stuff.)

 

for the (command "-insert" "PIPE-CALC" (getpoint) 1 1 0 val2 val3 val4 val5 val6 val7 val8 (strcat "1/" val1) (rtos TOT 4 2))

 

i am guessing that this is what is going to fill in the columns, at the (strcat "1/" val1) is adding the whole calculation to all val1's within the block. so i added in two additional lines to reflect this to be adding to the others.

 

but i am getting errors all around with this. and of course the block. lol

 

 

 

; simple example of filling in a block attributes with calcs
; by Alan H Dec 2017

(defun c:pipe-calc ( / len ans div slabd inv safety tot totslope)

(if (not ah:getval6) (load "getvals1-6"))

(ah:getval8 "Enter desired slope 1/x 4 8 16" 5 4  "4" "Enter Finished FLR Elev. " 5 4  "100" "Enter length " 5 4  "50" "Fittings Factor " 5 4 "25%" "Enter inv " 5 4 "24" "Enter slab depth" 5 4 "4" "Enter safety " 5 4 "6")

(setq div (/ 1.0 (atof val1)))
(setq flr (atof val2))
(setq len (atof val3))
(setq perc (atof val4))
(setq inv (atof val5))
(setq th (atof val6))
(setq safety (atof val7))


(setq totslope (* (* len) perc) div ))
(setq tot (+ (+ (+ totslope inv) safety) slabd))

;(alert (strcat "Value is " (rtos div 2 2)  "\nFinished Flr Elev is " (rtos inv 2 2) "\nLength is " (rtos inv 2 2) "\nFittings factor is " (rtos len 2 2) (strcat "Val% " )  "\nInvert is " (rtos inv 2 2) "\nSlab depth is " (rtos slabd 2 2) "\nSafety is " (rtos slabd 2 2) "\n\nTotal overall is " "\nAbsolute feet is " (rtos slabd 2 2)))))))

(command "-insert" "PIPE-CALC" (getpoint) 1 1 0  val2 val3 val4 val5 val6 val7 val8 (strcat "1/4" val1)  (rtos TOT 4 2))
(command "-insert" "PIPE-CALC" (getpoint) 1 1 0  val2 val3 val4 val5 val6 val7 val8 (strcat "1/8" val2)  (rtos TOT 4 2))
(command "-insert" "PIPE-CALC" (getpoint) 1 1 0  val2 val3 val4 val5 val6 val7 val8 (strcat "1/16" val3)  (rtos TOT 4 2))

)
(c:pipe-calc)

 

OH AND SO I DONT FORGET. HERE IS THE "GETVALS1-5 WITH MODIFICATIONS TO SHOW 1-8.

 

 

; Input  Dialog box with variable title
; multiple lines of dcl input supported
; add extra lines if required by copying code defun
; By Alan H 2015
(vl-load-com)

; 1 line dcl
; sample code (ah:getval1 "Line 1" 5 4 "-")
(defun AH:getval1 (title width limit def1 / fo fname)
; you can hard code a directory if you like for dcl file
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
(write-line (strcat "     edit_width = " (rtos width 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_only;}" fo)
(close fo)

(setq dcl_id (load_dialog  fname))
; pt is a list 2 numbs -1 -1 centre ('(20 20))
;(not (new_dialog "test" dch "" *screenpoint*)) 
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key1" 3)
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 as a string
(vl-file-delete fname)
) ; defungetval1

; 2 line dcl
; sample code (ah:getval2 "Line 1" 5 4 "1" "Line2" 8 7 "2")
(defun AH:getval2 (title1 width1 limit1 def1 title2 width2 limit2 def2 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval2 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval2" dcl_id))
(exit))
(mode_tile "key1" 3)
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(set_tile "key2" (setq val2 def2))
(action_tile "key2" "(setq val2 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 and val2 as strings
(vl-file-delete fname)
) ; defungetval2

; 3 line dcl
; sample code (ah:getval3 "Line 1" 5 4 "0.9" "Line 2" 8 7 "wow" "Line 3" 6 4 "123")

(defun AH:getval3 (title1 width1 limit1 def1 title2 width2 limit2 def2 title3 width3 limit3 def3 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(set_tile "key2" (setq val2 def2))
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(set_tile "key3" (setq val3 def3))
(action_tile "key3" "(setq val3 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 val2 and val3 as strings
(vl-file-delete fname)
) ; defungetval3

; 4 line dcl
; sample code (ah:getval4 "Line 1" 5 4 "0.9" "Line 2" 8 7 "wow" "Line 3" 6 4 "123" "Line 4" 6 4 "456")

(defun AH:getval4 (title1 width1 limit1 def1 title2 width2 limit2 def2 title3 width3 limit3 def3  title4 width4 limit4 def4 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key4" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title4 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width4 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit4 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(set_tile "key2" (setq val2 def2))
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(set_tile "key3" (setq val3 def3))
(action_tile "key3" "(setq val3 $value)")
(mode_tile "key4" 3)
(set_tile "key4" (setq val4 def4))
(action_tile "key4" "(setq val4 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 val2 and val3 as strings
(vl-file-delete fname)
) ; defungetval4

; 5 line dcl
; sample code (ah:getval5 "Line 1" 5 4 "0.9" "Line 2" 8 7 "wow" "Line 3" 6 4 "123" "Line 4" 6 4 "456" "Line 5" 6 4 "789")

(defun AH:getval5 (title1 width1 limit1 def1 title2 width2 limit2 def2 title3 width3 limit3 def3  title4 width4 limit4 def4  title5 width5 limit5 def5 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key4" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title4 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width4 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit4 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key5" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title5 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width5 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit5 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; 8 line dcl
; sample code (ah:getval8 "Line 1" 5 4 "0.9" "Line 2" 8 7 "wow" "Line 3" 6 4 "123" "Line 4" 6 4 "456" "Line 5" 6 4 "789" "Line 6" 6 4 "789" "Line 7" 6 4 "789" "Line 8" 6 4 "789")

(defun AH:getval8 (title1 width1 limit1 def1 title2 width2 limit2 def2 title3 width3 limit3 def3  title4 width4 limit4 def4  title5 width5 limit5 def5 title6 width6 limit6 def6 title7 width7 limit7 def7 title8 width8 limit8 def8 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key4" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title4 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width4 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit4 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key5" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title5 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width5 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit5 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key6" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title6 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width6 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit6 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key7" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title7 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width7 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit7 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(write-line (strcat "    key = " (chr 34) "key8" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title8 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width8 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit8 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(set_tile "key2" (setq val2 def2))
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(set_tile "key3" (setq val3 def3))
(action_tile "key3" "(setq val3 $value)")
(mode_tile "key4" 3)
(set_tile "key4" (setq val4 def4))
(action_tile "key4" "(setq val4 $value)")
(mode_tile "key5" 3)
(set_tile "key5" (setq val5 def5))
(action_tile "key5" "(setq val5 $value)")
(mode_tile "key6" 3)
(set_tile "key6" (setq val6 def6))
(action_tile "key6" "(setq val6 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 val2 and val3 as strings
(vl-file-delete fname)
) ; defungetval6

new block (1).dwg

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...