Convert old program to LISP

[dandrejco]

I was wondering if there was anyone out their who could help me with a project, my drafting department used a product called Medusa which had a really great straight forward down and dirty ductulator which worked really good. I need to bring this into AutoCAD but I dont have the skill in LISP. The following is the original code from Medusa:


define_constant(!ductulator,proc(object,attribute)


if attribute .is. !activate then
ui!ductulator!visible :- true
endif

if object!label .eq. "Cancel" then
ui!ductulator!visible :- false
elif object!label .eq. "Calculate" then

ui!ductulator_ans!label :- "..."

a=to_real(ui!ductulator_a_txt!value)
b=to_real(ui!ductulator_b_txt!value)
new_a = to_real(ui!ductulator_new_txt!value)

De = ductulator_De(a,b)
new_b = ductulator_b(De,new_a)

if new_b > 0 then
ui!ductulator_ans!label :- "Rnd = "><fixed_string(De,2)[2;] >< " New b = " >< fixed_string(new_b,2)[2;]
else
ui!ductulator_ans!label = "Out of bounds."
endif

endif


endproc)

--------------------------------------------------------------------------------
define_constant(!ductulator_De,proc(a,b)
--------------------------------------------------------------------------------
De = (1.3*(a*b)**.625) / ((a + b)**.25)
return De

endproc)

--------------------------------------------------------------------------------
define_constant(!ductulator_b,proc(De,a)
--------------------------------------------------------------------------------
loop for b over range(1,1000,.005)

if abs(ductulator_De(a,b) - De) < .05 then

loop for bb over range(b,b+1,.0001)
if abs(ductulator_De(a,bb) - De) < .0005 then
return bb
endif
endloop

endif

endloop

return 0

endproc)


----------------------------------------------------------------------------------------------------

This program created a window like the jpg attached


Thanks in advance for anyone help...

[Tom1]

Are you still looking for help with this one?

[BlackBox]

The following is the original code from Medusa:

Not to be a jerk, but do you, or your company, have the express permission to publicly distribute their product's source-code?

FWIW -

Perhaps, instead of posting the source-code, you should clearly articulate what it is you need for this routine to do. If others know of an equivalent they point you towards it, or maybe even help get you started.

I would be shocked if someone just writes you the whole routine to order.

[fixo]

Try this lisp, change limits within the code,
be aware I'm not a math, so you need to check
formula on your current dat:

(defun mkdia()
;; create dialog 
(setq dialst(list "ductulator : dialog {"
   (strcat "label = " "\"" "Ductulator" "\"" ";")
   "color = 136;"
  ": boxed_row {"
    ": column {"
     ":row{"
      ": text {"
       (strcat "key = " "\"" "ta" "\""";")
        (strcat "value=" "\"" "Side A:" "\""";")
        "width = 12;"
        "color = 136;"
      "}"
      ":edit_box{"
      (strcat "key = " "\"" "sidea" "\""";")
      "width = 12;"
      "color = 136;"
      "}"
    "}"
         ":row{"
      ": text {"
        (strcat "key = " "\"" "tb " "\""";")
        (strcat "value=" "\"" "Side B:" "\""";")
        "width = 12;"
        "color = 136;"
      "}"
      ":edit_box{"
      (strcat "key = " "\"" "sideb" "\""";")
      "width = 12;"
      "color = 136;"
      "}"
    "}"
         ":row{"
     " :text {"
        (strcat "key = " "\"" "nta" "\""";")
        (strcat "value=" "\"" "New Side A:" "\""";")
       " width = 12;"
       " color = 136;"
      "}"
     " :edit_box{"
      (strcat "key = " "\"" "newsidea" "\""";")
      "width = 12;"
     " color = 136;"
      "}"
   " }"
    "spacer_1;"
"}"
"}"

": boxed_row {"
"height=2;"
":column {"
   ": text {"
        (strcat "key = " "\"" "rnd" "\""";")
        (strcat "value=" "\"" "  Rnd  =" "\""";")
       " width = 8;"
       " color = 136;"
      "}"
      "}"
     " :column {"
   ": text {"
        (strcat "key = " "\"" "value1" "\""";")
        (strcat "value=" "\"" "-" "\""";")
        "width = 8;"
       " color = 136;"
      "}"
      "}"
     " :column {"
  " : text {"
        (strcat "key = " "\"" "newb" "\""";")
        (strcat "value=" "\"" "  New b  =" "\""";")
       " width = 8;"
       " color = 136;"
      "}"
      "}"
     " :column {"
  " : text {"
        (strcat "key = " "\"" "value2" "\""";")
       (strcat "value=" "\"" "-"" \""";")
       " width = 8;"
       " color = 136;"
      "}"
      "}"
"}"

      "spacer;"
      
  "ok_cancel_err;"
"}"
))
;; create dialog in the drawing folder
(setq fn (strcat (getvar "dwgprefix") "ductulator.dcl"))
  
(setq fd (open fn "w"))
;; write to file
(mapcar (function (lambda(txt)(write-line txt fd))) dialst)
  
(close fd)
  
  (princ)
  
  )


(defun c:ductulator ( / dcl_id a b DE accept_clk *error*)

 
 (defun *error* (msg) (princ))
  
 ( mkdia )

 (defun DE (a b)
 (/(* 1.3  (expt(* a b) 0.625)) (expt (+ a  b)0.25)))	

  (defun accepted ()
  
  (setq a (atof (get_tile "sidea"))
   
       b (atof (get_tile "sideb"))
	
     naval (DE a b)
     
     na (set_tile "newsidea" (rtos naval 2 2))
	
     rnd (set_tile "value1" (get_tile "newsidea")))

(setq a (atof na))
    
(setq loop t)
    
(while loop
  
(if (< (abs (- (DE a b) naval)) 0.05)
    (progn
  (setq b (+ b 0.001))
  if (< (abs (- (DE a b) naval)) 0.0005))
  (setq loop nil)
  )
)
(setq nb (set_tile "value2" (rtos b 2)))
  

 (cond
  ;; change limits here 
 ((or (< a 2.0)(> a 100.0))
  (set_tile "sidea" "...")
  (set_tile "sideb" "...")
  (set_tile "newsidea" "...")
  (set_tile "value1" "...")
  (set_tile "value2" "...")
  (set_tile "error" "Admissible value in limits from 2 to 100"))
     
 ((or (< b 2.0)(> b 200.0))
  (set_tile "sidea" "...")
  (set_tile "sideb" "...")
  (set_tile "newsidea" "...")
  (set_tile "value1" "...")
  (set_tile "value2" "...")
  (set_tile "error" "Admissible value in limits from 2 to 200"))
   (T (set_tile "error" " "))
    )
  )

;;; load dialog
 
  (if (> 0 (setq dcl_id (load_dialog fn)))

   (progn
      (alert "Can't load dialog")
    
  (exit)
    )
  )

 (if (not (new_dialog "ductulator" dcl_id))
   
 (progn
    
  (alert "Could not create dialog")
   
   (exit)
    )
  )

 (action_tile  "accept"  "(accepted)")
 
 (action_tile  "cancel"  "(done_dialog 0)")
 

  (setq dcl_rt (start_dialog))

  (unload_dialog dcl_id)
  

;; delete dialog file
  
(vl-file-delete fn)
(princ)

)
(princ "\n\t\t---\tType DUCTULATOR to run form\t---")
(princ)

~'J'~