线切割3B程序

cal3012

我觉得,能把这个程序做得更精点,再加上格式转换,加载上传输设置,那么这就是一款很棒的应用软件了(致少我觉得要胜于wedm caxa),而且很有商用价值,值得去钻一下!!,(不过,是否涉及侵权就不得而知的了,之前别人是做在别的软件上的,真正直接做在CAD上的现在暂时还没发现)---(能做成插件也是很很好的了) 我不懂程序,但我致少还有很多人很希望有这么个东东,渴求!!! 有需要效劳请尽管说 cal3012@sohu.com

熊哥哥

怎么没有高手说话了呀

ZZXXQQ

文件存在当前打开图形目录下，文件名是bbb.bb和ppp.pp。一般同一张图不要运行两次，可能程序对图元进行的处理。

熊哥哥

好像对这个感兴趣的人不多吗

ttang

对图形是处理的，几次都可以啊

21楼的建议很好啊

谁会做的完善一点在此留言哈

其实不难哦

gjh

刚看到!马上下载试用！

谢谢!

 

 

102782

本人菜鸟，不过很感兴趣这个程序，不知道程序是这样的吗(按上面说的)，如下程序我保存成LISP没有运行出来，命令profile和bcircle没有反应，这是怎么回事，哪里出错了，请帮忙解释一下

