windtalkers 发表于 2010-5-4 16:07:00

[求助] 请高手帮忙调试

danxingpen 发表于 2010-5-5 08:48:00

<p>很简单,找到你那个(-&nbsp;轮廓面积 除料面积)语句,更改为(vl-prin1-to-string (-&nbsp;轮廓面积 除料面积))</p><p>具体的程序就没有看了!</p>

windtalkers 发表于 2010-5-5 09:25:00

<p>请高手明示!不甚感激</p><p>小弟已想了2天,快崩溃了,请帮忙看一下lisp语句哪有问题!</p>

danxingpen 发表于 2010-5-5 10:52:00

<p>不好意思，没有注意看，运行了一下感觉能用，就是导出不能用而已啊！没有出错呢！</p>

hbllw 发表于 2010-5-5 13:48:00

(defun c:kg (/ std id a b l c p d e )
    (setvar "osmode" 0)
      (setq gear_list1_list(list 0.5 0.6 0.8 1.0 1.2 1.5 1.6 1.8 2.0 2.5 2.8 3.0 3.2 3.5 4.0 5.0 6.0 8.0 10.0 12.0 14.0 15.0 16.0 18.0 20.0 ))
      (setq gear_list2_list(list 7.85 2.7 0.8 1.0 ))
      
(defun getdata ()
      (setq a(atof (get_tile "s_out")))
      (setq b(atof (get_tile "s_in")))
      (setq l(get_tile "gear_list1"))
      (setq c(nth(atoi l)gear_list1_list))
      (setq p(get_tile "gear_list2"))
      (setq d(nth(atoi p)gear_list2_list))
      )

(setq id (load_dialog "kg.dcl"))
(if( < id 0 )(exit))
(setq std 1)
   
      (while(= std 1)
   (if(not(new_dialog"kg"id))(exit))
   (action_tile "pick_1" "(done_dialog 1)")
          (action_tile "pick_2" "(done_dialog 2)")
          (action_tile "weight" "(getdata)(oweight)")
(action_tile "goout" "(done_dialog 3)")
          (action_tile "cancel" "(done_dialog 0)")
          (setq std (start_dialog))
(cond
   ((= std 1)
          (vl-load-com);将 Visual LISP 扩展功能载入到 AutoLISP
          (setq my (entsel)) ;"\n选择面域:"
          (while (= my nil) (setq my (entsel)))
          (setq myob (vlax-ename->vla-object (car my)))
          (setq myar (vla-get-area myob));返回面域的面积
   (setq a myar)
   )
   ((= std 2)
          (vl-load-com);将 Visual LISP 扩展功能载入到 AutoLISP
          (setq my1 (entsel)) ;"\n选择面域:"
          (while (= my1 nil) (setq my1 (entsel)))
          (setq myob1 (vlax-ename->vla-object (car my1)))
          (setq myar1 (vla-get-area myob1));返回面域的面积
   (setq b myar1)
   )
   ((= std 3)
          (setq pt (getpoint "指定插入点"))
    (command "text" pt "2.5" "0" (strcat "轮廓面积:" (rtos a) ))
    (command "text" (polar pt (* 1.5 pi) 3.5) "2.5" "0" (strcat "除料面积:" (rtos b)) )
    (command "text" (polar pt (* 1.5 pi) 7) "2.5" "0" (strcat "厚度:" (rtos c )))
    (command "text" (polar pt (* 1.5 pi) 10.5) "2.5" "0" (strcat "密度:" (rtos d) ))
    (if e (command "text" (polar pt (* 1.5 pi) 14) "2.5" "0"(strcat"重量:" (rtos e) )))
   )
   )
)
(unload_dialog id)
(princ)
)

gufeng 发表于 2010-5-5 14:55:00

