动起来吧，我的打点机。我造了你的肉身，晓东赐给你灵魂。

ghoust · 发表于 2013-10-24 10:52:00

q3_2006 发表于 2013-10-24 09:22
这算不算有问题。。。不知道程序的用处

这个程序是数控使用的，用最简单的方式输出程序。图元上有圆的地方，就表示在那个地方打一个点。

ghoust · 发表于 2013-10-24 10:55:09

q3_2006 发表于 2013-10-24 09:47
你的手动修改指什么，代码吗？不是可以修改吗？？

我指的是手动修改连接线，路径线。手动修改好后，再按线的坐标来输出。

ghoust · 发表于 2013-10-24 10:55:56

st788796 发表于 2013-10-24 10:46
这就简单了, 一会儿把完整的贴上

{:soso_e181:}谢谢。出来了我让机器运行一上，发视频上来。让大家看看。

st788796 · 发表于 2013-10-24 12:49:19

ghoust 发表于 2013-10-24 10:55
谢谢。出来了我让机器运行一上，发视频上来。让大家看看。

Ok 了，测试一下

(defun c:tt (/ ss cs pts ptl bp i ih header dir lst ps pl)
(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)
)
(if (and
(setq ss (ssget)) ;_选择整个零件，自动计算Box左下角点
(setq cs (ssget "P" '((0 . "circle"))))
(progn (vl-cmdf ".select" ss "")
(setq
ps (ssget "P"
'((0 . "LWPOLYLINE") (8 . "XD-Circle-Path"))
)
)
t
)
)
(progn
(if ps
(setq ptl (xdrx_getpropertyvalue (ssname ps 0) "Vertices"))
(progn
(setq
pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Center"))
(xdrx_pickset->ents 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)
(setq dir (acet-ui-pickdir "选择保存位置"))
)
(progn
(or $globlespeed (setq $globlespeed 50))
(or $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)
)
(strcat "G01Z-2F" (itoa i))
(strcat "G0Z" (itoa ih))
)
)
(mapcar '(lambda (x) (mapcar '- x bp)) (cdr ptl))
)
)
lst (append header ptl '("M30"))
)
(or $globleFilenum (setq $globleFilenum 1))
(xd::list:tofile
(strcat dir
"\\XD-"
(XD::String:Strpad $globleFilenum 4 "0" 0)
".nc"
)
lst
)
(setq $globleFilenum (1+ $globleFilenum))
(princ
(strcat
"\n写出 "
(strcat dir
"\\XD-"
(XD::String:Strpad (1- $globleFilenum) 4 "0" 0)
".nc"
)
" 文件, Ok"
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss cs pts ptl bp i ih header dir lst ps pl) 
  (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) 
  ) 
  (if (and 
 (setq ss (ssget)) ;_选择整个零件，自动计算Box左下角点 
 (setq cs (ssget "P" '((0 . "circle")))) 
 (progn (vl-cmdf ".select" ss "") 
        (setq 
   ps (ssget "P" 
      '((0 . "LWPOLYLINE") (8 . "XD-Circle-Path")) 
      ) 
        ) 
        t 
 ) 
      ) 
    (progn 
      (if ps 
 (setq ptl (xdrx_getpropertyvalue (ssname ps 0) "Vertices")) 
 (progn 
   (setq 
     pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Center")) 
   (xdrx_pickset->ents 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) 
        (setq dir (acet-ui-pickdir "选择保存位置")) 
   ) 
 (progn 
   (or $globlespeed (setq $globlespeed 50)) 
   (or $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) 
        ) 
        (strcat "G01Z-2F" (itoa i)) 
        (strcat "G0Z" (itoa ih)) 
         ) 
       ) 
      (mapcar '(lambda (x) (mapcar '- x bp)) (cdr ptl)) 
    ) 
         ) 
  lst    (append header ptl '("M30")) 
   ) 
   (or $globleFilenum (setq $globleFilenum 1)) 
   (xd::list:tofile 
     (strcat dir 
      "\\XD-" 
      (XD::String:Strpad $globleFilenum 4 "0" 0) 
      ".nc" 
     ) 
     lst 
   ) 
   (setq $globleFilenum (1+ $globleFilenum)) 
   (princ 
     (strcat 
       "\n写出 " 
       (strcat dir 
        "\\XD-" 
        (XD::String:Strpad (1- $globleFilenum) 4 "0" 0) 
        ".nc" 
       ) 
       " 文件, Ok" 
     ) 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

ghoust · 发表于 2013-10-24 13:56:09

st788796 发表于 2013-10-24 12:49
Ok 了，测试一下

大师，能不能把用到的函数一起贴出来一下啊？拜托了。谢谢。现在就等着试机呢。

ghoust · 发表于 2013-10-24 14:11:06

st788796 发表于 2013-10-24 12:49
Ok 了，测试一下

是不是我那里设置不对？还有函数不够啊，我运行就提示这个： QQ图片20131024135817.jpg

st788796 · 发表于 2013-10-24 14:23:50

本帖最后由 st788796 于 2013-10-24 14:28 编辑

ghoust 发表于 2013-10-24 14:11
是不是我那里设置不对？还有函数不够啊，我运行就提示这个：

你用的什么 CAD 版本

需要加载 1023 XDAPI 和 xd-lisp-lib.vlx

ghoust · 发表于 2013-10-24 15:09:25

本帖最后由 ghoust 于 2013-10-24 15:17 编辑

st788796 发表于 2013-10-24 14:23
你用的什么 CAD 版本

需要加载 1023 XDAPI 和 xd-lisp-lib.vlx

我用的2008版的。加载的时候不分先后顺序吧？我试了几次，有时候可以，有时候不可以，还没弄懂为什么呢。
如果我把要加载的那两个文件改名了，还行不行呢？　我加载的两个是：XDRX_API.R17.X32.arx　和xd-lisp-lib.VLX　是这两个吗？谢谢。

ghoust · 发表于 2013-10-24 15:26:53

命令: tt
选择对象: 指定对角点: 找到 4 个

选择对象: .select
选择对象: 找到 4 个

选择对象:
命令: ; 错误: 参数类型错误: 二维/三维点: nil

那个未处理异常的对话框会跳出来三次。

Free-Lancer · 发表于 2013-10-24 15:46:28

本帖最后由 Free-Lancer 于 2013-10-24 15:47 编辑

要把整个零件包括外框都选上，不然坐标就不对了，不要在 UCS 下用
选目录用了ET，可以用API的函数

ghoust · 发表于 2013-10-24 15:50:33

Free-Lancer 发表于 2013-10-24 15:46
要把整个零件包括外框都选上，不然坐标就不对了，不要在 UCS 下用
选目录用了ET，可以用API的函数

请大师指点一下：　　全部选上没问题。　不要在ＵＣＳ下用是什么意思啊？
　　　　　　　　　　选　目录用了ＥＴ，可以用ＡＰＩ的函数又是什么意思啊？

ghoust · 发表于 2013-10-24 16:06:32

我换了台电脑，且重新了CAD2006。在很纯净的环境下加载使用后出现这样的问题：

命令:
命令: tt
选择对象: 指定对角点: 找到 3 个

选择对象: .select
选择对象: 找到 3 个

选择对象:
命令: 接受路径直接输出?[是(Y)/否(N)]<Y>: ; 错误: no function definition:
ACET-UI-PICKDIR
求大师指点啊，，就看要成功了呢。

ghoust · 发表于 2013-10-24 16:10:02

我下载 XDRX_API.R2007.rar 　也按相应的版本下载的，也是相应的版本加载的。还是不行

st788796 · 发表于 2013-10-24 17:36:11

本帖最后由 st788796 于 2013-10-24 21:24 编辑

ghoust 发表于 2013-10-24 16:10
我下载 XDRX_API.R2007.rar 　也按相应的版本下载的，也是相应的版本加载的。还是不行

再试试这个

(defun c:tt (/ ss cs pts ptl bp i ih header dir lst ps pl fn)
(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 cs (ssget "P" '((0 . "circle"))))
(progn (vl-cmdf ".select" ss "")
(setq
ps (ssget "P"
'((0 . "LWPOLYLINE") (8 . "XD-Circle-Path"))
)
)
t
)
)
(progn
(if ps
(setq ptl (xdrx_getpropertyvalue (ssname ps 0) "Vertices"))
(progn
(setq
pts (xd::list:removedup
(mapcar
'(lambda (x) (xdrx_getpropertyvalue x "Center"))
(xdrx_pickset->ents 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 $globlespeed (setq $globlespeed 50))
(or $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)
)
(strcat "G01Z-2F" (itoa i))
(strcat "G0Z" (itoa ih))
)
)
(mapcar '(lambda (x) (mapcar '- x bp)) (cdr ptl))
)
)
lst (append header ptl '("M30"))
)
(xd::list:tofile dir lst)
(setq $globleFilenum (1+ $globleFilenum))
(princ
(strcat "\n写出 " dir " 文件, Ok")
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss cs pts ptl bp i ih header dir lst ps pl fn) 
  (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 cs (ssget "P" '((0 . "circle")))) 
 (progn (vl-cmdf ".select" ss "") 
        (setq 
   ps (ssget "P" 
      '((0 . "LWPOLYLINE") (8 . "XD-Circle-Path")) 
      ) 
        ) 
        t 
 ) 
      ) 
    (progn 
      (if ps 
 (setq ptl (xdrx_getpropertyvalue (ssname ps 0) "Vertices")) 
 (progn 
   (setq 
     pts (xd::list:removedup 
    (mapcar 
      '(lambda (x) (xdrx_getpropertyvalue x "Center")) 
      (xdrx_pickset->ents 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 $globlespeed (setq $globlespeed 50)) 
   (or $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) 
        ) 
        (strcat "G01Z-2F" (itoa i)) 
        (strcat "G0Z" (itoa ih)) 
         ) 
       ) 
      (mapcar '(lambda (x) (mapcar '- x bp)) (cdr ptl)) 
    ) 
         ) 
  lst    (append header ptl '("M30")) 
   ) 
   (xd::list:tofile dir lst) 
   (setq $globleFilenum (1+ $globleFilenum)) 
   (princ 
     (strcat "\n写出 " dir " 文件, Ok") 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

ghoust · 发表于 2013-10-24 17:58:01

本帖最后由 ghoust 于 2013-10-24 18:02 编辑

st788796 发表于 2013-10-24 17:36
再试试这个

这个全部提示OK。但就是没有文件出来呢？
试验了几次，原来所有的文件全部在C盘根目录里，不管保存时目录选择在那里，都保存在C盘根目录里。还请大师修改一下呢。哦，还有，保存的文件没有后缀。那个文件名递增非常好。这样不会重名。{:soso_e179:} QQ图片20131024175534.jpg

真的很感谢你。

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

[已解决] 动起来吧，我的打点机。我造了你的肉身，晓东赐给你灵魂。

点评

点评

点评

点评

点评

点评

点评

点评