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

st788796 · 发表于 2013-10-24 18:28:45

ghoust 发表于 2013-10-24 17:58
这个全部提示OK。但就是没有文件出来呢？
试验了几次，原来所有的文件全部在C盘根目录里，不管保存时目 ...

已修改，有个变量写错了

ghoust · 发表于 2013-10-24 18:54:24

st788796 发表于 2013-10-24 18:28
已修改，有个变量写错了

{:soso_e181:}，今天晚上应该可以试机了。有兴趣可以看看视频。等下就发上来。

st788796 · 发表于 2013-10-24 19:00:44

ghoust 发表于 2013-10-24 18:54
，今天晚上应该可以试机了。有兴趣可以看看视频。等下就发上来。

期待你的成功，一定要检查下文件坐标是否正确，毕竟非专业

ghoust · 发表于 2013-10-24 20:20:39

st788796 发表于 2013-10-24 18:28
已修改，有个变量写错了

大师，你忘了贴程序出来了吧？

st788796 · 发表于 2013-10-24 20:26:41

ghoust 发表于 2013-10-24 20:20
大师，你忘了贴程序出来了吧？

在 44 楼帖子修改的
http://bbs.xdcad.net/forum.php?mod=redirect&goto=findpost&ptid=671228&pid=3493653

ghoust · 发表于 2013-10-24 20:45:53

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

大师啊。终于OK了啊。我现在开始试机，顺便拍个视频发上来。

ghoust · 发表于 2013-10-24 21:10:39

st788796 发表于 2013-10-24 20:26
在 44 楼帖子修改的
http://bbs.xdcad.net/forum.php?mod=redirect&goto=findpost&ptid=671228&pid=3493 ...

大师，程序OK。有后缀了，也能按指定地方保存了。还有个地方得麻烦你一下呢。就是多个坐标过滤。
我试了下，有同心圆的地方机器会在同一个地方打两次点，比如：

S1500
G0X80Y80
G01Z-2F50
G0Z5
G0X80Y80
G01Z-2F50
G0Z5
G0X80Y80
G01Z-2F50
G0Z5

机器会在X80Y80的地方点三次。希望大师再改进一下，谢谢啊。
还有个路径，第一次选图元后，就会出现红线路径，这时候我点N回车后，拖动红色多段线的节点，试试，能否改变路径，但是好像输出的程序不受红线控制。是否红色线只是让用户看到是如何走路径的，而不是修改，是吗？
其它未发现问题，谢谢。

st788796 · 发表于 2013-10-24 21:23:20

ghoust 发表于 2013-10-24 21:10
大师，程序OK。有后缀了，也能按指定地方保存了。还有个地方得麻烦你一下呢。就是多个坐标过滤。
我试 ...

加个消除重点函数即可, 看44楼

ghoust · 发表于 2013-10-24 21:23:36

st788796 发表于 2013-10-24 20:26
在 44 楼帖子修改的
http://bbs.xdcad.net/forum.php?mod=redirect&goto=findpost&ptid=671228&pid=3493 ...

我修改了一个红色复线的节点，只是拖动操作，没有炸开。然后再输入TT，再框选，到最后输出的时候就出现上图的错误。
是不是不能这样修改路径节点？或者说只能看路径，不能修改？
还请大师指点一下呢，谢谢。

ghoust · 发表于 2013-10-24 21:34:07

st788796 发表于 2013-10-24 20:26
在 44 楼帖子修改的
http://bbs.xdcad.net/forum.php?mod=redirect&goto=findpost&ptid=671228&pid=3493 ...

执行这个复杂点的，好像不行呢，这提示这个：no function definition: ACET-UI-PICKDIR
我又搜不到这个函数呢？还要麻烦大师一下呢。谢谢了。

st788796 · 发表于 2013-10-24 21:36:09

ghoust 发表于 2013-10-24 21:23
我修改了一个红色复线的节点，只是拖动操作，没有炸开。然后再输入TT，再框选，到最后输出的时候就出现 ...

注意红线的基点不要动