(defun at_err (st)
(if (and (/= st "Function cancelled")
(/= st "quit / exit abort")) (princ (strcat "\n错误: " st)))
(if (= (type f) 'FILE) (close f))
(setq f nil)
(if (= (type pf) 'FILE) (close pf))
(setq pf nil)
(setvar "pickbox" 3)
(setq *error* olderr)
(princ)
)

(defun C:profile()
(pro1)
(command "layer" "off" "BBB" "" "pedit" eny "y" "j" "w"
(mapcar '- (getvar "extmin") '(1 1)) (mapcar '+ (getvar "extmax") '(1 1)) "" "")
(if (zerop jk) (command "copy" (last eny) "" '(0 0) '(0 0))
(command "offset" (abs jk) (last eny) sid ""))
(setq mi (ssname (ssget "l") 0))
(command "change" mi "" "p" "la" "BBB" "" "explode" (last eny))
(command "layer" "on" "BBB" "set" "BBB" "off" la "color" "255" "" "" "explode" mi)
(setq ss (ssget "w" (mapcar '- (getvar "extmin") '(1 1)) (mapcar '+ (getvar "extmax") '(1 1))))
(setq number (sslength ss))
(terpri)
(initget 1)
(setq csp (getpoint "请输入穿丝点: "))
(terpri)
(initget 1)
(COMMAND "OSNAP" "END")
(menucmd "s=osnapb")
(setq p (getpoint "请选择起始点(端点): "))
(COMMAND "OSNAP" "NONE")
(pro2)
(COMMAND "OSNAP" "nearest")
(initget 1)
(setq pp (getpoint "请输入方向: "))
(COMMAND "OSNAP" "NONE")
(terpri)
(prompt "等待 ......")
(terpri)
(setq ss (ssget pp))
(setq en (entget (ssname ss 0)))
(arc1)
(setq enp en)
(setq q (if (>= (distance p (cdr (assoc '11 en))) (distance pp (cdr (assoc '11 en)))) 11 10))
(setq qn (if (= 10 q) 11 10))
(if (= "LINE" (cdr (assoc '0 en)))
(progn
(setq xx (- (nth 0 (cdr (assoc q en))) (nth 0 p)) )
(setq yy (- (nth 1 (cdr (assoc q en))) (nth 1 p)) )
(line))
(progn
(setq xx1 (- (nth 0 p) (nth 0 (cdr (assoc '19 en)))) )
(setq yy1 (- (nth 1 p) (nth 1 (cdr (assoc '19 en)))) )
(setq xx2 (- (nth 0 (cdr (assoc q en))) (nth 0 (cdr (assoc '19 en)))) )
(setq yy2 (- (nth 1 (cdr (assoc q en))) (nth 1 (cdr (assoc '19 en)))) )
(arc)
(arcb3)
))
(writf)
(princ (rtos (nth 0 p) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p) 2 3) f)
(if (= "LINE" (cdr (assoc '0 en)))
(princ "\n" f)
(progn
(princ " " f)
(princ (rtos (nth 0 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (cdr (assoc '20 en)) 2 3) f)
(princ "\n" f)
))
(setq a 1)
(setvar "pickbox" 0)
(while (< a number )
(entdel (ssname ss 0))
(setq ss (ssget (cdr (assoc q en))))
(setq eo en)
(setq en (entget (ssname ss 0)))
(arc1)
(setq ts1 (mapcar '* '(1000 1000) (cdr (assoc q eo))))
(setq ts2 (mapcar '* '(1000 1000) (cdr (assoc '10 en))))
(setq q (if (and (= (fix (+ (nth 0 ts1) 0.5)) (fix (+ (nth 0 ts2) 0.5)))
(= (fix (+ (nth 1 ts1) 0.5)) (fix (+ (nth 1 ts2) 0.5))))
11 10))
(setq qn (if (= 10 q) 11 10))
(if (= "LINE" (cdr (assoc '0 en)))
(progn
(setq xx (- (nth 0 (cdr (assoc q en))) (nth 0 (cdr (assoc qn en)))) )
(setq yy (- (nth 1 (cdr (assoc q en))) (nth 1 (cdr (assoc qn en)))) )
(line))
(progn
(setq xx1 (- (nth 0 (cdr (assoc qn en))) (nth 0 (cdr (assoc '19 en)))) )
(setq yy1 (- (nth 1 (cdr (assoc qn en))) (nth 1 (cdr (assoc '19 en)))) )
(setq xx2 (- (nth 0 (cdr (assoc q en))) (nth 0 (cdr (assoc '19 en)))) )
(setq yy2 (- (nth 1 (cdr (assoc q en))) (nth 1 (cdr (assoc '19 en)))) )
(arc)
(arcb3)
))
(writf)
(princ (rtos (nth 0 (cdr (assoc qn en))) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 (cdr (assoc qn en))) 2 3) f)
(if (= "LINE" (cdr (assoc '0 en)))
(princ "\n" f)
(progn
(princ " " f)
(princ (rtos (nth 0 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (cdr (assoc '20 en)) 2 3) f)
(princ "\n" f)
))
(setq a (1+ a))
)
(entdel (ssname ss 0))

(setq p1 (cdr (assoc q en)))
(setq ts1 (mapcar '* '(1000 1000) p1))
(setq ts2 (mapcar '* '(1000 1000) p))
(if (or (/= (fix (+ (nth 0 ts1) 0.5)) (fix (+ (nth 0 ts2) 0.5)))
(/= (fix (+ (nth 1 ts1) 0.5)) (fix (+ (nth 1 ts2) 0.5))))
(progn
(setq en enp)
(if (= "LINE" (cdr (assoc '0 en)))
(progn
(setq xx (- (nth 0 p) (nth 0 p1)) )
(setq yy (- (nth 1 p) (nth 1 p1)) )
(line))
(progn
(setq xx1 (- (nth 0 p1) (nth 0 (cdr (assoc '19 en)))) )
(setq yy1 (- (nth 1 p1) (nth 1 (cdr (assoc '19 en)))) )
(setq xx2 (- (nth 0 p) (nth 0 (cdr (assoc '19 en)))) )
(setq yy2 (- (nth 1 p) (nth 1 (cdr (assoc '19 en)))) )
(arc)
(arcb3)
))
(writf)
(princ (rtos (nth 0 p1) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p1) 2 3) f)
(if (= "LINE" (cdr (assoc '0 en)))
(princ "\n" f)
(progn
(princ " " f)
(princ (rtos (nth 0 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 (cdr (assoc '19 en))) 2 3) f)
(princ " " f)
(princ (rtos (cdr (assoc '20 en)) 2 3) f)
(princ "\n" f)
))))

(setq xx (- (nth 0 csp) (nth 0 p)) )
(setq yy (- (nth 1 csp) (nth 1 p)) )
(line)
(writf)
(princ (rtos (nth 0 p) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p) 2 3) f)
(princ "\n" f)
(setq m (1+ m))
(if (< m 100) (princ " " f))
(if (< m 10) (princ " " f))
(princ "(" f)
(princ m f)
(princ ") " f)
(princ "D\n" f)
(princ "D\n" pf)
(close f)
(close pf)
(setvar "pickbox" 3)
(command "layer" "on" la "set" la "" )
(terpri)
(setq c (getstring "还有吗 (Y/N)? "))
(setq *error* olderr)
(terpri)
(prompt "结束!")
(princ)
)

(defun c:bcircle()
(pro1)
(command "layer" "set" "BBB" "color" "255" "" "")
(if (zerop jk) (command "copy" (last eny) "" '(0 0) '(0 0))
(command "offset" (abs jk) (last eny) sid ""))
(setq mi (ssname (ssget "l") 0))
(command "change" mi "" "p" "la" "BBB" "" "layer" "off" la "" )
(terpri)
(initget 1)
(setq csp (getpoint "请输入穿丝点: "))
(terpri)
(COMMAND "OSNAP" "quadrant")
(initget 1)
(setq p (getpoint "请输入起始点(四分圆点): "))
(COMMAND "OSNAP" "NONE")
(pro2)
(prompt "等待 ......")
(terpri)
(setq en (entget mi))
(setq b12 (mapcar '- p (cdr (assoc '10 en))))
(setq xx1 (nth 0 b12))
(setq yy1 (nth 1 b12))
(setq b1 (abs xx1) b2 (abs yy1) )
(setq b3 (* 4 (cdr (assoc '40 en))))
(setq b4 (if (<= (abs xx1) (abs yy1)) 'X 'Y))
(setq b5 'NR)
(if (and (> (atof (rtos xx1 2 3)) 0) (>= (atof (rtos yy1 2 3)) 0)) (setq b6 1))
(if (and (<= (atof (rtos xx1 2 3)) 0) (> (atof (rtos yy1 2 3)) 0)) (setq b6 2))
(if (and (< (atof (rtos xx1 2 3)) 0) (<= (atof (rtos yy1 2 3)) 0)) (setq b6 3))
(if (and (>= (atof (rtos xx1 2 3)) 0) (< (atof (rtos yy1 2 3)) 0)) (setq b6 4))
(writf)
(princ (rtos (nth 0 p) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p) 2 3) f)
(princ " " f)
(princ (rtos (nth 0 (cdr (assoc '10 en))) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 (cdr (assoc '10 en))) 2 3) f)
(princ " " f)
(princ (rtos (cdr (assoc '40 en)) 2 3) f)
(princ "\n" f)
(command "erase" "w" (mapcar '- (getvar "extmin") '(1 1)) (mapcar '+ (getvar "extmax") '(1 1)) "")
(setq xx (- (nth 0 csp) (nth 0 p)) )
(setq yy (- (nth 1 csp) (nth 1 p)) )
(line)
(writf)
(princ (rtos (nth 0 p) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p) 2 3) f)
(princ "\n" f)
(setq m (1+ m))
(if (< m 100) (princ " " f))
(if (< m 10) (princ " " f))
(princ "(" f)
(princ m f)
(princ ") " f)
(princ "D\n" f)
(princ "D\n" pf)
(close f)
(close pf)
(setvar "pickbox" 3)
(command "layer" "on" la "set" la "" )
(terpri)
(setq c (getstring "还有吗 (Y/N)? "))
(setq *error* olderr)
(terpri)
(prompt "结束!")
(princ)
)

(defun pro1()
(setvar "cmdecho" 0)
(setvar "pickbox" 3)
(setq olderr *error* *error* at_err)
(setq f nil)
(command "zoom" "e")
(command "zoom" "w" (mapcar '- (getvar "extmin") '(1 1)) (mapcar '+ (getvar "extmax") '(1 1)))
(if (and (/= "Y" c) (/= "y" c)) (progn (setq df '"w")
(setq m 0)
(terpri)
(setq no (getstring "请输入图号 (000-000-00): "))
(if (= "" no) (setq no "000-000-00")))
(setq df '"a"))
(terpri)
(setq jk (getreal "请输入偏移量: (0.085): "))
(if (= nil jk) (setq jk 0.085))
(terpri)
(setq eny (entsel "请选择图形: "))
(setq la (cdr (assoc '8 (entget (car eny)))))
(terpri)
(initget 1)
(if (/= 0 jk) (setq sid (getpoint "请点击偏移方向: ")) )
(command "layer" "new" "BBB" "" )
)

(defun pro2()
(setq f (open "bbb.bb" df))
(setq pf (open "ppp.pp" df))
(terpri)
(while (or (= "Y" c) (= "y" c))
(setq xx (- (nth 0 csp) (nth 0 p11)) )
(setq yy (- (nth 1 csp) (nth 1 p11)) )
(line)
(writf)
(princ (rtos (nth 0 p11) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 p11) 2 3) f)
(princ "\n" f)
(setq m (1+ m))
(if (< m 100) (princ " " f))
(if (< m 10) (princ " " f))
(princ "(" f)
(princ m f)
(princ ") " f)
(princ "D\n" f)
(princ "D\n" pf)
(setq c 2)
)
(setq p11 csp)
(if (/= 2 c) (progn
(princ "\n" f)
(princ "DRAW NO.:" f)
(princ no f)
(princ " DATE:" f)
(princ (rtos (getvar "cdate") 2 0) f)
(princ " f:" f)
(princ jk f)
(princ "\n" f)
(princ "\n" f)
)
(progn
(princ " f:" f)
(princ jk f)
(princ "\n" f)
))
(setq xx (- (nth 0 p) (nth 0 csp)) )
(setq yy (- (nth 1 p) (nth 1 csp)) )
(line)
(writf)
(princ (rtos (nth 0 csp) 2 3) f)
(princ " " f)
(princ (rtos (nth 1 csp) 2 3) f)
(princ "\n" f)
)

(defun line()
(setq b1 (abs xx))
(setq b2 (abs yy))
(if (or (< b1 0.0005) (< b2 0.0005)) (setq b1 '0.0 b2 '0.0) 'T)
(setq b3 (if (>= (abs xx) (abs yy)) (abs xx) (abs yy) ))
(setq b4 (if (>= (abs xx) (abs yy)) 'X 'Y))
(setq b5 'L)
(if (and (> (atof (rtos xx 2 3)) 0) (>= (atof (rtos yy 2 3)) 0)) (setq b6 1))
(if (and (<= (atof (rtos xx 2 3)) 0) (> (atof (rtos yy 2 3)) 0)) (setq b6 2))
(if (and (< (atof (rtos xx 2 3)) 0) (<= (atof (rtos yy 2 3)) 0)) (setq b6 3))
(if (and (>= (atof (rtos xx 2 3)) 0) (< (atof (rtos yy 2 3)) 0)) (setq b6 4))
)

(defun arc()
(setq b1 (abs xx1) b2 (abs yy1))
(setq b4 (if (<= (abs xx2) (abs yy2)) 'X 'Y))
(if (= '10 q) (progn
(setq b5 'SR)
(if (and (> (atof (rtos xx1 2 3)) 0) (<= (atof (rtos yy1 2 3)) 0)) (setq b6 4))
(if (and (<= (atof (rtos xx1 2 3)) 0) (< (atof (rtos yy1 2 3)) 0)) (setq b6 3))
(if (and (< (atof (rtos xx1 2 3)) 0) (>= (atof (rtos yy1 2 3)) 0)) (setq b6 2))
(if (and (>= (atof (rtos xx1 2 3)) 0) (> (atof (rtos yy1 2 3)) 0)) (setq b6 1)))
(progn (setq b5 'NR)
(if (and (> (atof (rtos xx1 2 3)) 0) (>= (atof (rtos yy1 2 3)) 0)) (setq b6 1))
(if (and (<= (atof (rtos xx1 2 3)) 0) (> (atof (rtos yy1 2 3)) 0)) (setq b6 2))
(if (and (< (atof (rtos xx1 2 3)) 0) (<= (atof (rtos yy1 2 3)) 0)) (setq b6 3))
(if (and (>= (atof (rtos xx1 2 3)) 0) (< (atof (rtos yy1 2 3)) 0)) (setq b6 4))))
)

(defun writf()
(if (/= '0 b3) (progn
(setq m (1+ m))
(if (< m 100) (princ " " f))
(if (< m 10) (princ " " f))
(princ "(" f)
(princ m f)
(princ ") " f)
(setq b1 (rtos (* 1000 b1) 2 0))
(princ "B" pf)
(princ b1 pf)
(if (< (strlen b1) 6) (setq b1 (strcat " " b1)))
(if (< (strlen b1) 6) (setq b1 (strcat " " b1)))
(if (< (strlen b1) 6) (setq b1 (strcat " " b1)))
(if (< (strlen b1) 6) (setq b1 (strcat " " b1)))
(if (< (strlen b1) 6) (setq b1 (strcat " " b1)))
(princ "B " f)
(princ b1 f)
(setq b2 (rtos (* 1000 b2) 2 0))
(princ "B" pf)
(princ b2 pf)
(if (< (strlen b2) 6) (setq b2 (strcat " " b2)))
(if (< (strlen b2) 6) (setq b2 (strcat " " b2)))
(if (< (strlen b2) 6) (setq b2 (strcat " " b2)))
(if (< (strlen b2) 6) (setq b2 (strcat " " b2)))
(if (< (strlen b2) 6) (setq b2 (strcat " " b2)))
(princ " B " f)
(princ b2 f)
(setq b3 (rtos (* 1000 b3) 2 0))
(if (< (strlen b3) 6) (setq b3 (strcat "0" b3)))
(if (< (strlen b3) 6) (setq b3 (strcat "0" b3)))
(if (< (strlen b3) 6) (setq b3 (strcat "0" b3)))
(if (< (strlen b3) 6) (setq b3 (strcat "0" b3)))
(if (< (strlen b3) 6) (setq b3 (strcat "0" b3)))
(princ " B " f)
(princ b3 f)
(princ " G" f)
(princ b4 f)
(princ " " f)
(princ b5 f)
(princ b6 f)
(princ "B" pf)
(princ b3 pf)
(princ "G" pf)
(princ b4 pf)
(princ b5 pf)
(princ b6 pf)
(princ "\n" pf)
(if (= b5 'L) (princ " " f))
(princ " " f)
))
)

(defun arc1()
(setq en (if (= "ARC" (cdr (assoc '0 en))) (list
(append '(10) (polar (cdr(assoc '10 en)) (cdr(assoc '50 en)) (cdr(assoc '40 en))) )
(append '(11) (polar (cdr(assoc '10 en)) (cdr(assoc '51 en)) (cdr(assoc '40 en))) )
(append '(19) (cdr (assoc '10 en)))
(cons '20 (cdr (assoc '40 en)))
(assoc '50 en)
(assoc '51 en)
'(0 . "ARC")) en))
)

(defun arcb3()
(setq r1 (atof (rtos (* 1.57080 (cdr (assoc '20 en))) 2 3))
r2 (atof (rtos (* 3.14159 (cdr (assoc '20 en))) 2 3))
r3 (atof (rtos (* 4.71239 (cdr (assoc '20 en))) 2 3))
r4 (atof (rtos (* 6.28319 (cdr (assoc '20 en))) 2 3)) )
(setq aa12 (if (>= (cdr (assoc '51 en)) (cdr (assoc '50 en)))
(- (cdr (assoc '51 en)) (cdr (assoc '50 en)))
(+ 6.28319 (- (cdr (assoc '51 en)) (cdr (assoc '50 en)))) ))
(setq rl (atof (rtos (* (cdr (assoc '20 en)) aa12) 2 3)))
(setq a1 (atof (rtos (cdr (assoc '50 en)) 2 3)))
(setq a2 (atof (rtos (cdr (assoc '51 en)) 2 3)))
(if (= 'X b4)
(progn
(if (and (> rl 0) (<= rl r1))
(if (or (and (>= a1 1.571) (<= a1 3.142) (>= a2 3.142) (<= a2 4.712))
(and (>= a1 4.712) (<= a1 6.283) (>= a2 0) (<= a2 1.571)))
(setq b3 (- (* 2 (cdr (assoc '20 en))) (abs (+ xx1 xx2))))
(setq b3 (abs (- xx1 xx2))) ))
(if (and (> rl r1) (<= rl r2))
(if (or (and (>= a1 0) (<= a1 1.571) (>= a2 1.571) (<= a2 3.142))
(and (>= a1 3.142) (<= a1 4.712) (>= a2 4.712) (<= a2 6.283)))
(setq b3 (abs (- xx1 xx2)))
(setq b3 (- (* 2 (cdr (assoc '20 en))) (abs (+ xx1 xx2)))) ))
(if (and (> rl r2) (<= rl r3))
(if (or (and (>= a1 1.571) (<= a1 3.142) (>= a2 0) (<= a2 1.571))
(and (>= a1 4.712) (<= a1 6.283) (>= a2 3.142) (<= a2 4.712)))
(setq b3 (- (* 4 (cdr (assoc '20 en))) (abs (- xx1 xx2))))
(setq b3 (+ (* 2 (cdr (assoc '20 en))) (abs (+ xx1 xx2)))) ))
(if (and (> rl r3) (<= rl r4))
(if (or (and (>= a1 0) (<= a1 1.571) (>= a2 4.712) (<= a2 6.283))
(and (>= a1 3.142) (<= a1 4.712) (>= a2 1.571) (<= a2 3.142)))
(setq b3 (+ (* 2 (cdr (assoc '20 en))) (abs (+ xx1 xx2))))
(setq b3 (- (* 4 (cdr (assoc '20 en))) (abs (- xx1 xx2)))) ))
))
(if (= 'Y b4)
(progn
(if (and (> rl 0) (<= rl r1))
(if (or (and (>= a1 0) (<= a1 1.571) (>= a2 1.571) (<= a2 3.142))
(and (>= a1 3.142) (<= a1 4.712) (>= a2 4.712) (<= a2 6.283)))
(setq b3 (- (* 2 (cdr (assoc '20 en))) (abs (+ yy1 yy2))))
(setq b3 (abs (- yy1 yy2))) ))
(if (and (> rl r1) (<= rl r2))
(if (or (and (>= a1 1.571) (<= a1 3.142) (>= a2 3.142) (<= a2 4.712))
(and (>= a1 4.712) (<= a1 6.283) (>= a2 0) (<= a2 1.571)))
(setq b3 (abs (- yy1 yy2)))
(setq b3 (- (* 2 (cdr (assoc '20 en))) (abs (+ yy1 yy2)))) ))
(if (and (> rl r2) (<= rl r3))
(if (or (and (>= a1 0) (<= a1 1.571) (>= a2 4.712) (<= a2 6.283))
(and (>= a1 3.142) (<= a1 4.712) (>= a2 1.571) (<= a2 3.142)))
(setq b3 (- (* 4 (cdr (assoc '20 en))) (abs (- yy1 yy2))))
(setq b3 (+ (* 2 (cdr (assoc '20 en))) (abs (+ yy1 yy2)))) ))
(if (and (> rl r3) (<= rl r4))
(if (or (and (>= a1 1.571) (<= a1 3.142) (>= a2 0) (<= a2 1.571))
(and (>= a1 4.712) (<= a1 6.283) (>= a2 3.142) (<= a2 4.712)))
(setq b3 (+ (* 2 (cdr (assoc '20 en))) (abs (+ yy1 yy2))))
(setq b3 (- (* 4 (cdr (assoc '20 en))) (abs (- yy1 yy2)))) ))
))
)

102782

帮帮我呀，玩不明白了

CAD83

如果电脑有软盘是可以放3B，再放到线切割机上，不知ttang输出和输入DAT文件的LISP吗？

能发上来就好了，

yhkk0317

回复 ZZXXQQ 的帖子

是的.不是这行的.看起来一头雾水