[编程申请]：希望修改下面的程序为谢

zhaoyafei19 · 发表于 2006-11-4 12:45:15

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

该程序用于线切割算价
将压缩文件中的文件解压后，放在CAD目录下的SUPPORT文件夹里，加载后可直接使用，快捷命令：LL。
希望修改后增加“切割面积一栏：”
如果可能，去掉“国产机”、进口机“
希望高手修改后传我一份，谢谢
出现如下图片

zhaoyafei19 · 发表于 2006-11-4 12:49:47

三个文件
fanll.dcl的代码如下

chtk: dialog {
   label = "线割费用计算器";
            : edit_box {
               label = "请输入此模板厚度 mm:";
               key = "TAO";
               value = 25.0;
               edit_width = 30;
                           }
         : boxed_column {
         fixed_width = true;
         fixed_height = true;
         label = "请选择线割类型及单价:";
         : boxed_row {
         fixed_width = true;
         fixed_height = true;
         alignment = top;
            : toggle {
               label = "国产机";
               key = "leie";
                           }
            : edit_box {
               label = "直线单价(元/mm2):";
               key = "leia";
               edit_width = 6;
                           }
            : edit_box {
               label = "小孔(元/个):";
               key = "leic";
               edit_width = 6;
                           }}
         : boxed_row {
         fixed_width = true;
         fixed_height = true;
            : toggle {
               label = "进口机";
               key = "leif";
                           }
            : edit_box {
               label = "直线单价(元/mm2):";
               key = "leib";
               edit_width = 6;
                           }
            : edit_box {
               label = "小孔(元/个):";
               key = "leid";
               edit_width = 6;
                           }}
}
ok_cancel ;
}

chta: dialog {
   value = "计算的相关结果为:";
         : boxed_column {
         fixed_width = true;
         fixed_height = true;
            : edit_box {
               label = ".";
               key = "pera";
               value = " ";
               edit_width = 40;
                           }
            : edit_box {
               label = ".";
               key = "perr";
               value = " ";
               edit_width = 40;
                           }
            : edit_box {
               label = ".";
               key = "perc";
               value = " ";
               edit_width = 40;
                           }
            : edit_box {
               label = ".";
               key = "perd";
               value = " ";
               edit_width = 40;
                           }
            : edit_box {
               label = ".";
               key = "perg";
               value = " ";
               edit_width = 40;
                           }
         }
ok_cancel ;
}

zhaoyafei19 · 发表于 2006-11-4 12:51:52

ll.lsp的代码如下

