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

ghoust · 发表于 2013-10-23 02:18:59

这是最终程序，放前面来，让更多人看到。这是st788796的杰作。谢谢你。

(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 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)
"Z2"
)
"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)
)

(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 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) 
         "Z2" 
        ) 
        "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) 
)

得到大家的帮助我高兴得有点激动。也不知道怎么感谢大家，就把所有的D豆贡献出来吧。
   首先是我弄了一台小机器，其实就是微型的数控铣床。机器倒是做好了，可是我不会数控编程的软件啊，看着机器心里那个急啊。由于绘图软件就会CAD，就想着能不能用CAD的外挂，完成最基本的操作。于是有幸来到这里，看到Lispboy帮写的程序后，着实一个激动啊。从设想到真实的看到可行，真的激动。还有Newer版主的指点。太感谢你们了。现在我很期望这样的一个程序能再进一步，能真正的发挥使用的价值，也很希望得到大家的帮助。谢谢。
   我先描述一下吧，我的设想是这样的：
   第一步：输入NC命令后，框选需要处理的模板（坐标原点已设在模板的左下角）；
   第二步：命令行提示（如果有介面更好）输入安全安度：（默认为5）；
   第三步：命令行提示输入切削速度：（默认为50）；
   第四步：用户输入上面两个参数后，回车后便以文本方式输出一个后缀为.nc的文件。（其实输出TXT文件也可以，但是要手动改后缀为NC）。路径由用户选择，就像保存文件那样。如果能记忆上一次的保存位置更佳。
文件名默认为：XDCAD.nc
   　至此结束。
　　神奇的事情发生了，操作如此简单，居然能输出以下的文本：
　　  G91G28X0Y0Z0
　　  G40G17G80G49
      G90G54
      G0z5
      M00
      M03 S1500       ；以上的内容作为固定的文本开头，是不变的。以下内容的其实就是变化每个圆心的坐标。精度到0.000即可。
         G0X坐标Y坐标Z2    坐标就是框选圆心的坐标，按我的理解，这个应该是离UCS最近那个。
　　 G01Z-2F50       这里的50就是用户输入的切削速度了。哦，最大值不能超过200，要不然机器就麻烦了。
　　 G0Z5             这个5也是用户输入的，这是安全高度。最大值50，太高了机器行程不够。
　　　　ＯＫ，第一个点就打好了哦，共有三个地方在变，第一是坐标，第二是切削速度，第三安全高度。
　　　　所有的圆心的坐标都按这格式出来就好了。当然，后台计算的最佳路径就是看不见的了。
　　　M30    　文本的最后以这个结束。这也是固定不变的。
　　　　　　　　　加工完毕！
　　　

以下是我手写的一个样本，输出的文件格式应该和这一样：

G91G28X0Y0Z0
G40G17G80G49
G90G54
G0Z5
M00
M03 S1500

G0X5.105Y4.958Z2
G01Z-2F50
G0Z5
G0X15.230Y9.775Z2
G01Z-2F50
G0Z5
G0X25.000Y31.500Z2
G01Z-2F50
G0Z5
"若干个孔，，，，，，，，"

M30

   对了，所有的0都是数字零。　期待大师的杰作，完了，我上传加工过程图片上来。先谢谢大家了。

st788796 · 发表于 2013-10-23 02:19:00

本帖最后由 st788796 于 2013-10-23 07:49 编辑

虽然是专业应用，去掉专业术语用编程语言来说就是在框选里找出所有 Circle ，包括块内的圆，取圆心坐标，过滤掉重复，转换到当前坐标系下（这个UCS取所有实体的Box左下点？），排行列后按规则写出

ghoust · 发表于 2013-10-23 02:22:48

本帖最后由 ghoust 于 2013-10-23 02:28 编辑

