设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 加帮忙修改一下代码，非常感谢
123下一页
返回列表 发新帖
查看: 5817|回复: 44

[求助] 加帮忙修改一下代码，非常感谢

[复制链接]
abc498091367

已领礼包: 60个

财富等级: 招财进宝
发表于 2014-8-13 17:59:56 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
原地址是资料的:http://bbs.xdcad.net/forum.php?mod=viewthread&tid=548394&page=1#pid2761243
想请帮忙加个框选后程序打散(现在程序封闭线不能打散，导致框选后输出的数据不全)

老程序找了好久，请帮忙一下，谢谢！

;; Design BY Ayungerstudio 2006.05.07   
;;; Template: AutoCAD 2002 为浙江网友定制
;;;**************************************
;;; No.1 DWG对象输出到 *.dat  函数      
;;;**************************************
(defun C:DWGDAT(/ FLTR ss1 n i DATfile fp entName entData entType Pt0 Pt1 Pt2 R string aa cc ll)

  (setq FLTR '((-4 . "<OR")      
                      (0 . "ARC")
                      (0 . "CIRCLE")
                      (0 . "LINE")
                      (-4 . "OR>")
                      );end_list
        );end_seqt

        (setq ss1 (ssget FLTR))   
        (if (= ss1 nil) (exit))
        (setq n (sslength ss1))
        (if (= n 0) (exit))
        (setvar "cmdecho" 0)

        (if (= #AY_DWGDATCURPATH nil) (setq #AY_DWGDATCURPATH ""))
        (setq DATFile (getfiled "输出*.DAT文件" #AY_DWGDATCURPATH "DAT" 1))
        (if (= DATFile nil) (progn (princ "\n错误: 没有选取DAT文件,程序退出!") (exit)))

        (setq #AY_DWGDATCURPATH (strcat (vl-filename-directory DATfile) "\\"))
        (setq fp (open DATfile "W"))
        (setq oldDimZin (getvar "DIMZIN"))
        (setvar "DIMZIN" 1)
  (setq oldLupRec (getvar "LUPREC"))
  (setvar "LUPREC" 6)

        ;;output the "LINE" object information.
        (setq ll 1)
        (setq i 0)
  (while (< i n)
                (setq entName (ssname ss1 i))
                (setq entData (entget entName))
                (setq entType (cdr (assoc 0 entData)))
                (if (= entType "LINE")
                        (progn
                          (setq Pt0 (cdr (assoc 10 entData)))
                          (setq Pt1 (cdr (assoc 11 entData)))
                          (setq string1 (strcat (if (< ll 100) "L " "L") (itoa ll) "= " (rtos (car Pt0)

2) ", " (rtos (cadr Pt0) 2) ", "


                  (rtos (car Pt1) 2) ", " (rtos (cadr Pt1) 2)))
                          (setq ll (+ ll 1))
                          (write-line string1 fp)
                        );end_progn
                );end_if
                (setq i (+ i 1))
        );end_while

        ;;output the "CIRCLE" object information.
        (setq cc 1)
        (setq i 0)
  (while (< i n)
                (setq entName (ssname ss1 i))
                (setq entData (entget entName))
                (setq entType (cdr (assoc 0 entData)))
                (if (= entType "CIRCLE")
                        (progn
                          (setq Pt0 (cdr (assoc 10 entData)))
                          (setq R (cdr (assoc 40 entData)))
                           (setq string1 (strcat (if (< cc 100) "C " "C") (itoa cc) "= " (rtos (car

Pt0) 2) ", " (rtos (cadr Pt0) 2) ", " (rtos R 2)))
                          (setq cc (+ cc 1))
                          (write-line string1 fp)
                        );end_progn
                );end_if
                (setq i (+ i 1))
        );end_while

        ;;output the "ARC" object information.
        (setq aa 1)
        (setq i 0)
  (while (< i n)
                (setq entName (ssname ss1 i))
                (setq entData (entget entName))
                (setq entType (cdr (assoc 0 entData)))
                (if (= entType "ARC")
                        (progn
                          (setq Pt0 (cdr (assoc 10 entData)))
                          (setq R (cdr (assoc 40 entData)))
                          (setq sAngle (cdr (assoc 50 entData)))
                          (setq eAngle (cdr (assoc 51 entData)))
                          (setq Pt1 (polar Pt0 sAngle R))
                          (setq Pt2 (polar Pt0 eAngle R))
                          (setq string1 (strcat (if (< aa 100) "A " "A") (itoa aa) "= " (rtos (car Pt0)

2) ", " (rtos (cadr Pt0) 2) ", "


                  (rtos (car Pt1) 2) ", " (rtos (cadr Pt1) 2) ", "


                  (rtos (car Pt2) 2) ", " (rtos (cadr Pt2) 2) ", N"))
                                (setq aa (+ aa 1))
                          (write-line string1 fp)
                        );end_progn
                );end_if
                (setq i (+ i 1))
        );end_while

        (close fp)
        (princ "/n DAT输出完成!")
        (setvar "DIMZIN" oldDimZin)
  (setvar "LUPREC" oldLupRec)
        (princ)
);end_defun

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2014-8-13 20:43:24 | 显示全部楼层
  2. ;; Design BY Ayungerstudio 2006.05.07   
  3. ;;; Template: AutoCAD 2002 为浙江网友定制
  4. ;;;**************************************
  5. ;;; No.1 DWG对象输出到 *.dat  函数      
  6. ;;;**************************************
  7. (defun CWGDAT(/ FLTR ss1 n i DATfile fp entName entData entType Pt0 Pt1 Pt2 R string aa cc ll)
  8. (setvar "CMDECHO" 0)
  9. (if (and (princ "请选择: ") (setq ss (ssget))) (progn
  10.   (if (setq ss1 (ssget "P" '((0 . "*POLYLINE")))) (progn
  11.    (setvar "QAFLAGS" 1)
  12.    (command "_.EXPLODE" ss1 "")
  13.    (setvar "QAFLAGS" 0)
  14.    (setq ss1 (ssget "P"))
  15.   ))
  16.   (command "SELECT" ss ss1 "")
  17.   (setq ss1 (ssget "P"))
  18.   (setq fnm (if (= (type fnm) 'STR) fnm ""))
  19.   (if (setq fnm (getfiled "输出*.DAT文件" fnm "DAT" 1)) (progn
  20.    (setq fp (open fnm "W"))
  21.    (setq oldDimZin (getvar "DIMZIN"))
  22.    (setvar "DIMZIN" 1)
  23.    (setq oldLupRec (getvar "LUPREC"))
  24.    (setvar "LUPREC" 6)
  25.         ;;output the "LINE" object information.
  26.    (setq ll 1)
  27.    (setq i 0)
  28.    (repeat (sslength ss1)
  29.     (setq entName (ssname ss1 i))
  30.     (setq entData (entget entName))
  31.     (setq entType (cdr (assoc 0 entData)))
  32.     (if (= entType "LINE") (progn
  33.      (setq Pt0 (cdr (assoc 10 entData)))
  34.      (setq Pt1 (cdr (assoc 11 entData)))
  35.      (setq string1
  36.       (strcat (if (< ll 100) "L " "L")
  37.        (itoa ll) "= " (rtos (car Pt0) 2) ", " (rtos (cadr Pt0) 2) ", "
  38.        (rtos (car Pt1) 2) ", " (rtos (cadr Pt1) 2))
  39.      )
  40.      (setq ll (1+ ll))
  41.      (write-line string1 fp)
  42.     ));if
  43.     (setq i (1+ i))
  44.    );repeat
  45.    ;;output the "CIRCLE" object information.
  46.    (setq cc 1)
  47.    (setq i 0)
  48.    (repeat (sslength ss1)
  49.     (setq entName (ssname ss1 i))
  50.     (setq entData (entget entName))
  51.     (setq entType (cdr (assoc 0 entData)))
  52.     (if (= entType "CIRCLE") (progn
  53.      (setq Pt0 (cdr (assoc 10 entData)))
  54.      (setq R (cdr (assoc 40 entData)))
  55.      (setq string1
  56.       (strcat (if (< cc 100) "C " "C")
  57.        (itoa cc) "= " (rtos (car Pt0) 2) ", " (rtos (cadr Pt0) 2) ", " (rtos R 2))
  58.      )
  59.      (setq cc (1+ cc))
  60.      (write-line string1 fp)
  61.     ));f
  62.     (setq i (1+ i))
  63.    );repeat
  64.    ;;output the "ARC" object information.
  65.    (setq aa 1)
  66.    (setq i 0)
  67.    (repeat (sslength ss1)
  68.     (setq entName (ssname ss1 i))
  69.     (setq entData (entget entName))
  70.     (setq entType (cdr (assoc 0 entData)))
  71.     (if (= entType "ARC") (progn
  72.      (setq Pt0 (cdr (assoc 10 entData)))
  73.      (setq R (cdr (assoc 40 entData)))
  74.      (setq sAngle (cdr (assoc 50 entData)))
  75.      (setq eAngle (cdr (assoc 51 entData)))
  76.      (setq Pt1 (polar Pt0 sAngle R))
  77.      (setq Pt2 (polar Pt0 eAngle R))
  78.      (setq string1
  79.       (strcat (if (< aa 100) "A " "A")
  80.        (itoa aa) "= " (rtos (car Pt0) 2) ", " (rtos (cadr Pt0) 2) ", "
  81.        (rtos (car Pt1) 2) ", " (rtos (cadr Pt1) 2) ", "
  82.        (rtos (car Pt2) 2) ", " (rtos (cadr Pt2) 2) ", N")
  83.      )
  84.      (setq aa (1+ aa))
  85.      (write-line string1 fp)
  86.     ));if
  87.     (setq i (1+ i))
  88.    );repeat
  89.    (close fp)
  90.    (princ "/n DAT输出完成!")
  91.    (setvar "DIMZIN" oldDimZin)
  92.    (setvar "LUPREC" oldLupRec)
  93.   ))
  94. ))
  95. (princ)
  96. )

点评

abc498091367
你好；ZXQ0220，后面我发给你的那源码，感觉有问题，我输出文件的时候，圆比较多的话变行了，输出的圆坐标变行，你帮忙检查一下是不是那有不对,xie  详情 回复 发表于 2014-8-14 14:44
abc498091367
谢，非常好，特别感谢！另外还想麻烦一下ZXQ0220；帮我修改一下这程序现在程序是（转出去的坐标都OK,只是有一点，转文件时每一种圆的直径都需要手动输入，想麻烦ZXQ0220帮我修改成，有个选择1.回车或鼠标右键默认大  详情 回复 发表于 2014-8-14 09:45
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-14 09:45:41 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
zxq0220 发表于 2014-8-13 20:43

谢，非常好，特别感谢！另外还想麻烦一下ZXQ0220；帮我修改一下这程序现在程序是（转出去的坐标都OK,只是有一点，转文件时每一种圆的直径都需要手动输入，想麻烦ZXQ0220帮我修改成，有个选择1.回车或鼠标右键默认大小，2.手动加大。现在程序就是手动加大，我就想加一个默认的，不用改，就怕有十几种全部都去输入一次，有点浪费时间！谢谢）




(defun c:cnc()
(PRINC "\n请选要输出的圆[提示:不要的层最好关闭]")
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "CIRCLE")))) (progn
  (command ".UNDO" "BE")
  (setq i -1  cirlst (list))
  (repeat (sslength ss)
   (setq r (cdr (assoc 40 (entget (setq en (ssname ss (setq i (1+ i))))))))
   (if (assoc r cirlst)
(setq cirlst (subst (cons r (1+ (cdr (assoc r cirlst)))) (assoc r cirlst) cirlst))
    (setq cirlst (cons (cons r 1) cirlst))
   )
  )
  (setq i -1 cirlst (reverse cirlst) cclist (list))
  (setq cirlst (vl-sort cirlst (function (lambda (e1 e2) (> (car e1) (car e2))))))
  (repeat (length cirlst)
   (setq r (car (nth (setq i (1+ i)) cirlst)))
   (command "select" ss "")
   (setq ss1 (ssget "P" (list (cons 0 "CIRCLE") (cons 40 r))))
   (setq r1 (getdist (strcat "\n输入新直径<" (rtos (+ r r) 2 2) "> :")))
   (setq r (if r1 (* r1 0.5) r))
   (setq j 0 clist (list r))
   (repeat (sslength ss1)
    (setq ent (entget(ssname ss1 j)))
(setq j (1+ j))
(setq pc (cdr(assoc 10 ent)))
(setq clist (append clist (list (list (car pc) (cadr pc)))))
   )
   (setq cclist (cons clist cclist))
  )
  (setq nm (if nm nm ""))
  (if (setq nm (getfiled "输出钻孔文件的目录" nm "rot" 1)) (progn
   (setq i 0)
   (setq fp (open nm "w"))
   (princ "M48\nMETRIC,LZ\nVER,1\nFMAT,2\n" fp)
   (repeat (length cclist)
    (setq r (car(nth i cclist)))
    (setq i (1+ i))                                                         
    (princ (strcat "T" (if (< i 10) "0" "") (itoa i) "C" (rtos (+ r r) 2 3) "F42B423S6H2000\n") fp)
   )
   (princ "DETECT,ON\nATC,ON\n%\n" fp)
   (setq i 0)
   (repeat (length cclist)
    (setq clist (nth i cclist) i (1+ i))
(princ (strcat "T" (if (< i 10) "0" "") (itoa i) "\n") fp)
(setq j 0 clist (cdr clist))
(repeat (length clist)
  (setq pc (nth j clist) j (1+ j))
  (princ (strcat "X" (rtos (car pc) 2 3) "Y" (rtos (cadr pc) 2 3) "\n") fp)
)
   )
   (princ "M30\n" fp)
   (close fp)
  ))
  (command ".UNDO" "E")
))
(setvar "CMDECHO" 1)
(princ)
)


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
发表于 2014-8-14 10:31:06 | 显示全部楼层

第一个程序，分类时写成函数形式，Polyline 用 API  不需要炸开
  1.   (defun pnt->str (p)
  2.     (strcat (rtos (car p) 2) "," (rtos (cadr p) 2))
  3.   )
  4.   (defun Line_info (ln / sp ep)
  5.     (setq sp (xdrx_curve_getstartpoint ln)
  6.           ep (xdrx_curve_getendpoint ln)
  7.     )
  8.     (list
  9.       (list "LINE" (strcat "=" (pnt->str sp) "," (pnt->str ep)))
  10.     )
  11.   )
  12.   (defun Arc_Info (arc / pts spm epm cen)
  13.     (setq pts (xdrx_curve_getpoint arc)
  14.           spm (xdrx_getpropertyvalue arc "startpam")
  15.           epm (xdrx_getpropertyvalue arc "endpam")
  16.           cen (xdrx_getpropertyvalue arc "center")
  17.     )
  18.     (list (list        "ARC"
  19.                 (strcat        "="
  20.                         (pnt->str cen)
  21.                         ","
  22.                         (pnt->str (car pts))
  23.                         ","
  24.                         (pnt->str (last pts))
  25.                         ","
  26.                         (if (> spm epm)
  27.                           "S"
  28.                           "N"
  29.                         )
  30.                 )
  31.           )
  32.     )
  33.   )
  34.   (defun Circle_info (circle)
  35.     (list
  36.       (list "CIRCLE"
  37.             "="
  38.             (pnt->str (xdrx_getpropertyvalue circle "center"))
  39.             ","
  40.             (rtos (xdrx_getpropertyvalue circle "Radius") 2)
  41.       )
  42.     )
  43.   )
  44.   (defun Polyline_info (pline / n i key pts ll lst)
  45.     (setq n (xdrx_polyline_numverts pline)
  46.           i 0
  47.     )
  48.     (repeat (1- n)
  49.       (setq key (xdrx_polyline_segtype pline i))
  50.       (if (= key "kLine")
  51.         (progn
  52.           (setq pts (xdrx_polyline_getlinesegat pline i))
  53.           (setq        ll (cons (list
  54.                            "LINE"
  55.                            (strcat "="
  56.                                    (pnt->str (car pts))
  57.                                    ","
  58.                                    (pnt->str (cadr pts))
  59.                            )
  60.                          )
  61.                          ll
  62.                    )
  63.           )
  64.         )
  65.         (progn
  66.           (setq lst (xdrx_polyline_getarcsegat pline i))
  67.           (setq        ll
  68.                  (cons
  69.                    (list "ARC"
  70.                          "="
  71.                          (pnt->str (cadr lst))
  72.                          ","
  73.                          (pnt->str (xdrx_polyline_getpointat pline i))
  74.                          ","
  75.                          (pnt->str (xdrx_polyline_getpointat pline (1+ i)))
  76.                          ","
  77.                          (rtos (caddr lst) 2)
  78.                    )
  79.                    ll
  80.                  )
  81.           )
  82.         )
  83.       )
  84.       (setq i (1+ i))
  85.     )
  86.     ll
  87.   )

点评

abc498091367
哦，我试试，谢谢  详情 回复 发表于 2014-8-14 11:06
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-14 11:06:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
Free-Lancer 发表于 2014-8-14 10:31
第一个程序，分类时写成函数形式，Polyline 用 API  不需要炸开

哦，我试试，谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-14 14:44:30 | 显示全部楼层
zxq0220 发表于 2014-8-13 20:43

你好；ZXQ0220，后面我发给你的那源码，感觉有问题，我输出文件的时候，圆比较多的话变行了，输出的圆坐标变行，你帮忙检查一下是不是那有不对,xie

点评

zxq0220
不明白什么是变行 输入一次新直径？不知道要怎么处理  详情 回复 发表于 2014-8-14 20:02
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2014-8-14 20:02:52 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
abc498091367 发表于 2014-8-14 14:44
你好；ZXQ0220，后面我发给你的那源码，感觉有问题，我输出文件的时候，圆比较多的话变行了，输出的圆坐 ...

不明白什么是变行
输入一次新直径？不知道要怎么处理

点评

abc498091367
你好zxq0220，你可以复制一下程序试一下， 命令: cnc 输入新直径 : 2.1 输入新直径 :0.9 现在程序是这样。输入命令后需要手动输入一次直径，而且还是从大到小，想改成从小到大。。。 另外加一个选择： 命  详情 回复 发表于 2014-8-15 09:46
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-15 09:46:47 | 显示全部楼层
zxq0220 发表于 2014-8-14 20:02
不明白什么是变行
输入一次新直径？不知道要怎么处理

你好zxq0220，你可以复制一下程序试一下，
命令: cnc
输入新直径<2.0> : 2.1
输入新直径<0.66> :0.9

现在程序是这样。输入命令后需要手动输入一次直径，而且还是从大到小，想改成从小到大。。。

另外加一个选择：
命令:CNC
(不用加按1; 手动加新直径按2)  意思就是不用加就马上输出，不用输入新直径,这样方便。如果按2就输入新直径，就现在程序本身的这样但是要改成从小大到。







点评

zxq0220
改成从小到大容易，但按1按2是怎么回事？如果不改孔径对原始数据要怎么处理？  详情 回复 发表于 2014-8-15 19:38
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2014-8-15 19:38:35 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
abc498091367 发表于 2014-8-15 09:46
你好zxq0220，你可以复制一下程序试一下，
命令: cnc
输入新直径 : 2.1

改成从小到大容易，但按1按2是怎么回事？如果不改孔径对原始数据要怎么处理？

点评

abc498091367
不改就是默认的大小，框选的圆是多大就多大，就不输入新直径，但是也要输出全部框选的圆坐标.(比如1.0输出的就是1.0，1.1输出的就是1.1) 命令：CNC 1.默认大小(回车或鼠标右键)，2.手动输入新直径 1. 保存输出  详情 回复 发表于 2014-8-15 22:13
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-15 22:13:20 | 显示全部楼层
zxq0220 发表于 2014-8-15 19:38
改成从小到大容易，但按1按2是怎么回事？如果不改孔径对原始数据要怎么处理？

不改就是默认的大小，框选的圆是多大就多大，就不输入新直径，但是也要输出全部框选的圆坐标.(比如1.0输出的就是1.0，1.1输出的就是1.1)
命令：CNC
1.默认大小(回车或鼠标右键)，2.手动输入新直径
1.
  保存输出的目录窗口

命令：CNC
1.默认大小，2.手动输入
2.
  原<1.0>请输出新直径:1.1

  原<1.1>请输出新直径:1.2
  原<1.2>请输出新直径:1.6
  原<1.3> 请输出新直径:1.8
  保存输出的目录窗口

加大的就是需要按键盘手动输入新直径，就是程序现在本身这样，只需要改下从小到大.


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2014-8-16 07:38:17 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  2. (defun c:cnc()
  3. (setvar "CMDECHO" 0)
  4. (princ "\n请选要输出的圆[提示:不要的层最好关闭]")
  5. (if (and (setq n (getint "\n<1=默认大小>,2=手动输入: "))
  6.             (setq ss (ssget '((0 . "CIRCLE"))))) (progn
  7.   (command ".UNDO" "BE")
  8.   (setq i -1  cirlst (list))
  9.   (repeat (sslength ss)
  10.    (setq r (cdr (assoc 40 (entget (setq en (ssname ss (setq i (1+ i))))))))
  11.    (if (assoc r cirlst)
  12. (setq cirlst (subst (cons r (1+ (cdr (assoc r cirlst)))) (assoc r cirlst) cirlst))
  13.     (setq cirlst (cons (cons r 1) cirlst))
  14.    )
  15.   )
  16.   (setq i -1 cirlst (reverse cirlst) cclist (list))
  17.   (setq cirlst (vl-sort cirlst (function (lambda (e1 e2) (> (car e1) (car e2))))))
  18.   (repeat (length cirlst)
  19.    (setq r (car (nth (setq i (1+ i)) cirlst)))
  20.    (command "select" ss "")
  21.    (setq ss1 (ssget "P" (list (cons 0 "CIRCLE") (cons 40 r))))
  22.    (if (/= n 2) (progn
  23.    (setq r1 (getdist (strcat "\n输入新直径<" (rtos (+ r r) 2 2) "> :")))
  24.    (setq r (if r1 (* r1 0.5) r))
  25.    ))
  26.    (setq j 0 clist (list r))
  27.    (repeat (sslength ss1)
  28.     (setq ent (entget(ssname ss1 j)))
  29.     (setq j (1+ j))
  30.     (setq pc (cdr(assoc 10 ent)))
  31.     (setq clist (append clist (list (list (car pc) (cadr pc)))))
  32.    )
  33.    (setq cclist (cons clist cclist))
  34.   )
  35.   (setq nm (if nm nm ""))
  36.   (if (setq nm (getfiled "输出钻孔文件的目录" nm "rot" 1)) (progn
  37.    (setq fp (open nm "w"))
  38.    (princ "M48\nMETRIC,LZ\nVER,1\nFMAT,2\n" fp)
  39.    (repeat (setq i (length cclist))
  40.     (setq r (car(nth (setq i (1- i)) cclist)))
  41.     (princ (strcat "T" (if (< i 10) "0" "") (itoa i) "C" (rtos (+ r r) 2 3) "F42B423S6H2000\n") fp)
  42.    )
  43.    (princ "DETECT,ON\nATC,ON\n%\n" fp)
  44.    (repeat (setq i (length cclist))
  45.     (setq clist (nth (setq i (1- i)) cclist))
  46.     (princ (strcat "T" (if (< i 10) "0" "") (itoa i) "\n") fp)
  47.     (setq j 0 clist (cdr clist))
  48.     (repeat (length clist)
  49.      (setq pc (nth j clist) j (1+ j))
  50.      (princ (strcat "X" (rtos (car pc) 2 3) "Y" (rtos (cadr pc) 2 3) "\n") fp)
  51.     )
  52.    )
  53.    (princ "M30\n" fp)
  54.    (close fp)
  55.   ))
  56.   (command ".UNDO" "E")
  57. ))
  58. (setvar "CMDECHO" 1)
  59. (princ)
  60. )

点评

abc498091367
[attachimg]9384[/attachimg][attachimg]9385[/attachimg] 这样变形的，是错的。 右边这图是CAD输出的坐标， 看左边的图形就能看到变形了，左右两边两个圆坐标。  详情 回复 发表于 2014-8-16 16:59
abc498091367
还有你能帮我检查一下这代码，有时输出的坐标数据变形（意思是本身圆的坐标在23,25而变成100,320了）不是每个图形都是，有时十个图形有一个是，有时十个一个都没事  详情 回复 发表于 2014-8-16 08:50
abc498091367
你好；程序就是这样的，但是现在还有1个问题， ,2=手动输入 (这地方我试了一下相返了，这个没问题) 默认大小也没问题，就是手动输入能改成从小到大吗？现在是从大到小 另外能写一个程序再读取这些输出的圆坐  详情 回复 发表于 2014-8-16 08:48
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-16 08:48:39 | 显示全部楼层
zxq0220 发表于 2014-8-16 07:38

你好；程序就是这样的，但是现在还有1个问题，
<1=默认大小>,2=手动输入    (这地方我试了一下相返了，这个没问题)
默认大小也没问题，就是手动输入能改成从小到大吗？现在是从大到小

另外能写一个程序再读取这些输出的圆坐标数据吗？输出搞好了，就差读取。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-16 08:50:17 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
zxq0220 发表于 2014-8-16 07:38

还有你能帮我检查一下这代码，有时输出的坐标数据变形（意思是本身圆的坐标在23,25而变成100,320了）不是每个图形都是，有时十个图形有一个是，有时十个一个都没事
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-16 16:59:20 | 显示全部楼层
zxq0220 发表于 2014-8-16 07:38

QQ图片20140816163219.jpg QQ图片20140816163114.jpg

这样变形的，是错的。  右边这图是CAD输出的坐标，
看左边的图形就能看到变形了，左右两边两个圆坐标。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

abc498091367

已领礼包: 60个

财富等级: 招财进宝
 楼主| 发表于 2014-8-18 21:44:44 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
:(:(:(:(:(:(:(:(:(:(:(
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

下一页 »
123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-28 00:55 , Processed in 0.479748 second(s), 61 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表