不知道可否，俺还是新手一个。。。;;; 定义以对话框为界面计算零件重量的命令，命令名为“kg”，需装入kg.dcl文件。
;;; AutoLISP源程序代码
(defun c:kg (/A    B       C   D
      GEAR_LIST1_LIST    GEAR_LIST2_LISTID
      MYMY1    MYAR       MYAR1MYOB
      MYOB1 OLDOSMODEPOINT      STDTEXTSIZE
      TEXTSIZE_B TEXT_P    xsws
   )
(setq gear_list1_list
(list 0.5   0.6   0.81.0   1.2   1.5   1.61.8   2.0
      2.5   2.8   3.03.2   3.5   4.0   5.06.0   8.0
      10.012.014.015.016.018.020.0
       )
)
(setq gear_list2_list (list 7.85 2.7 0.8 1.0))
(setq id (load_dialog "kg.dcl"))
(if (< id 0)
    (exit)
)
(setq std 3)
(while (> std 0)
    (if (not (new_dialog "kg" id))
      (exit)
    )
    (action_tile "pick_1" "(getdata)(done_dialog 1)")
    (action_tile "pick_2" "(getdata)(done_dialog 2)")
    (action_tile "weight" "(getdata)(oweight)")
    (action_tile "cancel" "(done_dialog 0)")
    (action_tile "goout" "(getdata)(done_dialog 999)")
    (set_dialog a b l p)
    (setq std (start_dialog))
    (if (= std 1)
      (progn
(vl-load-com)   ;将 Visual LISP 扩展功能载入到 AutoLISP
(setq my (entsel));"\n选择面域:"
(while (= my nil) (setq my (entsel)))
(setq myob (vlax-ename->vla-object (car my)))
(setq myar (vla-get-area myob)) ;返回面域的面积
(setq a myar)
      )
    )
    (if (= std 2)
      (progn
(vl-load-com)   ;将 Visual LISP 扩展功能载入到 AutoLISP
(setq my1 (entsel));"\n选择面域:"
(while (= my1 nil) (setq my1 (entsel)))
(setq myob1 (vlax-ename->vla-object (car my1)))
(setq myar1 (vla-get-area myob1)) ;返回面域的面积
(setq b myar1)
      )
    )
    (if (= std 999)
      (progn
(setq std 0)
(setq text_p (strcat "轮廓面积:"
      (rtos a 2 4)
      "\n除料面积:"
      (rtos b 2 4)
      "\n厚度:"
      (rtos c 2 4)
      "\n密度:"
      (rtos d 2 4)
      "\n重量:"
      (rtos (* d (* c (- a b))) 2 4)
       )
)
(setq point (getpoint "\n选择点"))
(setq TEXTSIZE 5) ;_文字高度
(setq TEXTSIZE_b 2) ;_行间距倍数
(setq xsws 3) ;_小数位数
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "..text"
   point
   TEXTSIZE
   0
   (strcat "轮廓面积:" (rtos a 2 xsws))
)
(command "..text"
   (setq point (list (nth 0 point)
       (- (nth 1 point) (* TEXTSIZE_b TEXTSIZE))
      )
   )
   TEXTSIZE
   0
   (strcat "除料面积:" (rtos b 2 xsws))
)
(command "..text"
   (setq point (list (nth 0 point)
       (- (nth 1 point) (* TEXTSIZE_b TEXTSIZE))
      )
   )
   TEXTSIZE
   0
   (strcat "厚度:" (rtos c 2 xsws))
)
(command "..text"
   (setq point (list (nth 0 point)
       (- (nth 1 point) (* TEXTSIZE_b TEXTSIZE))
      )
   )
   TEXTSIZE
   0
   (strcat "密度:" (rtos d 2 xsws))
)
(command "..text"
   (setq point (list (nth 0 point)
       (- (nth 1 point) (* TEXTSIZE_b TEXTSIZE))
      )
   )
   TEXTSIZE
   0
   (strcat "重量:" (rtos (* d (* c (- a b))) 2 xsws))
)
(setvar "osmode" oldosmode)
      )
    )
)
(unload_dialog id)
(princ)
)
(defun oweight ()
(setq e (* d (* c (- a b))))
(set_tile "show" (rtos e 2 4))
)
(defun getdata ()
(setq a (atof (get_tile "s_out")))
(setq b (atof (get_tile "s_in")))
(setq l (get_tile "gear_list1"))
(setq c (nth (atoi l) gear_list1_list))
(setq p (get_tile "gear_list2"))
(setq d (nth (atoi p) gear_list2_list))
)
(defun set_dialog (a b l p)
(if a
    (progn
      (set_tile "s_out" (rtos a 2 4))
    )
)
(if b
    (progn
      (set_tile "s_in" (rtos b 2 4))
    )
)
(set_tile "gear_list1" l)
(set_tile "gear_list2" p)
)

windtalkers 发表于 2010-5-5 18:51:00

<p>感谢5楼指教, 但是轮廓面积和除料面积不能及时显示在编辑框内,编辑框总是显示初始值</p><p>请赐教!</p>
页: [1]
查看完整版本: [求助] 请高手帮忙调试