升级LISP函数库Build 2013.12.08后出错了。请高手帮帮忙。。。

ghoust · 发表于 2014-2-17 16:59:40

是这样的，去年得到大师 st788796帮助，写了一个LISP。我下载了坛里的ARX，和API，可以使用了。我用的2008版的。后来API过期了，我就更新成了“LISP函数库Build 2013.12.08”的这个版本。以前那个版本大小是114KB，更新后是的184KB。运行LISP后出现如下现象：

升级API后，得到的程序前后多了一个引号，这样就不了用了。请高手帮帮忙吧。谢谢。

st788796 · 发表于 2014-2-17 16:59:41

本帖最后由 st788796 于 2014-2-17 17:38 编辑

暂时仅升级 API，用旧的 lisp-lib
或者把这个函数放在程序的最前面

(defun XD::List:ToFile (fn lst / fl x)
(setq fl (open fn "w"))
(if (and
fl
(> (length lst) 0)
)
(progn
(mapcar
'(lambda (x)
(write-line x fl)
)
lst
)
(close fl)
t
)
)
)

ghoust · 发表于 2014-2-17 17:01:40

这是st788796大师帮写的LISP。谢谢大家了。

(defun c:tt (/ ss cs pts ptl bp i ih header dir lst ps pl fn el)
  (defun GetPntsPath (bp pts / ptl)
(setq ptl (list bp))
(while pts
   (setq pts (mapcar '(lambda (x)
   (list (distance (car ptl) x) x)
)
pts
  )
   pts (vl-sort pts
(function (lambda (e1 e2)
      (< (car e1) (car e2))
   )
)
  )
   ptl (cons (cadar pts) ptl)
   pts (cdr (mapcar 'cadr pts))
   )
)
(reverse ptl)
  )
  (setvar "dimzin" 0)
  (if (and
(setq ss (ssget)) ;_选择整个零件，自动计算Box左下角点
(setq el (xdrx_pickset->ents ss))
(or (setq
   cs (vl-remove-if-not
   '(lambda (x)
      (= (xdrx_getpropertyvalue x "IsA") "AcDbCircle")
   )
   el
)
   )
   (progn
   (princ "\n程序结束，没有找到圆!")
   nil
   )
)
(progn (setq
ps
(vl-remove-if-not
   '(lambda (x)
      (and
(= (xdrx_getpropertyvalue x "IsA")
   "AcDbPolyline"
)
(= (strcase (car (xdrx_getpropertyvalue
      x
      "Layer"
   )
      )
   )
   "XD-CIRCLE-PATH"
)
      )
   )
   el
)
      )
      (if (<= (length ps) 1)
t
(progn
   (sssetfirst nil (XD::Entity->PickSet ps))
   (princ
   (strcat
      "\n共 "
      (itoa (length ps))
      " 条路径!请保留一条路径或全部删除后再运行!"
   )
   )
   nil
)
      )
)
   )
(progn
   (xdrx_document_ucsoff)
   (if ps
(setq ptl (xdrx_getpropertyvalue (car ps) "Vertices")
   bp  (xdrx_curve_getstartpoint (car ps))
)
(progn
(setq
   pts (xd::list:removedup
(mapcar
   '(lambda (x) (xdrx_getpropertyvalue x "Center"))
   cs
)
  )
   bp (car (xdrx_entity_box ss))
   ptl (getpntspath
bp
(vl-remove-if '(lambda (x) (equal bp x 0.001)) pts)
  )
)
(xdrx_layer_make "XD-Circle-Path" 1)
(setq pl (apply 'xdrx_polyline_make ptl))
(xdrx_setpropertyvalue pl "layer" "XD-Circle-Path")
)
   )
   (if (and (= (xdrx_yesorno "接受路径直接输出" "Y") 1)
      (or $globleFilenum (setq $globleFilenum 1))
      (setq
fn (strcat "XD-"
   (XD::String:Strpad $globleFilenum 4 "0" 0)
   )
      )
      (setq dir (car (xdrx_system_selectfiles
"选择保存位置"
(strcat "c:\\" fn ".nc")
"nc"
1
      )
)
      )
)
(progn
(or (numberp $globlespeed) (setq $globlespeed 200))
(or (numberp $globlehight) (setq $globlehight 5))
(if (and (setq i (getint (strcat "\n切削速度[0-200]<"
      (itoa $globlespeed)
      ">: "
   )
   )
   )
   (< 0 i 201)
   )
   (setq $globlespeed i)
   (setq i $globlespeed)
)
(if (and (setq
   ih (getint (strcat "\n安全高度<"
   (if $globlehight
   (itoa $globlehight)
   (itoa (setq $globlehight 5))
   )
   ">: "
)
)
   )
   (< 0 ih 51)
   )
   (setq $globlehight ih)
   (setq ih $globlehight)
)
(setq header '("G91G28X0Y0Z0"    "G40G17G80G49"
"G90G54"    "G0z5"    "M00"
"M03"       "S1500"
)
  ;;G0X坐标Y坐标Z2    坐标就是框选圆心的坐标，按我的理解，这个应该是离UCS最近那个。
  ;;G01Z-2F50       这里的50就是用户输入的切削速度了。哦，最大值不能超过200，要不然机器就麻烦了。
  ;;G0Z5             这个5也是用户输入的，这是安全高度。最大值50，太高了机器行程不够。
  ptl (apply
'append
(mapcar
   '(lambda (x)
      (list (strcat "G0X"
      (rtos (car x) 2 3)
      "Y"
      (rtos (cadr x) 2 3)
      )
      "G0Z1"
      (strcat "G01Z-2F" (itoa i))
      (strcat "G0Z" (itoa ih))
      )
   )
   (mapcar '(lambda (a) (mapcar '- a bp)) (cdr ptl))
)
      )
  lst (append header ptl '("M30"))
)
(xd::list:tofile dir lst)
(setq $globleFilenum (1+ $globleFilenum))
(princ
   (strcat "\n写出 " dir " 文件, Ok")
)
)
   )
   (xdrx_document_ucson)
)
  )
  (princ)
)