(defun c:ll()
(setvar "cmddia" 0)
(setvar "cmdecho" 0)
(setq per 0)
(setq perr 0)
(setq pere 0)
(setq perf 0)
(setq perg 0)
(setq perb 0)
(setq price "0.033")
(setq tao "25.0")
(setq leie "0")
(setq leif "1")
(setq biao "国产机:")(lla)(setq leia price)
(setq biao "进口机:")(lla)(setq leib price)
(setq biao "进口机小孔:")(lla)(setq leid price)
(setq biao "国产机小孔:")(lla)(setq leic price)
(setq platename "此板")
(setq s (ssget))
(setq dcl_id (load_dialog (findfile "fanll.dcl")))
(if (not (new_dialog "chtk" dcl_id)) (exit))
(set_tile "TAO" tao)
(set_tile "leia" leia)
(set_tile "leib" leib)
(set_tile "leic" leic)
(set_tile "leid" leid)
(set_tile "leie" leie)
(set_tile "leif" leif)
(mode_tile "leid" 0)
(mode_tile "leib" 0)
(mode_tile "leia" 1)
(mode_tile "leic" 1)
(action_tile "leie" "(fcll)")
(action_tile "leif" "(fdll)")
(action_tile "accept" "(fbll)")
(setq dd (start_dialog))
(if (= dd 0)(exit))
(if (= leie "1")
(progn
(setq price (atof leia))
(setq pricea (atof leic)))
(progn
(setq price (atof leib))
(setq pricea (atof leid))
))
(setq nu (sslength s))
(setq kc 0)
(while (< kc nu)
(setq en (ssname s kc))
(setq eni (entget en))
(setq xing (cdr (assoc 0 eni)))
(setq layera (cdr (assoc 8 eni)))
(cond ((= xing "LWPOLYLINE")
(command "_area" "object" en)
(setq per (getvar "perimeter")))
((= xing "ARC")
(setq per (cdr (assoc 40 eni)))
(setq per (* 2 (* per pi)))
(setq aa (cdr (assoc 50 eni)))
(setq ab (cdr (assoc 51 eni)))
(setq ac (+ (- (* 2 pi) aa) ab))
(if (> ac (* 2 pi))
(setq ac (- ac (* 2 pi))))
(setq per (* per (/ ac (* 2 pi)))))
((= xing "CIRCLE")
(setq per (cdr (assoc 40 eni)))
(setq per (* 2 (* per pi)))
(if (< (* price (* per (atof tao))) pricea)
(progn
(setq perb (+ perb 1))
(setq per 0)
))
)
((= xing "LINE")
(setq pointa (cdr (assoc 10 eni)))
(setq pointb (cdr (assoc 11 eni)))
(command "dist" pointa pointb)
(setq per (getvar "distance")))
)
(setq kc (+ kc 1))
(setq perr (+ perr per))
)
(if (/= perr 0)
(progn
(setq pera (* perr 1000))
(setq pera (itoa (fix pera)))
(setq lengtha (strlen pera))
(setq pere (+ perr (*(*(* perr 1000) (atof tao)) price)))
(setq perr (itoa (fix pere)))
(setq lengthb (strlen perr))
(setq perr (strcat platename "线割线价格为：" (substr perr 1 (- lengthb 3)) "." (substr perr (- lengthb 2) 2) "元"))
(setq pera (strcat platename "线割线长度为：" (substr pera 1 (- lengtha 3)) "." (substr pera (- lengtha 2) 2) "mm"))
)
(progn
(setq perr (strcat platename "线割线价格为：" "0.00元"))
(setq pera (strcat platename "线割线长度为：" "0.00mm"))
))
(if (/= perb 0)
(progn
(setq perf (* (* perb pricea) 1000))
(setq perd (itoa (fix (* (* perb pricea) 1000))))
(setq lengthc (strlen perd))
(setq perc (strcat platename "线割孔个数为：" (itoa perb) "个"))
(setq perd (strcat platename "线割孔总价为：" (substr perd 1 (- lengthc 3)) "." (substr perd (- lengthc 2) 2) "元"))
)
(progn
(setq perc (strcat platename "线割孔个数为：" "0个"))
(setq perd (strcat platename "线割孔总价为：" "0.00元"))
))
(setq perg (itoa (fix (+ pere perf))))
(setq lengthd (strlen perg))
(setq perg (strcat "总计：" (substr perg 1 (- lengthd 3)) "." (substr perg (- lengthd 2) 2) "元"))
(if (not (new_dialog "chta" dcl_id)) (exit))
(set_tile "perr" perr)
(set_tile "pera" pera)
(set_tile "perc" perc)
(set_tile "perd" perd)
(set_tile "perg" perg)
(action_tile "accept" "(fall)")
(setq dd (start_dialog))
(if (= dd 0)(exit))
(graphscr)
(setvar "cmddia" 1)
(setvar "cmdecho" 1)
(princ)
)
(defun lla()
(setq sDlgNameAndPath (findfile "slid.txt"))
(setq f (open sDlgNameAndPath "r"))
(setq panzhuan (read-line f))
(while (not (wcmatch panzhuan biao))
(setq panzhuan (read-line f))
(setq price (read-line f)))
(close f)
)
(defun fbll()
(setq tao (get_tile "TAO"))
(setq leia (get_tile "leia"))
(setq leib (get_tile "leib"))
(setq leic (get_tile "leic"))
(setq leid (get_tile "leid"))
(setq leie (get_tile "leie"))
(setq leif (get_tile "leif"))
(done_dialog dcl_id)
)
(defun fall()
(setq perr (get_tile "perr"))
(setq pera (get_tile "pera"))
(done_dialog dcl_id)
)
(defun fcll()
(set_tile "leia" leia)
(set_tile "leic" leic)
(set_tile "leie" "1")
(set_tile "leif" "0")
(mode_tile "leid" 1)
(mode_tile "leib" 1)
(mode_tile "leia" 0)
(mode_tile "leic" 0)
)
(defun fdll()
(set_tile "leib" leib)
(set_tile "leid" leid)
(set_tile "leie" "0")
(set_tile "leif" "1")
(mode_tile "leid" 0)
(mode_tile "leib" 0)
(mode_tile "leia" 1)
(mode_tile "leic" 1)
)