(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")
bp (xdrx_curve_getstartpoint (ssname ps 0))
)
(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 (numberp $globlespeed) (setq $globlespeed 50))
(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)
)
(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")
)
)
)
)
)
(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") 
       bp  (xdrx_curve_getstartpoint (ssname ps 0)) 
 ) 
 (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 (numberp $globlespeed) (setq $globlespeed 50)) 
   (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) 
        ) 
        (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") 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

ghoust · 发表于 2013-10-24 21:46:07

st788796 发表于 2013-10-24 21:23
加个消除重点函数即可, 看44楼

大师，我{:soso_e110:}真的不会加函数。。{:soso_e154:}。下面这段程序是Lispboy大师写的，这段程序是用的WCS坐标，实际应用中就要把每个模板移动到WCS原点才行。程序直接出文件，没有选项，也没有路径线。这个就有重点过滤。希望能两者结合一下吧，大师，就拜托你了。

(defun c:nc ()
(if (setq ss (ssget))
(progn
(setq box (XD::Entity:BOX ss)
base (car box)
elst (xdrx_pickset->ents ss)
elst (XD::Pickset:TableSort ss 0 0 '< '<)
elst (apply 'append elst)
)
(setq tlst (list "G91G28X0Y0Z0" "G40G17G80G49" "G90G54" "G0z5" "M00" "M03" "S1500"))
(foreach e elst
(xdrx_setenttodb e)
(if (= "CIRCLE" (xdrx_getentdxf 0))
(progn
(setq cen (xdrx_getentdxf 10)
cen (mapcar
'-
cen
base
)
node (strcat "G0x" (rtos (car cen) 2 4) "y" (rtos (cadr cen) 2 4) "z2")
tlst (append
tlst
(list node "g01z-2F50" "G0z5")
)
)
)
)
)
(setq tlst (append
tlst
(list "M30")
)
)
(if (and
(setq fn (xdrx_system_selectFiles "选择保存的文件" "c:\\coords.txt" "txt;" 1))
(setq fn (car fn))
(XD::List:ToFile fn tlst)
)
(progn
(prompt (strcat "\n成功将坐标信息写到" fn "下."))
)
)
)
)
(princ)
)
;|
表内容写文本文件
参数：
fn -- 文件名，如： "c:\\abc.txt"
lst-- 表
成功返回T，否NIL
|;
(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 (vl-princ-to-string x) fl)
)
lst
)
(close fl)
t
)
)
)

(defun c:nc () 
  (if (setq ss (ssget)) 
    (progn 
      (setq box (XD::Entity:BOX ss) 
            base (car box) 
            elst (xdrx_pickset->ents ss) 
            elst (XD::Pickset:TableSort ss 0 0 '< '<) 
            elst (apply 'append elst) 
      ) 
      (setq tlst (list "G91G28X0Y0Z0" "G40G17G80G49" "G90G54" "G0z5" "M00" "M03" "S1500")) 
      (foreach e elst 
        (xdrx_setenttodb e) 
        (if (= "CIRCLE" (xdrx_getentdxf 0)) 
          (progn 
            (setq cen (xdrx_getentdxf 10) 
                  cen (mapcar 
                        '- 
                        cen 
                        base 
                      ) 
                  node (strcat "G0x" (rtos (car cen) 2 4) "y" (rtos (cadr cen) 2 4) "z2") 
                  tlst (append 
                         tlst 
                         (list node "g01z-2F50" "G0z5") 
                       ) 
            ) 
          ) 
        ) 
      ) 
      (setq tlst (append 
                   tlst 
                   (list "M30") 
                 ) 
      ) 
      (if (and 
            (setq fn (xdrx_system_selectFiles "选择保存的文件" "c:\\coords.txt" "txt;" 1)) 
            (setq fn (car fn)) 
            (XD::List:ToFile fn tlst) 
          ) 
        (progn 
          (prompt (strcat "\n成功将坐标信息写到" fn "下.")) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
) 
;| 
表内容写文本文件 
参数： 
  fn -- 文件名， 如： "c:\\abc.txt" 
  lst-- 表 
 
成功返回T，否NIL 
|; 
(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 (vl-princ-to-string x) fl) 
         ) 
        lst 
      ) 
      (close fl) 
      t 
    ) 
  ) 
)

ghoust · 发表于 2013-10-24 21:49:14

st788796 发表于 2013-10-24 21:36
注意红线的基点不要动

这个能处理很复杂的模板了。马上试机。我看看重点过滤功能应该OK

st788796 · 发表于 2013-10-24 21:50:54

ghoust 发表于 2013-10-24 21:49
这个能处理很复杂的模板了。马上试机。我看看重点过滤功能应该OK

过滤重复点已经加上了

ghoust · 发表于 2013-10-24 22:04:08

st788796 发表于 2013-10-24 21:50
过滤重复点已经加上了

大师你太快了。比我还快。稍等就有结果了。。。。。

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

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

点评

点评