Jump to content

Dcl dialog to lisp

sathalex

By sathalex
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

sathalex Apprentice

sathalex

Posted
Posted

Hello everybody!

I'm trying to make DSL dialogue for a small program.

DCL:

perfsuff: dialog {
                       label = "PF";
         : boxed_column
         {             label = "--< Add >--";
         : edit_box
         {
                       label = "Type prefix:";
                       key = "pre";
                       value = "";
                       edit_width = 10;}
         : edit_box
         {
                       label = "Type suffix:";
                       key = "suf";
                       value = "";
                       edit_width = 10;}
         : spacer
         {height = 0.5;}}
         ok_cancel;
         }

Lisp:

(defun c:perfsuff (/ prefiks-txt sufiks-txt spisok znach i)
(initget 1)
(setq prefiks-txt (getstring T "prefix: "))
(initget 1)
(setq sufiks-txt (getstring T "suffix: "))
(princ)
(setq spisok (ssget '((0 . "*text"))))
(setq i 0)
(while (< i (sslength spisok))
(setq znach (entget (ssname spisok i)))
(setq soderzhimoe (cons 1 (strcat prefiks-txt (cdr (assoc 1 znach)) sufiks-txt)))
(setq znach (subst soderzhimoe (assoc 1 znach) znach))
(entmod znach)
(setq i (1+ i))
)
(princ)
)
(c:perfsuff)

I get something like this:

(defun c:perfsuff (/ prefiks-txt sufiks-txt spisok znach i)
(if (< (setq num (load_dialog "perfsuff")) 0) (exit))
(if (not (new_dialog "perfsuff" num)) (exit))
(action_tile "pre" "(setq rad1 (atof $value))")
(terpri)
(princ prefiks-txt)
(action_tile "suf" "(setq rad1 (atof $value))")
(terpri)
(princ sufiks-txt)
(terpri)
(start_dialog)
(unload_dialog num)
(setq spisok (ssget '((0 . "*text"))))
(setq i 0)
(while (< i (sslength spisok))
(setq znach (entget (ssname spisok i)))
(setq soderzhimoe (cons 1 (strcat prefiks-txt (cdr (assoc 1 znach)) sufiks-txt)))
(setq znach (subst soderzhimoe (assoc 1 znach) znach))
(entmod znach)
(setq i (1+ i))
)
(princ)
)
(c:perfsuff)

But the program does not work, please tell me where the mistake?

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

A few problems

both pre & suf set the value rad1

prefiks-txt is a nil value in last post

 

Have a look at this its a multi line dcl have as many lines as you like the example is for 2 lines in code it returns variables Key1 key2 as strings etc

 

; multi line dcl
; sample code a 2 line example
; By Alan H
; use these two next lines in your code all thats required.

; (if (not AH:getkeys)(load "getvals2"))
;(AH:getkeys (list "Enter prefix " 5 4 "Enter suffix " 5 4 ))

; returns key1 key2 etc

(princ "Getvals2 loaded")

(defun AH:getkeys (INFO / fo fname newlst num x y klist)
; you can hard code a directory if you like for dcl file
;(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(setq fo (open (setq fname "c:\\acadtemp\\getkeys.dcl") "w"))
(write-line "ddgetkey : dialog {" fo)
(write-line " : column {" fo)

(setq num (/ (length info) 3))

(setq x 1)
(repeat num
(setq klist (cons (strcat "key" (rtos x 2 0)) klist))
(setq x (+ 1 x))
)

(setq x 1)
(setq y 1)

(repeat num
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) (strcat "key" (rtos y 2 0)) (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) (nth (- x 1) info) (chr 34) ";"  )   fo)
(write-line (strcat "     edit_width = " (rtos (nth x info) 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos (nth (+ x 1) info) 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "  }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 3))
(setq y (+ y 1))
)
(write-line "  }" fo) 
(write-line "ok_only;}" fo)
(close fo)

(setq x 1)
(setq outlst '())
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetkey" dcl_id))
(exit))

(foreach k klist
     (action_tile k (strcat "(setq " k " (get_tile \"" k "\"))"))
)
 (action_tile "accept" "(done_dialog 1)")
 (action_tile "cancel" "(done_dialog 0)")
 (setq action (start_dialog))
 (unload_dialog dcl_id)


) ; defun

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted

I'm also interested about dcl-lisp wiring-up, but I'm stuck at obtaining the values from the edit_box(es):

 

(defun C:test ( / LstDCL FpathWithFname fileDCL dcl_id dlgRtn Prefix$ Suffix$)

(setq LstDCL
	(list
		"PrefSuff : dialog" 
		"{"
		"label = \"PF\";"
		": boxed_column"
		"{" 
		"label = \"--< Add >--\";"
		": edit_box"
		"{"
		"label = \"Type prefix:\";"
		"key = \"pre\";"
		"edit_width = 10;"
		"}"
		": edit_box"
		"{"
		"label = \"Type suffix:\";"
		"key = \"suf\";"
		"edit_width = 10;"
		"}"
		": spacer"
		"{height = 0.5;}"
		"}"
		"ok_cancel;"
		"}"
	); list
); setq LstDCL
(setq FpathWithFname (vl-filename-mktemp nil nil ".dcl")); studied from LM
(setq fileDCL (open FpathWithFname "w"))
(foreach x LstDCL (write-line x fileDCL))
(close fileDCL) 
; Load Dialog
(setq dcl_id (load_dialog FpathWithFname)) 
(and (not (new_dialog "PrefSuff" dcl_id))(exit))
[color="red"]; UNCLEAR what to do below:
; Set Dialog Initial Settings
(set_tile "pre" Prefix$)
(set_tile "suf" Suffix$)
; Dialog Actions
(action_tile "pre" "(setq Prefix$ $value)")
(action_tile "suf" "(setq Suffix$ $value)")

(if (setq dlgRtn (start_dialog))
	(progn
		(cond 
			((= 1 dlgRtn) ; ok was pressed
				(alert (vl-princ-to-string Prefix$))
				(alert (vl-princ-to-string Suffix$))
				(done_dialog)
			)
			((= 0 dlgRtn) ; cancel was pressed
				(done_dialog)
			)
		)
		; Unload Dialog
		(unload_dialog dcl_id) 
		(vl-file-delete FpathWithFname)
	); progn
); if[/color]
(princ)
);| defun |; (vl-load-com) (princ)

Not sure what exactly to do in the red part of the code, any help?

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Consider the following example:

[color=GREEN];; Prefix/Suffix Text  -  Example by Lee Mac 2016-11-26[/color]
([color=BLUE]defun[/color] c:ps ( [color=BLUE]/[/color] *error* dch dcl des enx idx pre sel str suf )

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 dch) ([color=BLUE]unload_dialog[/color] dch))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'file ([color=BLUE]type[/color] des)) ([color=BLUE]close[/color] des))
       ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'str ([color=BLUE]type[/color] dcl)) ([color=BLUE]setq[/color] dcl ([color=BLUE]findfile[/color] dcl))) ([color=BLUE]vl-file-delete[/color] dcl))
       ([color=BLUE]if[/color] ([color=BLUE]and[/color] msg ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg [color=BLUE]t[/color]) [color=MAROON]"*break,*cancel*,*exit*"[/color])))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )

   ([color=BLUE]cond[/color]
       (   ([color=BLUE]null[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"TEXT,MTEXT"[/color]))))))
       (   ([color=BLUE]not[/color]
               ([color=BLUE]and[/color]
                   ([color=BLUE]setq[/color] dcl ([color=BLUE]vl-filename-mktemp[/color] [color=BLUE]nil[/color] [color=BLUE]nil[/color] [color=MAROON]".dcl"[/color]))
                   ([color=BLUE]setq[/color] des ([color=BLUE]open[/color] dcl [color=MAROON]"w"[/color]))
                   ([color=BLUE]foreach[/color] str
                      '(
                           [color=MAROON]"ps : dialog"[/color]
                           [color=MAROON]"{"[/color]
                           [color=MAROON]"    spacer;"[/color]
                           [color=MAROON]"    label = \"Prefix/Suffix\";"[/color]
                           [color=MAROON]"    : edit_box"[/color]
                           [color=MAROON]"    {"[/color]
                           [color=MAROON]"        label = \"Prefix:\";"[/color]
                           [color=MAROON]"        key = \"pre\";"[/color]
                           [color=MAROON]"        edit_width = 12;"[/color]
                           [color=MAROON]"    }"[/color]
                           [color=MAROON]"    : edit_box"[/color]
                           [color=MAROON]"    {"[/color]
                           [color=MAROON]"        label = \"Suffix:\";"[/color]
                           [color=MAROON]"        key = \"suf\";"[/color]
                           [color=MAROON]"        edit_width = 12;"[/color]
                           [color=MAROON]"    }"[/color]
                           [color=MAROON]"    spacer;"[/color]
                           [color=MAROON]"    ok_cancel;"[/color]
                           [color=MAROON]"}"[/color]
                       )
                       ([color=BLUE]write-line[/color] str des)
                   )
                   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] des ([color=BLUE]close[/color] des)))
                   ([color=BLUE]<[/color] 0 ([color=BLUE]setq[/color] dch ([color=BLUE]load_dialog[/color] dcl)))
                   ([color=BLUE]new_dialog[/color] [color=MAROON]"ps"[/color] dch)
               )
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to write & load DCL file."[/color])
       )
       (   ([color=BLUE]progn[/color]
               ([color=BLUE]setq[/color] pre [color=MAROON]""[/color] suf [color=MAROON]""[/color])
               ([color=BLUE]action_tile[/color] [color=MAROON]"pre"[/color] [color=MAROON]"(setq pre $value)"[/color])
               ([color=BLUE]action_tile[/color] [color=MAROON]"suf"[/color] [color=MAROON]"(setq suf $value)"[/color])
               ([color=BLUE]=[/color] 1 ([color=BLUE]start_dialog[/color]))
           )
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx))))
                     str ([color=BLUE]assoc[/color] 1 enx)
               )
               ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 1 ([color=BLUE]strcat[/color] pre ([color=BLUE]cdr[/color] str) suf)) str enx))
           )
       )
       (   ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color]))
   )
   (*error* [color=BLUE]nil[/color])
   ([color=BLUE]princ[/color])
)

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.

×
 Share
Go to topic listing
×
×
  • Create New...