(defun c:ll() 
   (setvar "cmddia" 0) 
   (setvar "cmdecho" 0) 
   (setq per 0) 
   (setq perr 0) 
   (setq pere 0) 
   (setq perf 0) 
   (setq perg 0) 
   (setq perb 0) 
   (setq price "0.033") 
   (setq tao "25.0") 
   (setq leie "0") 
   (setq leif "1") 
   (setq biao "国产机:")(lla)(setq leia price) 
   (setq biao "进口机:")(lla)(setq leib price) 
   (setq biao "进口机小孔:")(lla)(setq leid price) 
   (setq biao "国产机小孔:")(lla)(setq leic price) 
   (setq platename "此板") 
   (setq s (ssget)) 
   (setq dcl_id (load_dialog (findfile "fanll.dcl"))) 
   (if (not (new_dialog "chtk" dcl_id)) (exit)) 
   (set_tile "TAO" tao) 
   (set_tile "leia" leia) 
   (set_tile "leib" leib) 
   (set_tile "leic" leic) 
   (set_tile "leid" leid) 
   (set_tile "leie" leie) 
   (set_tile "leif" leif) 
   (mode_tile "leid" 0) 
   (mode_tile "leib" 0) 
   (mode_tile "leia" 1) 
   (mode_tile "leic" 1) 
   (action_tile "leie" "(fcll)") 
   (action_tile "leif" "(fdll)") 
   (action_tile "accept" "(fbll)") 
   (setq dd (start_dialog)) 
   (if (= dd 0)(exit)) 
   (if (= leie "1") 
       (progn 
       (setq price (atof leia)) 
       (setq pricea (atof leic))) 
       (progn 
       (setq price (atof leib)) 
       (setq pricea (atof leid)) 
     )) 
   (setq nu (sslength s)) 
   (setq kc 0) 
   (while (< kc nu) 
      (setq en (ssname s kc)) 
      (setq eni (entget en)) 
      (setq xing (cdr (assoc 0 eni))) 
      (setq layera (cdr (assoc 8 eni))) 
      (cond ((= xing "LWPOLYLINE") 
            (command "_area" "object" en) 
            (setq per (getvar "perimeter"))) 
           ((= xing "ARC") 
            (setq per (cdr (assoc 40 eni))) 
            (setq per (* 2 (* per pi))) 
            (setq aa (cdr (assoc 50 eni))) 
            (setq ab (cdr (assoc 51 eni))) 
            (setq ac (+ (- (* 2 pi) aa) ab)) 
            (if (> ac (* 2 pi)) 
                (setq ac (- ac (* 2 pi)))) 
            (setq per (* per (/ ac (* 2 pi))))) 
           ((= xing "CIRCLE") 
            (setq per (cdr (assoc 40 eni))) 
            (setq per (* 2 (* per pi))) 
            (if (< (* price (* per (atof tao))) pricea) 
                (progn 
                (setq perb (+ perb 1)) 
                (setq per 0) 
                )) 
            ) 
           ((= xing "LINE") 
            (setq pointa (cdr (assoc 10 eni))) 
            (setq pointb (cdr (assoc 11 eni))) 
            (command "dist" pointa pointb) 
            (setq per (getvar "distance"))) 
          ) 
      (setq kc (+ kc 1)) 
      (setq perr (+ perr per)) 
      ) 
   (if (/= perr 0) 
      (progn 
      (setq pera (* perr 1000)) 
      (setq pera (itoa (fix pera))) 
      (setq lengtha (strlen pera)) 
      (setq pere (+ perr (*(*(* perr 1000) (atof tao)) price))) 
      (setq perr (itoa (fix pere))) 
      (setq lengthb (strlen perr)) 
      (setq perr (strcat platename "线割线价格为：" (substr perr 1 (- lengthb 3)) "." (substr perr (- lengthb 2) 2) "元")) 
      (setq pera (strcat platename "线割线长度为：" (substr pera 1 (- lengtha 3)) "." (substr pera (- lengtha 2) 2) "mm")) 
      ) 
      (progn 
      (setq perr (strcat platename "线割线价格为：" "0.00元")) 
      (setq pera (strcat platename "线割线长度为：" "0.00mm")) 
      )) 
   (if (/= perb 0) 
      (progn 
      (setq perf (* (* perb pricea) 1000)) 
      (setq perd (itoa (fix (* (* perb pricea) 1000)))) 
      (setq lengthc (strlen perd)) 
      (setq perc (strcat platename "线割孔个数为：" (itoa perb) "个")) 
      (setq perd (strcat platename "线割孔总价为：" (substr perd 1 (- lengthc 3)) "." (substr perd (- lengthc 2) 2) "元")) 
      ) 
      (progn 
      (setq perc (strcat platename "线割孔个数为：" "0个")) 
      (setq perd (strcat platename "线割孔总价为：" "0.00元")) 
      )) 
   (setq perg (itoa (fix (+ pere perf)))) 
   (setq lengthd (strlen perg)) 
   (setq perg (strcat "总计：" (substr perg 1 (- lengthd 3)) "." (substr perg (- lengthd 2) 2) "元")) 
   (if (not (new_dialog "chta" dcl_id)) (exit)) 
   (set_tile "perr" perr) 
   (set_tile "pera" pera) 
   (set_tile "perc" perc) 
   (set_tile "perd" perd) 
   (set_tile "perg" perg) 
   (action_tile "accept" "(fall)") 
   (setq dd (start_dialog)) 
   (if (= dd 0)(exit)) 
   (graphscr) 
   (setvar "cmddia" 1) 
   (setvar "cmdecho" 1) 
   (princ) 
) 
(defun lla() 
  (setq sDlgNameAndPath (findfile "slid.txt")) 
  (setq f (open sDlgNameAndPath "r")) 
  (setq panzhuan (read-line f)) 
  (while (not (wcmatch panzhuan biao)) 
       (setq panzhuan (read-line f)) 
       (setq price (read-line f))) 
  (close f) 
  ) 