ghoust · 发表于 2014-2-17 19:32:22

st788796 发表于 2014-2-17 17:35
暂时仅升级 API，用旧的 lisp-lib
或者把这个函数放在程序的最前面

太好了。因为API经常都要升级，所以害怕以后用不了。太感谢了大师！。

ghoust · 发表于 2014-2-17 20:12:26

st788796 发表于 2014-2-17 16:59
暂时仅升级 API，用旧的 lisp-lib
或者把这个函数放在程序的最前面

我把程序，加在了最前面，运行后，可以使用。但是命令行每次都会出现很多这样的信息：
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback
; 错误: no function definition: $xdob_reactors_DOCMANAGER_callback

晓东通用LISP函数库Build 2013.12.08加载完毕...Couldn't find OpenDCL.17.arx.

不知有何影响呢？谢谢。

ghoust · 发表于 2014-2-17 20:46:09

我试了几次，应该是VLX不对。因为其它什么都没动，加载114KB那个VLX就没有任何出错提示。加载184KB那个，就会有这样的提示。其它什么都没改。

ysq101 · 发表于 2014-2-18 18:13:47

哇DIY人才又出来了。。。你的机器怎么样了啊？？

ghoust · 发表于 2014-2-19 08:26:22

ysq101 发表于 2014-2-18 18:13
哇DIY人才又出来了。。。你的机器怎么样了啊？？

机器还在装配呢，模型机到是能运行。

sicky111 · 发表于 2014-2-20 11:07:10

ghoust 发表于 2014-2-19 08:26
机器还在装配呢，模型机到是能运行。

多大的机器，能上传一些图片给我们看看不？

ghoust · 发表于 2014-2-20 20:11:20

sicky111 发表于 2014-2-20 11:07
多大的机器，能上传一些图片给我们看看不？

前辈，图来了。。

http://bbs.5imx.com/bbs/forum.php?mod=viewthread&tid=879724&extra=&page=5
这是我在模型论坛发的图片，帖子里有整个过程，有兴趣可以去看一下。目前机器还在调试中。。。。估计十天左右能调试OK吧。

sryf · 发表于 2014-3-2 14:59:21

不太懂。路过，了解下。哈哈

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

[已解决] 升级LISP函数库Build 2013.12.08后出错了。请高手帮帮忙。。。

最佳答案

点评

点评

点评

点评