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

st788796 · 发表于 2013-10-25 00:19:37

本帖最后由 st788796 于 2013-10-25 09:33 编辑

ghoust 发表于 2013-10-25 00:02
大师，我发现了个问题呢，你看看一楼，这是我贴出来的格式：
G0X15.230Y9.775Z2 后面有个Z2.
G01Z ...

增加错误提示

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

ghoust · 发表于 2013-10-25 00:22:54

st788796 发表于 2013-10-25 00:19
增加的错误提示

大师，这么晚了还没睡呢。真的是麻烦您了。这么晚了，还帮我改程序。谢谢。

ghoust · 发表于 2013-10-25 00:26:39

OKOK。这下太完美了。我还要再享受享受。。

ghoust · 发表于 2013-10-25 00:38:07

st788796 发表于 2013-10-25 00:19
增加的错误提示

弱弱的问下，现在程序老是提示：选择对象:路径太多!请保留一条 Pline 线!，这是哪个出错了？请大师指点迷津。谢谢。

Free-Lancer · 发表于 2013-10-25 00:46:26

ghoust 发表于 2013-10-25 00:38
弱弱的问下，现在程序老是提示：选择对象:路径太多!请保留一条 Pline 线!，这是哪个出错了？请大师指点迷 ...

看了看程序，应该是零件内部路径线多了，都删除或者保留一条

st788796 · 发表于 2013-10-25 06:52:19

ghoust 发表于 2013-10-25 00:38
弱弱的问下，现在程序老是提示：选择对象:路径太多!请保留一条 Pline 线!，这是哪个出错了？请大师指点迷 ...

76 楼更新，当存在多条路径时会亮显提示

ghoust · 发表于 2013-10-25 08:36:38

st788796 发表于 2013-10-25 06:52
76 楼更新，当存在多条路径时会亮显提示

还是不对，新建一个文件，任意画了个矩形，然后任意画了几个圆在里面。没有其它图元了。然后执行TT。
令: tt
选择对象: 指定对角点: 找到 9 个

选择对象:
选择了 0 条路径!请保留一条或全部删除后再次运行本程序!

图上没有任何变化，也没有出现路径。图层也没有增加。
还得劳驾您一下呢，谢谢。

但是上一次的程序，昨天晚上仔细试了下，执行命令，框选，出红色路径线，OK就直接出程序了。需要修改点NO，把线改好后，再执行TT，然后会按修改好的路径出程序。非常OK。

st788796 · 发表于 2013-10-25 09:34:30

ghoust 发表于 2013-10-25 08:36
还是不对，新建一个文件，任意画了个矩形，然后任意画了几个圆在里面。没有其它图元了。然后执行TT。
令 ...

改提示时漏了, 76 楼程序已更新

ghoust · 发表于 2013-10-25 10:35:59

st788796 发表于 2013-10-25 09:34
改提示时漏了, 76 楼程序已更新

{:soso_e192:}OK了。真的OK了。太爽了啊。

q3_2006 · 发表于 2013-10-25 14:37:10

ghoust 发表于 2013-10-25 10:35
OK了。真的OK了。太爽了啊。

上一段视频吧。。完整欣赏一下。。

ghoust · 发表于 2013-10-25 15:32:57

q3_2006 发表于 2013-10-25 14:37
上一段视频吧。。完整欣赏一下。。

是不是只能上到优酷上，再链接过来？论坛能直接上视频吗？

ghoust · 发表于 2013-10-25 15:38:18

现在开始要组装真正能干活的机器了。也许很难，很费劲。但是尝试是必须的。前面看不到大路，后面没有退路，只能奋力一博了。

sicky111 · 发表于 2013-10-25 23:07:40

ghoust 发表于 2013-10-25 15:38
现在开始要组装真正能干活的机器了。也许很难，很费劲。但是尝试是必须的。前面看不到大路，后面没有退路， ...

加油，朋友，大伙儿都关注着你呢。

ghoust · 发表于 2013-10-26 09:12:28

谢谢你们的鼓励，谢谢你们的帮助。我一定会努力的！

st788796 · 发表于 2013-10-26 10:28:40

ghoust 发表于 2013-10-26 09:12
谢谢你们的鼓励，谢谢你们的帮助。我一定会努力的！

能用就好，欢迎常来

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

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

点评

点评

点评

点评

点评

点评

点评

点评

点评