共享，CAD图形做模具加工中的G代码
本帖最后由 邹锋 于 2012-7-20 05:10 编辑;;;;;;打断增强
(defun c:br (/ name pt)
(setvar "cmdecho" 0)
(setq name (car (entsel "\n ----------->选取要打断的线")))
(setq pt (getpoint "\n ----------->选择你要打断的点"))
(command "break" name pt pt)
(princ)
)
;;;;串接增强，可指定方向
(defun c:CJ (/ SS name1 name2 ss1 ss2 sub)
(command "undo" "be")
(setvar "cmdecho" 0)
(setq name1 (car (entsel "\n ----------->请选择进刀线")))
(if (= name1 nil)
(alert "没有选择到，请重新选择")
)
(setq name2
(car
(entsel
"\n ----------->请选择方向，即进刀线进入后为顺时
针还是逆时针"
)
)
)
(if (= name1 nil)
(alert "没有选择到，请重新选择")
)
(princ "\n ----------->请框选要切割图形,包括刚选择的进刀线")
(setq ss (ssget))
(setq ss (ssdel name1 ss))
(setq ss (ssdel name2 ss))
(setq ss1 (ssadd name1))
(setq ss2 (ssadd name2 ss1))
(setq i 0)
(repeat (sslength ss)
(setq sn (ssname ss i))
(setq ss2 (ssadd sn ss1))
(setq i (1+ i))
)
(command "pedit" "m" ss2 "" "y" "j" "j" "" 0.1 "")
(setq sub (ssget "l"))
(command "change" sub "" "p" "c" "3" "")
(command "undo" "e")
(princ)
)
;;;;;转出G代码，适合夏米尔慢走丝机床用
(defun C:mzs (/ ss1 ename el obj len
i ptonepttwo onex oney twox twoytu
pt1
pt2 dis radiush h1 half-
angle
arc-length pa n
)
(setq ffn (getfiled "选取文件" "" "TXT" 1));;;夏米尔使用ISO
格式文本
(setq f (open ffn "w"))
(princ (strcat "\nH000=0;"
"\nH001=0.21;"
"\nH002=0.165;"
"\nH003=0.131;"
)
f
)
(setvar "cmdecho" 0)
(setvar "dimzin" 0)
(setq ss1 (ssget '((0 . "LWPOLYLINE"))))
(setq n 0)
(repeat (sslength ss1)
(setq ename (ssname ss1 n))
(shunni)
;;;判断方向
(setq ptone (vlax-curve-getpointatparam ename 0)
pttwo (vlax-curve-getpointatparam ename 1)
onex (rtos (car ptone) 2 3)
oney (rtos (cadr ptone) 2 3)
twox (rtos (car pttwo) 2 3)
twoy (rtos (cadr pttwo) 2 3)
)
(princ (strcat "\nG00 X" onex " Y" oney ";") f)
(princ (strcat "\nG92 X" onex " Y" oney ";") f)
(princ (strcat "\nM60;" "\nC096;" "\nG40 H000;\n") f)
(princ (strcat sn "G01 X" twox " Y" twoy ";") f)
(princ (strcat "\nC001;" "\nH001;") f)
(setq el (entget ename))
(setq obj (vlax-ename->vla-object ename))
(setq len (1- (cdr (assoc 90 el))))
(setq i 1)
;(setq par nil)
(repeat (1- len)
(setq tu (vla-getBulge obj i))
(setq pt1 (vlax-curve-getpointatparam ename i))
(setq pt2 (vlax-curve-getpointatparam ename (1+ i)))
(setq px1 (car pt1)
py1 (cadr pt1)
px2 (rtos (car pt2) 2 3)
py2 (rtos (cadr pt2) 2 3)
)
(setq dis (distance pt1 pt2))
(if (/= tu 0)
(progn
(setq radius (/ (* (+ 1.0 (* tu tu)) dis 0.25) (abs
tu)))
(setq h(* dis (abs tu) 0.5)
h1 (- radius h)
)
(setq half-angle (atan (/ dis 2) h1))
(setq arc-length (* 2 half-angle radius))
(setq cen (midp pt1 pt2))
(setq cen (polar cen
(+ (angle pt1 pt2)
(if (or nil
(and (> h1 0) (> tu 0))
(and (< h1 0) (< tu 0))
)
(* pi 0.5)
(* pi -0.5)
)
)
(abs h1)
)
)
(setq cenx (car cen)
ceny (cadr cen)
)
(if (< 0 tu)
(setq sn "\nG03 X")
(setq sn "\nG02 X")
)
(setq xi (- cenx px1)
yj (- ceny py1)
)
(setq xi (rtos xi 2 3)
yj (rtos yj 2 3)
)
(princ (strcat sn px2 " Y" py2 " i" xi " j" yj ";")
f)
)
(progn
(princ (strcat "\nG01 X" px2 " Y" py2 ";") f)
)
)
(setq i (1+ i))
)
(princ (strcat "\nM00;" "\nG40 H000 G50 A0.0 G01 X" onex "
Y" oney ";" "\nM50;") f)
(setq n (1+ n))
)
(princ "\nM02;" f)
(close f)
(princ)
)
;;;;批量串接圆
(defun c:ci (/ ss i ename ell ang pto pt r)
(command "undo" "be")
(setvar "cmdecho" 0)
(COMMAND "ucs" "w")
(setq ss (ssget '((0 . "CIRCLE")))
i0
) ;setq
(if ss
(repeat (sslength ss)
(setq ename (ssname ss i)
i (1+ i)
endata (entget ename)
oldr_list (assoc 40 endata)
r (cdr oldr_list)
cenpt (assoc 10 endata)
pt (cdr cenpt)
ppt (polar pt 0 r)
) ;setq
(command "Pline" pt ppt "A" "CE"PT "A""90"
"CE"
PT "A" "90""CE"PT "A" "90""CE"
PT
"A" "90" ""
)
) ;repeat
) ;if
(command "erase" ss "")
(command "ucs" "p")
(command "undo" "e")
(princ)
)
;;;判断多义线方向-by GU_xl
(defun shunni (/ fd ang offsetObj plineObj)
(setq plineObj (vlax-ename->vla-object ename))
(setq offsetplineObj
(car (vlax-safearray->list
(vlax-variant-value
(vla-OFFSET plineObj 0.0001)
)
)
)
)
(if (> (vlax-curve-getdistatparam
plineobj
(vlax-curve-getEndParam plineobj)
)
(vlax-curve-getdistatparam
offsetplineObj
(vlax-curve-getEndParam offsetplineObj)
)
)
(setq sn "G41")
(setq sn "G42")
)
(vla-delete offsetplineObj)
)
(defun midp (p1 p2);;;;BY 高飞鸟
(polar p1 (angle p1 p2) (* (distance p1 p2) 0.5))
)
此代码中，还有很多BUG,,,比如：
1 不可以对图元进行二次写出，或三次写出，，，
2 判断多义线方向有时判断错误，，我这些图形都是不封闭的PL，，，可能原作者原意是判断封闭的多义线
3 直线与圆弧生成多义线，比较麻烦，需手动去选择，看了其他编程语言的，才算的上是高效率
一个庞大的软件，都源于一段简单的代码，，呵呵，，以后会增加去完善，，，，
请问下大佬，如果二维线按线走刀如 :spl 能不加点控制输出g代码吗. circle好像有g代码不要加点。 CNC加工中心的2D部分完成了，现在想想，下决心，写个线割编程用的。 楼主不用统赢啊 沙发支持 感谢楼主分享程序! 感谢楼主分享程序! 谢谢楼主分享，最近也在学习程序写G代码，广州数控的
(defun c:ent ()
(entget (car (entsel)) '("*"))
)
;;;无屑孔;;;修刀三次
((-1 . <图元名: 7ef90690>)
(0 . "LWPOLYLINE")
(330 .
<图元名:
7ef76cf8>
)
(5 . "17A")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(62 . 1)
(100 . "AcDbPolyline")
(90 . 6)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 .
0.0
)
(10 14.2985 0.0443879)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 15.7128
1.4586
)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 15.7128 -1.36983)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 12.8843 -1.36983)
(40 . 0.0)
(41 . 0.0)
(42 .
-0.414214
)
(10 12.8843 1.4586)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10
15.7128
1.4586
)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(210 0.0 0.0 1.0)
(-3
("my_tag" (1000 . "CIRCLEPATH")
(1000 . "CirclePath")
(1000 . "NO_COR")
(1000 . " ")
(1000 . "WPCAM")
(1000 . "无屑切割(1)")
(1000 . "WIRE_DATA0")
(1000 . "0.000 -98.00 30.00000.000 0")
(1000 . "WIRE_DATA1")
(1000 . " 0.2120 150 1506.900 71 ")
(1000 . "WIRE_DATA2")
(1000 . " 0.1520 450 4509.050 0 ")
(1000 . "WIRE_DATA3")
(1000 . " 0.1320 832 8326.900 0 ")
(1000 . "WIRE_DATA4")
(1000 . " 0.1290 833 8335.850 0 ")
(1000 . "WPCAM-PRI")
(1000 . "0.10 0.10")
(1000 . "WIRED_DATA")
(1000 . "5 无屑切割(1) 0.000 -98 3 0.000 0.000 ")
(1000 . "PLATHKDIAMATER")
(1000 . "20.00 0.25 SKD11")
(1000 . "ORDNO")
(1000 . "2")
(1000 . "NO_COR0")
(1000 . " ")
(1000 . "OFFSET_NO")
(1000 . "3 110 0.212 4 111 0.152 5 112 0.132 6 113 0.129 ")
)
)
)
;;;;圆形孔,,角度 2度，修1次，放0.21间隙
((-1 . <图元名: 7ef90568>)
(0 . "LWPOLYLINE")
(5 . "155")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(62 . 4)
(100 . "AcDbPolyline")
(90 . 6)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 6.51043 -0.646734)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 6.51043 -2.64673)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 4.51043 -0.646734)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 6.51043 1.35327)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 8.51043 -0.646734)
(40 . 0.0)
(41 . 0.0)
(42 . -0.414214)
(10 6.51043 -2.64673)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(210 0.0 0.0 1.0)
(-3("my_tag" (1000 . "CIRCLEPATH")
(1000 . "CirclePath")
(1000 . "WPCAM")
(1000 . "圆型孔(4)")
(1000 . "WIRE_DATA0")
(1000 . "2.000 -98.00 10.21000.000
0") (1000 . "WIRE_DATA1")
(1000 . " 0.1930 150 1506.900 21 ")
(1000 . "WIRE_DATA2")
(1000 . " 0.1330 450 4509.050 31 ")
(1000 . "WPCAM-PRI")
(1000 . "0.10 0.10")
(1000 . "WIRED_DATA")
(1000 . "2 圆型孔(4) 2.000 -98 1 0.210 0.000 ")
(1000 . "PLATHKDIAMATER")
(1000 . "20.00 0.25 SKD11")
(1000 . "ORDNO")
(1000 . "1")
(1000 . "OFFSET_NO")
(1000 . "1 110 -0.017 2 121 -0.077 ")
)
)
)
;;;;冲头,,角度五度，整修1次
((-1 . <图元名: 7ef908b0>)
(0 . "LWPOLYLINE")
(330 .
<图元名:
7ef76cf8>
)
(5 . "1B6")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(62 . 5)
(100 . "AcDbPolyline")
(90 . 7)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 .
0.0
)
(10 -7.30103 0.679924)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -2.30103
0.679924
)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -2.30103 1.92992)
(40 . 0.0)
(41
.
0.0
)
(42 . 0.0)
(10 2.69897 1.92992)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10
2.69897
-3.07008
)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -2.30103 -3.07008)
(40 .
0.0
)
(41 . 0.0)
(42 . 0.0)
(10 -2.30103 0.679924)
(40 . 0.0)
(41 . 0.0)
(42 .
0.0
)
(210 0.0 0.0 1.0)
(-3
("my_tag" (1000 . "WPCAM")
(1000 . "冲头(5)")
(1000 . "WIRE_DATA0")
(1000 . "5.000 -98.00 -10.00000.000 8")
(1000 . "WIRE_DATA1")
(1000 . " 0.1930 150 1506.900 21 ")
(1000 . "WIRE_DATA2")
(1000 . " 0.1330 450 4509.050 31 " )
(1000 . "WIRE_DATA3")
(1000 . " 0.1930 150 1506.900 21 ") (1000 . "WPCAM-PRI")
(1000 . "0.10 0.10")
(1000 . "WIRED_DATA")
(1000 . "11 冲头(5) 5.000 -98 -1 0.000 0.000 ")
(1000 . "PLATHKDIAMATER")
(1000 . "20.00 0.25 SKD11")
(1000 . "ORDNO")
(1000 . "3")
(1000 . "OFFSET_NO")
(1000 . "7 108 0.193 8 121 0.133 9 122 0.193 ")
)
)
)原来，WPCAM中的ARX，也是通过添加多义线的扩展属性，里面包含了其加工参数 (defun C:zxc (/ EN OBJ p1 PP)
(and (setq EN (entsel "\n选择多选线: "))
(setq EN (car EN))
(sssetfirst nil (ssadd EN))
(setq OBJ (vlax-ename->vla-object EN))
(or (= (vla-get-objectname OBJ) "AcDbPolyline")
(and (princ "\n所选的对象不是多段线。") nil)
)
)
(setq p1 (getpoint "\n选择切入点: "))
(setq p1 (trans p1 1 0)
PP (vlax-curve-getclosestpointto OBJ p1)
)
(vlax-invoke
OBJ
'ADDVERTEX
(1+ (fix (vlax-curve-getparamatpoint OBJ PP)))
(list (car p1) (cadr p1))
)
(sssetfirst)
(setq p2 (getpoint "\n选择起点"))
(setq pt (list (car p1) (cadr p1)))
(setq pt2 (list (car p2) (cadr p2)))
(setq pt1 (list (car p1) (cadr p1)))
(setq dat (entget en))
(setq ptfrst (cons 10 pt))
(setq dat0 (reverse (member (assoc 39 dat) (reverse dat)))
dat1 (cdr (member (assoc 39 dat) dat))
dat9 (list (last dat1))
dat1 (reverse (cdr (reverse dat1)))
data (member ptfrst dat1)
datb (reverse (cdr (member ptfrst (reverse dat1))))
)
(setq data1 (LIST (cons 10 pt2))
ptend (list (cons 10 pt1))
data2 (LIST (cons 40 0.0) (cons 41 0.0) (cons 42 0.0))
)
(setq aa (append dat0 data1 data2 data datb ptend data2 dat9));排序
(setq dat70 (cons 70 1);改为不封闭的
dat71 (cons 70 0)
aaa (subst dat71 dat70 aa)
)
(setq shu1 (assoc 90 aaa);加多两个端点
shu (cdr shu1)
shu2 (cons 90 (+ 2 shu))
aaaa (subst shu2 shu1 aaa)
)
(entmod aaaa)
(princ)
)
;;;这段代码实现这效果
用统赢方便多了！ 未见专门求多段线起、终点、圆心的部分啊？ http://www.faqs.org/faqs/CAD/autolisp-faq/part2/
Polylines
How to access polyline VERTICES?
How to JOIN multiple lines to polylines?
Change WIDTH of multiple polylines
Create a polyline or spline: with (ENTMAKE) or (COMMAND)
How to calculate the LENGTH of polylines?
How to revert the polyline direction?
How to get the CENTER of a polyline?
Circle/Arc Geometry:BULGE conversion, some trigonometry
页:
[1]
2