补充一下：对于图内有块不好编程的话，可以要求用户将块炸开。必竟这个操作很快。图片请放大看一下。另外，能不能将函数都放进一个ＬＩＳＰ里面啊，或者能“包装”一下吗？加载一个ＬＩＳＰ就那样。谢谢各位了。
这么晚了，好饿啊，，，，洗　洗　赶紧睡觉，真的有点困了。明天还有得忙呢。各位明天见喽！

ngc · 发表于 2013-10-23 02:42:41

这个就是雕刻机，用精雕做文件，转成nc，应该就可以使用了，很方便的

ghoust · 发表于 2013-10-23 02:45:31

打点和精雕ＮＣ还是不一样的。关键是效率上跟ＣＡＤ没得比。ＣＡＤ直接出ＮＣ了，太爽了。还有就是精雕软件，掌握的人相对ＣＡＤ来说，要少很多，而且操作不如ＣＡＤ简单。

ghoust · 发表于 2013-10-23 02:47:13

ngc 发表于 2013-10-23 02:42
这个就是雕刻机，用精雕做文件，转成nc，应该就可以使用了，很方便的

是不是该睡觉了啊，现在时间，，，是吧。

429014673 · 发表于 2013-10-23 08:25:21

就是一台小铣床嘛，铣孔用的
都有专门软件吧，要不就是楼主不会什么软件，mastercam已经可以解决很多问题了

st788796 · 发表于 2013-10-23 09:40:25

一小部分供参考，写外部文件部分未完成