(defun fbll() 
    (setq tao (get_tile "TAO")) 
    (setq leia (get_tile "leia")) 
    (setq leib (get_tile "leib")) 
    (setq leic (get_tile "leic")) 
    (setq leid (get_tile "leid")) 
    (setq leie (get_tile "leie")) 
    (setq leif (get_tile "leif")) 
    (done_dialog dcl_id) 
) 
   
(defun fall() 
    (setq perr (get_tile "perr")) 
    (setq pera (get_tile "pera")) 
    (done_dialog dcl_id) 
) 
(defun fcll() 
   (set_tile "leia" leia) 
   (set_tile "leic" leic) 
   (set_tile "leie" "1") 
   (set_tile "leif" "0") 
   (mode_tile "leid" 1) 
   (mode_tile "leib" 1) 
   (mode_tile "leia" 0) 
   (mode_tile "leic" 0) 
  ) 
(defun fdll() 
   (set_tile "leib" leib) 
   (set_tile "leid" leid) 
   (set_tile "leie" "0") 
   (set_tile "leif" "1") 
   (mode_tile "leid" 0) 
   (mode_tile "leib" 0) 
   (mode_tile "leia" 1) 
   (mode_tile "leic" 1) 
  )

slid.txt文件的内容如下
These are some refrence data:
国产机:
0.005
进口机:
0.02
国产机小孔:
5.0
进口机小孔:
12.0
end

账号		自动登录	找回密码
密码			立即注册

[编程申请]：希望修改下面的程序为谢

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块