CAD转钻孔帮忙修改

ntwison

(defun c:db()
   (setvar "cmdecho" 0)
   (setq FN (getvar "dwgname")); PCB1234MT.dwg
   (setq n 1 k 0)
   (While (> n 0)
     (setq Tac (vl-string-elt FN k))
         (if (and (> Tac 47)(< Tac 58));0是48,9是57
             (setq n 0)
                 (setq k (1+ k))
     )
   )
   (setq FN (substr FN (+ k 1)))
   (setq n 1 k 0)
   (While (> n 0)
     (setq Tac (vl-string-elt FN k))
         (if (> Tac 64);65是大写字母A
             (setq n 0)
                 (setq k (1+ k))
     )
   )
   (setq FN (substr FN 1 k))
   (setq file2 (strcat "C:\\NC\\" FN "p.NC"))
   ;(setq file2 (getstring "\n 请输入路径及文件名"))
   (setq file3(open file2 "w"))
   (if(= file3 nil)
      (progn
      (alert  "路径或文件名错误!")
      (exit)
      )
      )
  (princ "请选择要钻孔的圆：")
   (setq a (ssget))
   (setq n (sslength a))
   (setq i 0 m 0 Lzb nil)
   (repeat n
     (setq en(ssname a i))
     (setq endata(entget en))
     (setq entype(cdr (assoc 0 endata)))
     (if(= entype "CIRCLE")
      (progn
           (setq ZB (cdr(assoc 10 endata)))
           (setq Lzb (cons ZB Lzb))
       (setq x(cadr(assoc 10 endata)))
       (setq y(caddr(assoc 10 endata)))
       (princ "X" file3)
       (princ (rtos x 2 3) file3)
       (princ "  " file3)
       (princ "Y" file3)
       (princ (rtos y 2 3) file3)
       (princ "\n" file3)
       (setq m (+ 1 m))  
      )
     )
     (setq i (+ 1 i))
   )
(princ (strcat "\n共有<" (itoa m) ">孔被选取!"))
(prin1)
(close file3)
(setq R_c (cdr(assoc 40 endata)))
        (setq Tzb1(Last Lzb))        
        (setq Tzb2 (last (reverse Lzb)))
        (setq Txzb (- (* 1.5 (car Tzb1)) (* 0.5 (car Tzb2))))
        (setq Tyzb (* 0.5 (+ (cadr Tzb2) (cadr Tzb1))))
        (setq Tzb (list Txzb Tyzb))
        (prin1)
;;;;写字： PCB板钻孔文件为FN;;;;;;;;
(setq Txt (strcat "PCB板钻孔文件为" FN "P.NC"))
(entmake (list        
                 (cons 0 "TEXT")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbTexe")
                 (cons 62 6);颜色粉红
                         (cons 10 Tzb)
                         (cons 40 (/ R_c 3));字高2.5
                 (cons 7  "standard")
                 (cons 1  Txt)
                       )
  )
)

xiaolong1487

看一下是不是你想要的
(defun c:db(/ a en endata entype file2 file3 i m n pt x y)
        (setvar "cmdecho" 0)
        (setq file2 (strcat "c:/Nc/"(vl-string-right-trim ".dwg"(getvar "DWGNAME")) "P.nc"))
        (setq file3(open file2 "w"))
        (if(= file3 nil)
                (progn
      (alert  "路径或文件名错误!")
      (exit)
                )
        )
  (princ "请选择要钻孔的圆：")
        (setq a (ssget))
        (setq n (sslength a))
        (setq i 0 m 0)
        (repeat n
                (setq en(ssname a i))
                (setq endata(entget en))
                (setq entype(cdr (assoc 0 endata)))
                (if(= entype "CIRCLE")
      (progn
                                (setq x(cadr(assoc 10 endata)))
                                (setq y(caddr(assoc 10 endata)))
                                (princ "X" file3)
                                (princ (rtos x 2 3) file3)
                                (princ "  " file3)
                                (princ "Y" file3)
                                (princ (rtos y 2 3) file3)
                                (princ "\n" file3)
                                (setq m (+ 1 m))  
      )
                )
                (setq i (+ 1 i))
        )
        (princ (strcat "\n共有<" (itoa m) ">孔被选取!"))
        (close file3)
        (if (setq pt (getpoint "\n文字放置点: "))
                (entmakeX (list '(0 . "TEXT") (cons 1 (strcat (vl-string-right-trim ".dwg"(getvar "DWGNAME")) "P.nc")) (cons 10 pt) (cons 40 5) (cons 62 1)))
        )
        (prin1)
)

tungtat

ntwison 发表于 2018-4-21 20:14
(defun c:db()
   (setvar "cmdecho" 0)
   (setq FN (getvar "dwgname")); PCB1234MT.dwg

非常感谢。谢谢

tungtat

xiaolong1487 发表于 2018-4-22 08:38
看一下是不是你想要的
(defun c:db(/ a en endata entype file2 file3 i m n pt x y)
        (setvar "cmdecho" ...

输出的文件名没达到，不过会员 ntwison 已帮我搞定。还是非常感谢你

tungtat

Andyhon 发表于 2018-4-21 18:16
(setq file7 (getstring (strcat "\nDefault-->" file2 " OK?  ")))
(cond
  ((= file7 ""))

非常感谢，符合我的使用

前生

这个东西，写出去，是不是还要加文件头，文件尾啊？
孔径不同的在一起，咋处理啊？

前生

(ssget (list (cons 0 "CIRCLE")))
选实体的时候，变成上面的这样，就只选圆了。
后面的用repeat也好，while循环也好，直接处理了。不在需要进行判断是否为圆了。
在搜一搜，坐标排序，这样的话，你的NC程序，虽然简单，但是钻孔时，就是按最短路径加工了。

tungtat

前生 发表于 2018-4-24 23:34
(ssget (list (cons 0 "CIRCLE")))
选实体的时候，变成上面的这样，就只选圆了。
后面的用repeat也好，wh ...

这个程式只用于天马机钻孔而已，只需一种钻嘴，开头和结束，天马软件会识别。

以下这个可以分孔径大小，镭铭机钻孔用，照参各位大神的提示修改文件名。
兄弟机不能用，除非另外软件改写。再说我厂也没兄弟机，所以没有源代码。

(defun c:nc()
  (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 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 "drl" 1)) (progn
    (setq i 0)
    (setq fp (open nm "w"))
    (princ "M48\nMETRIC\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) "F423B423S6H1800\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%\n" fp)
    (close fp)
   ))
   (command ".UNDO" "E")
  ))
  (setvar "CMDECHO" 1)
  (princ)
)

啊业_48384

我知你是那个人了，叫我改呀。:P