(defun c:tt (/ getcircleinblk ss ss1 basept e typ ptl)
(defun getcircleinblk (bname)
(mapcar '(lambda (x)
(xdrx_getpropertyvalue x "Center")
)
(xdrx_block_getentities bname '((0 . "circle")))
)
)
(if (and (setq ss (ssget))
(setq ss1 (ssget "P" '((0 . "Circle,Insert"))))
)
(progn
(setq basePt (car (xdrx_entity_box ss)))
(xdrx_setsstodb ss1 0)
(while (setq e (xdrx_getentdata 0))
(setq typ (xdrx_getentdxf 0))
(if (= typ "CIRCLE")
(setq ptl (cons (xdrx_getentdxf 10) ptl))
(if (setq pts (getcircleinblkdef (xdrx_getentdxf 2)))
(setq pts (mapcar '(lambda (p)
(trans p e 0 1)
)
)
ptl (append pts ptl)
)
)
)
)
(setq
ptl (vl-sort (mapcar '(lambda (x) (mapcar - x basept)) ptl)
'(lambda (p1 p2)
(if (equal (cadr p1) (cadr p2))
(< (car p1) (car p2))
(< (cadr p1) (cadr p2))
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ getcircleinblk ss ss1 basept e typ ptl) 
  (defun getcircleinblk (bname) 
    (mapcar '(lambda (x) 
        (xdrx_getpropertyvalue x "Center") 
      ) 
     (xdrx_block_getentities bname '((0 . "circle"))) 
    ) 
  ) 
  (if (and (setq ss (ssget)) 
    (setq ss1 (ssget "P" '((0 . "Circle,Insert")))) 
      ) 
    (progn 
      (setq basePt (car  (xdrx_entity_box ss))) 
      (xdrx_setsstodb ss1 0) 
      (while (setq e (xdrx_getentdata 0)) 
 (setq typ (xdrx_getentdxf 0)) 
 (if (= typ "CIRCLE") 
   (setq ptl (cons (xdrx_getentdxf 10) ptl)) 
   (if (setq pts (getcircleinblkdef (xdrx_getentdxf 2))) 
     (setq pts (mapcar '(lambda (p) 
     (trans p e 0 1) 
          ) 
        ) 
    ptl (append pts ptl) 
     ) 
   ) 
 ) 
      ) 
      (setq 
 ptl (vl-sort (mapcar '(lambda (x) (mapcar - x basept)) ptl) 
       '(lambda (p1 p2) 
   (if (equal (cadr p1) (cadr p2)) 
     (< (car p1) (car p2)) 
     (< (cadr p1) (cadr p2)) 
   ) 
        ) 
     ) 
      ) 
    ) 
  ) 
  (princ) 
)

ghoust · 发表于 2013-10-23 09:47:12

st788796 发表于 2013-10-23 07:46
虽然是专业应用，去掉专业术语用编程语言来说就是在框选里找出所有 Circle ，包括块内的圆，取圆心坐标，过 ...

是的，取左下角为原点。其实专业不专业，关键是看怎么应用。

ghoust · 发表于 2013-10-23 09:58:49

429014673 发表于 2013-10-23 08:25
就是一台小铣床嘛，铣孔用的
都有专门软件吧，要不就是楼主不会什么软件，mastercam已经可以解决很多问题 ...

数控就是一个专业，专业的软件当然有，而且非常多，我知道的就有：MasterCAM,ＰowerMill，ＵＧ，CIMATRON其它还有很多呢。以前我是电脑锣操作员，也会ＭasterCAM编程，七八年之后，我全部忘记了。做机器之前，我还以为能像以前那样熟悉呢。没想到是完全忘了啊。那软件是全英文的，而且介面不是会好。就是因为专业的软件太复杂了，所以才想着用最简单的方法来做。ＣＡＤ是不二之选啊。

ghoust · 发表于 2013-10-23 10:02:26

st788796 发表于 2013-10-23 09:40
一小部分供参考，写外部文件部分未完成

期待佳作完成。

Free-Lancer · 发表于 2013-10-23 11:00:40

本帖最后由 Free-Lancer 于 2013-10-23 11:03 编辑

ghoust 发表于 2013-10-23 10:02
期待佳作完成。

程序要和绘图规则联系起来，比如块里面不要用嵌套块，否则可能找不出所有圆，零件种类很多，非专业编程有个验证准确性问题，因为楼主不懂编程，所以用lisp最好提出坐标后绘制一个连线，检查是不是遗漏，路径是否合理，确认写出文件，否则退出保留pline，手动调整pline节点，下次用pline写文件
非专业，一家之言，仅供参考

ghoust · 发表于 2013-10-23 11:20:44

Free-Lancer 发表于 2013-10-23 11:00
程序要和绘图规则联系起来，比如块里面不要用嵌套块，否则可能找不出所有圆，零件种类很多，非专业编程 ...

大师说得很好啊。你说不用块这个问题可以让用户来完成。编程之前，必须把所有的图元分解即可。这个不影响，专业ＣＡＤ设计的对图元前期处理都没什么问题。　　主要是后面，你说那个连线查漏和手动修改节点非常好。我知道有一个叫ＹＣＵＴ的线切割外挂就是这样的。框选模板后有串连线，有编号，可以手动修改。等下上图让大家看下。

st788796 · 发表于 2013-10-23 12:56:11

ghoust 发表于 2013-10-23 11:20
大师说得很好啊。你说不用块这个问题可以让用户来完成。编程之前，必须把所有的图元分解即可。这个不影响 ...

先写了一个求路径的，效率未必高，总体上也未必是最佳
在圆心连线

(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)
)
(defun c:tt (/ ss pts ptl bp)
(if (setq ss (ssget '((0 . "Circle"))))
(progn
(setq
pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Center"))
(xdrx_pickset->ents ss)
)
bp (car (xdrx_entity_box ss))
ptl (getpntspath
bp
(vl-remove-if '(lambda (x) (equal bp x 0.001)) pts)
)
)
(apply 'xdrx_polyline_make ptl)
)
(princ)
)
)

Lisphk · 发表于 2013-10-23 14:49:11

st788796 发表于 2013-10-23 12:56
先写了一个求路径的，效率未必高，总体上也未必是最佳
在圆心连线

这个路径用了什么算法吗? 给个图更好了。

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

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

最佳答案

点评

纟

点评

评分

点评

点评

评分

点评

点评

点评

评分

点评

点评

点评