需要转出一个文件，测试出错，求高手帮忙看看！

75215195

需要的文件如下：

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:TEST.rar 
下载次数:3  文件大小:23.14 KB 
下载权限: 不限 以上  [免费赚D豆]

工作需要转出CNC钻孔的程式格式，这个程序出错了，求高手帮忙看看

[Actionscript3] 纯文本查看 复制代码

(defun c:jknc (/ ss mz i ent name r rl tt n lts zj entt zb xz yz)
  (defun _princ (str x txt)
  (setvar "cmdecho" 0)
 (princ (strcat str (if (< x 0)
 (progn
  (setq x (atof (substr (rtos x 2 3) 2))) "-") "+" )
                (dig x 3 3)  ;  这个函数类似[color=red][font=Monaco, Consolas,]([/font][/color][color=#666666][font=Monaco, Consolas,]xd::string:strpad [/font][/color][color=green][font=Monaco, Consolas,]2[/font][/color][color=green][font=Monaco, Consolas,].1[/font][/color][color=#666666][font=Monaco, Consolas,] [/font][/color][color=green][font=Monaco, Consolas,]3[/font][/color][color=#666666][font=Monaco, Consolas,] [/font][/color][color=#ff0ff][font=Monaco, Consolas,]"0"[/font][/color][color=#666666][font=Monaco, Consolas,] [/font][/color][color=green][font=Monaco, Consolas,]3[/font][/color][color=red][font=Monaco, Consolas,]) 这个函数 遇到9的时候似乎出错，格式会少一个0[/font][/color]
 ) txt)
  )
  (setvar "cmdecho" 0)
(if (setq ss (ssget "x" '((0 . "circle")(8 . "M0,JD,90,0,1,PIN")))) 
  (progn
    (setq mz (getstring "\n请输入编号:"))
    (setq i -1
          ent nil)
    (while (setq name (ssname ss (setq i (1+ i))))
      (setq r (cdr (assoc 40 (entget name)))
            rl (list r name)
            ent (cons rl ent))
      )
    (setq ent (reverse (xd::list:groupbyindex ent 0.001)))   ;此处颠倒得不到需要的顺序排列 一个问题
    (setq tt (open (strcat "F:/"mz"DB.txt") "W"))
    (foreach n ent
      (setq r (car n)                     ;按半径分类的圆
            lts (cdr n))
      (setq zj (* r 2))
      (princ (strcat"T"(rtos zj 2 2)) tt) ;"T(rtos zj 2 2)刀具 
      (princ "\n" tt)                     ;按刀具大小分类坐标
;;;      (mapcar '(lambda (x)           删去此段注释代码后，可以运行得到需要的"TX.00"的刀具
;;;        (setq entt (entget x)           但运行这段，坐标写不进入，或只能得到一部分。
;;;              zb (cdr (assoc 10 entt))
;;;              xz (car zb)
;;;              yz (cadr zb))
;;;        (_princ "X" xz tt)
;;;        (_princ "Y" yz tt)
;;;        (princ "\n" tt)
;;;        )
;;;              lts
;;;      )
    )
  )
  )
  (CLOSE tt)
  (PRINC)
  )

另坐标的排列能不能是在文件排列循序是 PIN层的圆坐标，再是是1层的圆坐标，再是0层的圆坐标，之后是其他的。
函数和文档在附件。

newer

转出正确的结果是什么样的，截取个图上来

选什么转出，选的要求是什么也带个图上来说明下。

newer

图帮你截取了， 生成的文本文件格式是什么样的，截取前几行代表性的，贴图上来。

你要把圆什么信息提取出去说明下。

marting

(dig x 3 3)

函数JIG是做什么的？

75215195

marting 发表于 2017-8-9 11:37

DIG 3 3 3======>003.000 转换成这样的格式。

75215195

newer 发表于 2017-8-9 11:25

图为需要的

转出(ssget "x" '((0 . "circle")(8 . "M0,JD,90,0,1,PIN"))))所选层的圆
T4.00下面是PIN层的圆坐标   当PIN层没有圆，弹出警告alert 确认后执行一下
T1.00和T1.01下面是1层的圆坐标
T1.15下面是0层的圆坐标
T5.17下面是90层的圆坐标

75215195

newer 发表于 2017-8-9 11:25

格式是.hao     “ T1~n.00”为刀具大小

liunian0524

路过帮顶........

newer

既然用了 晓东通用函数库的函数，写出文件为什么不用 xd::list:tofile ,
表里面把数据都构造好

你程序先遍历选择集，然后把 半径+实体名 构建成关联表，其实，这个地方，就可以吧图层什么的都构建到关联表里面。免得以后程序还的循环处理。

表好了，

xd::list:tofile 就完成了，

想生成ACADTABLE，就 xd::table:makefromlist
想生成 EXCEL 就  XD::Table:ToExcel

还有，必须要TXT文件吗，EXCEL文件不是更方便？，以后在EXCEL里面可以归类筛选啥的。

75215195

newer 发表于 2017-8-9 13:28

生成的文件是让数控钻机器读取的，机械不读EXCEL文件呀。

ll_j

先建一个文本文件，内容是图层顺序，形成索引，然后根据这个索引来过滤，就可以完成按要求的图层排序了。

newer

上面是你提供的图纸计算结果部分截图，完整计算结果见附件TXT，816行数据。
下面是代码，程序关键的地方帮你注释了。

1. (defun c:tt (/ #center #layer #radius bFound fl info info_0 info_1
   
2.                info_other info_pin lst lst1 lst2 mz prefix ss str temp x x_c
   
3.                y y_c
   
4.             )
   
5.   (defun _format (prefix str)
   
6.     (if (minusp str)
   
7.       (strcat prefix "-" (xd::string:strpad (abs str) 3 "0" 3))
   
8.       (strcat prefix "+" (xd::string:strpad (abs str) 3 "0" 3))
   
9.     )
   
10.   )
    
11.   (if (setq ss (ssget '((0 . "circle") (8 . "M0,JD,90,0,1,PIN"))))
    
12.     (progn
    
13.       (setq mz (getstring "\n请输入编号:"))
    
14.       (setq lst (mapcar
    
15.                   '(lambda (x)
    
16.                      (xdrx_getpropertyvalue x "radius" "layer" nil "center")
    
17.                      (if (= #layer "PIN")
    
18.                        (setq bFound t)
    
19.                      )
    
20.                      (setq x_c (_format "X" (car #center))
    
21.                            y_c (_format "Y" (cadr #center))
    
22.                      )
    
23.                      (list #radius (strcase #layer) (strcat x_c y_c))
    
24.                    )
    
25.                   (xdrx_pickset->ents ss)
    
26.                 )
    
27.             lst (xd::list:groupbyindex lst 0.01) ; 半径分组
    
28.             lst1 (vl-sort lst '(lambda (x y)
    
29.                                  (< (car x) (car y))
    
30.                                )
    
31.                  )
    
32.             lst2 (mapcar
    
33.                    '(lambda (x)
    
34.                       (setq fl (strcat "T" (rtos (* 2 (car x)) 2 2))) ; 直径加T
    
35.                       (setq info (cdr x))
    
36.                       (setq temp (xd::list:groupbyindex info 1.0)) ; 同一个直径组里面图层再分组
    
37.                       (setq info_pin (assoc "PIN" temp)
    
38.                             info_0 (assoc "0" temp)
    
39.                             info_1 (assoc "1" temp)
    
40.                             info_other (vl-remove info_pin temp)
    
41.                             info_other (vl-remove info_0 info_other)
    
42.                             info_other (vl-remove info_1 info_other)
    
43.                             info_other (mapcar
    
44.                                          'cdr
    
45.                                          info_other
    
46.                                        )
    
47.                             info_other (apply
    
48.                                          'append
    
49.                                          info_other
    
50.                                        ) ; 其他层坐标信息
    
51.                       )
    
52.                       (vl-remove nil (list fl (cdr info_pin) (cdr info_1)
    
53.                                            (cdr info_0) info_other
    
54.                                      )
    
55.                       )
    
56.                     )
    
57.                    lst1
    
58.                  )
    
59.             lst2 (apply
    
60.                    'append
    
61.                    lst2
    
62.                  )
    
63.       )
    
64.       (xd::list:tofile (strcat "d:\\" mz "db.txt") lst2)
    
65.       (if (not bFound)
    
66.         (alert "没有PIN层数据！")
    
67.       )
    
68.     )
    
69.   )
    
70.   (princ)
    
71. )

(defun c:tt (/ #center #layer #radius bFound fl info info_0 info_1<br />                info_other info_pin lst lst1 lst2 mz prefix ss str temp x x_c<br />                y y_c<br />             )<br />   (defun _format (prefix str)<br />     (if (minusp str)<br />       (strcat prefix "-" (xd::string:strpad (abs str) 3 "0" 3))<br />       (strcat prefix "+" (xd::string:strpad (abs str) 3 "0" 3))<br />     )<br />   )<br />   (if (setq ss (ssget '((0 . "circle") (8 . "M0,JD,90,0,1,PIN"))))<br />     (progn<br />       (setq mz (getstring "\n请输入编号:"))<br />       (setq lst (mapcar<br />                   '(lambda (x)<br />                      (xdrx_getpropertyvalue x "radius" "layer" nil "center")<br />                      (if (= #layer "PIN")<br />                        (setq bFound t)<br />                      )<br />                      (setq x_c (_format "X" (car #center))<br />                            y_c (_format "Y" (cadr #center))<br />                      )<br />                      (list #radius (strcase #layer) (strcat x_c y_c))<br />                    )<br />                   (xdrx_pickset->ents ss)<br />                 )<br />             lst (xd::list:groupbyindex lst 0.01) ; 半径分组<br />             lst1 (vl-sort lst '(lambda (x y)<br />                                  (< (car x) (car y))<br />                                )<br />                  )<br />             lst2 (mapcar<br />                    '(lambda (x)<br />                       (setq fl (strcat "T" (rtos (* 2 (car x)) 2 2))) ; 直径加T<br />                       (setq info (cdr x))<br />                       (setq temp (xd::list:groupbyindex info 1.0)) ; 同一个直径组里面图层再分组<br />                       (setq info_pin (assoc "PIN" temp)<br />                             info_0 (assoc "0" temp)<br />                             info_1 (assoc "1" temp)<br />                             info_other (vl-remove info_pin temp)<br />                             info_other (vl-remove info_0 info_other)<br />                             info_other (vl-remove info_1 info_other)<br />                             info_other (mapcar<br />                                          'cdr<br />                                          info_other<br />                                        )<br />                             info_other (apply<br />                                          'append<br />                                          info_other<br />                                        ) ; 其他层坐标信息<br />                       )<br />                       (vl-remove nil (list fl (cdr info_pin) (cdr info_1)<br />                                            (cdr info_0) info_other<br />                                      )<br />                       )<br />                     )<br />                    lst1<br />                  )<br />             lst2 (apply<br />                    'append<br />                    lst2<br />                  )<br />       )<br />       (xd::list:tofile (strcat "d:\\" mz "db.txt") lst2)<br />       (if (not bFound)<br />         (alert "没有PIN层数据！")<br />       )<br />     )<br />   )<br />   (princ)<br /> )

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:2db.txt 
下载次数:1  文件大小:15.72 KB 
下载权限: 不限 以上  [免费赚D豆]

75215195

newer 发表于 2017-8-9 19:23

感谢你的热心帮助！

jxwfz19740724

看着这么多。眼都花了。