明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4873|回复: 14

共享,CAD图形做模具加工中的G代码

  [复制链接]
发表于 2012-7-20 05:00:35 | 显示全部楼层 |阅读模式
本帖最后由 邹锋 于 2012-7-20 05:10 编辑


  1. ;;;;;;打断增强
  2. (defun c:br (/ name pt)
  3.   (setvar "cmdecho" 0)
  4.   (setq name (car (entsel "\n ----------->选取要打断的线")))
  5.   (setq pt (getpoint "\n ----------->选择你要打断的点"))
  6.   (command "break" name pt pt)
  7.   (princ)
  8. )
  9. ;;;;串接增强,可指定方向
  10. (defun c:CJ (/ SS name1 name2 ss1 ss2 sub)
  11.   (command "undo" "be")
  12.   (setvar "cmdecho" 0)
  13.   (setq name1 (car (entsel "\n ----------->请选择进刀线")))
  14.   (if (= name1 nil)
  15.     (alert "没有选择到,请重新选择")
  16.   )
  17.   (setq name2
  18.   (car
  19.     (entsel
  20.       "\n ----------->请选择方向,即进刀线进入后为顺时
  21. 针还是逆时针"
  22.     )
  23.   )
  24.   )
  25.   (if (= name1 nil)
  26.     (alert "没有选择到,请重新选择")
  27.   )
  28.   (princ "\n ----------->请框选要切割图形,包括刚选择的进刀线")
  29.   (setq ss (ssget))
  30.   (setq ss (ssdel name1 ss))
  31.   (setq ss (ssdel name2 ss))
  32.   (setq ss1 (ssadd name1))
  33.   (setq ss2 (ssadd name2 ss1))
  34.   (setq i 0)
  35.   (repeat (sslength ss)
  36.     (setq sn (ssname ss i))
  37.     (setq ss2 (ssadd sn ss1))
  38.     (setq i (1+ i))
  39.   )
  40.   (command "pedit" "m" ss2 "" "y" "j" "j" "" 0.1 "")
  41.   (setq sub (ssget "l"))
  42.   (command "change" sub "" "p" "c" "3" "")
  43.   (command "undo" "e")
  44.   (princ)
  45. )


  46. ;;;;;转出G代码,适合夏米尔慢走丝机床用
  47. (defun C:mzs (/       ss1     ename   el      obj     len     
  48.        i         ptone  pttwo   onex oney twox twoy  tu
  49.      pt1
  50.        pt2     dis     radius  h       h1      half-
  51. angle
  52.        arc-length      pa      n
  53.       )
  54.   (setq ffn (getfiled "选取文件" "" "TXT" 1));;;夏米尔使用ISO
  55. 格式文本
  56.   (setq f (open ffn "w"))
  57.   (princ (strcat "\nH000=0;"
  58.    "\nH001=0.21;"
  59.    "\nH002=0.165;"
  60.    "\nH003=0.131;"
  61.   )
  62.   f
  63.   )
  64.   (setvar "cmdecho" 0)
  65.   (setvar "dimzin" 0)
  66.   (setq ss1 (ssget '((0 . "LWPOLYLINE"))))
  67.   (setq n 0)
  68.   (repeat (sslength ss1)
  69.     (setq ename (ssname ss1 n))
  70.     (shunni)
  71. ;;;判断方向
  72.     (setq ptone (vlax-curve-getpointatparam ename 0)
  73.    pttwo (vlax-curve-getpointatparam ename 1)
  74.    onex (rtos (car ptone) 2 3)
  75.    oney (rtos (cadr ptone) 2 3)
  76.    twox (rtos (car pttwo) 2 3)
  77.    twoy (rtos (cadr pttwo) 2 3)
  78.     )
  79.     (princ (strcat "\nG00 X" onex " Y" oney ";") f)
  80.     (princ (strcat "\nG92 X" onex " Y" oney ";") f)
  81.     (princ (strcat "\nM60;" "\nC096;" "\nG40 H000;\n") f)
  82.     (princ (strcat sn "G01 X" twox " Y" twoy ";") f)
  83.     (princ (strcat "\nC001;" "\nH001;") f)
  84.     (setq el (entget ename))
  85.     (setq obj (vlax-ename->vla-object ename))
  86.     (setq len (1- (cdr (assoc 90 el))))
  87.     (setq i 1)
  88.      ;(setq par nil)
  89.     (repeat (1- len)
  90.       (setq tu (vla-getBulge obj i))
  91.       (setq pt1 (vlax-curve-getpointatparam ename i))
  92.       (setq pt2 (vlax-curve-getpointatparam ename (1+ i)))
  93.       (setq px1 (car pt1)
  94.      py1 (cadr pt1)
  95.      px2 (rtos (car pt2) 2 3)
  96.      py2 (rtos (cadr pt2) 2 3)
  97.       )
  98.       (setq dis (distance pt1 pt2))
  99.       (if (/= tu 0)
  100. (progn
  101.    (setq radius (/ (* (+ 1.0 (* tu tu)) dis 0.25) (abs
  102. tu)))
  103.    (setq h  (* dis (abs tu) 0.5)
  104.   h1 (- radius h)
  105.    )
  106.    (setq half-angle (atan (/ dis 2) h1))
  107.    (setq arc-length (* 2 half-angle radius))
  108.    (setq cen (midp pt1 pt2))
  109.    (setq cen (polar cen
  110.       (+ (angle pt1 pt2)
  111.          (if (or nil
  112.           (and (> h1 0) (> tu 0))
  113.           (and (< h1 0) (< tu 0))
  114.       )
  115.     (* pi 0.5)
  116.     (* pi -0.5)
  117.          )
  118.       )
  119.       (abs h1)
  120.       )
  121.    )
  122.    (setq cenx (car cen)
  123.   ceny (cadr cen)
  124.    )
  125.    (if (< 0 tu)
  126.      (setq sn "\nG03 X")
  127.      (setq sn "\nG02 X")
  128.    )
  129.    (setq xi (- cenx px1)
  130.   yj (- ceny py1)
  131.    )
  132.    (setq xi (rtos xi 2 3)
  133.   yj (rtos yj 2 3)
  134.    )
  135.    (princ (strcat sn px2 " Y" py2 " i" xi " j" yj ";")
  136. f)
  137. )
  138. (progn
  139.    (princ (strcat "\nG01 X" px2 " Y" py2 ";") f)
  140. )
  141.       )
  142.       (setq i (1+ i))
  143.     )
  144.     (princ (strcat "\nM00;" "\nG40 H000 G50 A0.0 G01 X" onex "
  145. Y" oney ";" "\nM50;") f)
  146.     (setq n (1+ n))
  147.   )
  148.   (princ "\nM02;" f)
  149.   (close f)
  150.   (princ)
  151. )

  152. ;;;;批量串接圆
  153. (defun c:ci (/ ss i ename ell ang pto pt r)
  154.   (command "undo" "be")
  155.   (setvar "cmdecho" 0)
  156.   (COMMAND "ucs" "w")
  157.   (setq ss (ssget '((0 . "CIRCLE")))
  158. i  0
  159.   )     ;setq
  160.   (if ss
  161.     (repeat (sslength ss)
  162.       (setq ename     (ssname ss i)
  163.      i       (1+ i)
  164.      endata    (entget ename)
  165.      oldr_list (assoc 40 endata)
  166.      r       (cdr oldr_list)
  167.      cenpt     (assoc 10 endata)
  168.      pt       (cdr cenpt)
  169.      ppt       (polar pt 0 r)
  170.       )     ;setq
  171.       (command "Pline" pt ppt "A"   "CE"  PT    "A"  "90"  
  172. "CE"
  173.         PT    "A"   "90"  "CE"  PT    "A"   "90"  "CE"  
  174. PT
  175.         "A"   "90" ""
  176.        )
  177.     )     ;repeat
  178.   )     ;if
  179.   (command "erase" ss "")
  180.   (command "ucs" "p")
  181.   (command "undo" "e")
  182.   (princ)
  183. )
  184. ;;;判断多义线方向-by GU_xl
  185. (defun shunni (/ fd ang offsetObj plineObj)
  186.   (setq plineObj (vlax-ename->vla-object ename))
  187.   (setq offsetplineObj
  188.   (car (vlax-safearray->list
  189.   (vlax-variant-value
  190.     (vla-OFFSET plineObj 0.0001)
  191.   )
  192.        )
  193.   )
  194.   )
  195.   (if (> (vlax-curve-getdistatparam
  196.     plineobj
  197.     (vlax-curve-getEndParam plineobj)
  198.   )
  199.   (vlax-curve-getdistatparam
  200.     offsetplineObj
  201.     (vlax-curve-getEndParam offsetplineObj)
  202.   )
  203.       )
  204.     (setq sn "G41")
  205.     (setq sn "G42")
  206.   )
  207.   (vla-delete offsetplineObj)
  208. )

  209. (defun midp (p1 p2);;;;BY 高飞鸟
  210.     (polar p1 (angle p1 p2) (* (distance p1 p2) 0.5))
  211.   )



此代码中,还有很多BUG,,,比如:
1   不可以对图元进行二次写出,或三次写出,,,
2    判断多义线方向有时判断错误,,我这些图形都是不封闭的PL,,,可能原作者原意是判断封闭的多义线
3    直线与圆弧生成多义线,比较麻烦,需手动去选择,看了其他编程语言的,才算的上是高效率
      



一个庞大的软件,都源于一段简单的代码,,呵呵,,以后会增加去完善,,,,

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +1 收起 理由
VBALISPER + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2021-4-22 11:38:33 | 显示全部楼层
请问下大佬,如果二维线按线走刀如 :spl 能不加点控制输出g代码吗. circle好像有g代码不要加点。
发表于 2019-4-8 02:33:00 | 显示全部楼层
CNC加工中心的2D部分完成了,现在想想,下决心,写个线割编程用的。
发表于 2019-4-9 06:12:32 来自手机 | 显示全部楼层
楼主不用统赢啊
发表于 2012-7-20 07:19:38 | 显示全部楼层
沙发支持
发表于 2012-7-20 07:59:09 | 显示全部楼层
感谢楼主分享程序!
发表于 2012-7-20 08:21:35 | 显示全部楼层
感谢楼主分享程序!
发表于 2012-7-20 11:37:42 | 显示全部楼层
谢谢楼主分享,最近也在学习程序写G代码,广州数控的
 楼主| 发表于 2012-7-21 07:49:41 | 显示全部楼层

  1. (defun c:ent ()
  2.   (entget (car (entsel)) '("*"))
  3. )


  4. ;;;无屑孔;;;修刀三次
  5. ((-1 . <图元名: 7ef90690>)
  6.   (0 . "LWPOLYLINE")
  7.   (330 .
  8.        <图元名:
  9.        7ef76cf8>
  10.   )
  11.   (5 . "17A")
  12.   (100 . "AcDbEntity")
  13.   (67 . 0)
  14.   (410 . "Model")
  15.   (8 . "0")
  16.   (62 . 1)
  17.   (100 . "AcDbPolyline")
  18.   (90 . 6)
  19.   (70 . 0)
  20.   (43 . 0.0)
  21.   (38 . 0.0)
  22.   (39 .
  23.       0.0
  24.   )
  25.   (10 14.2985 0.0443879)
  26.   (40 . 0.0)
  27.   (41 . 0.0)
  28.   (42 . 0.0)
  29.   (10 15.7128
  30.       1.4586
  31.   )
  32.   (40 . 0.0)
  33.   (41 . 0.0)
  34.   (42 . -0.414214)
  35.   (10 15.7128 -1.36983)
  36.   (40 . 0.0)
  37.   (41 . 0.0)
  38.   (42 . -0.414214)
  39.   (10 12.8843 -1.36983)
  40.   (40 . 0.0)
  41.   (41 . 0.0)
  42.   (42 .
  43.       -0.414214
  44.   )
  45.   (10 12.8843 1.4586)
  46.   (40 . 0.0)
  47.   (41 . 0.0)
  48.   (42 . -0.414214)
  49.   (10
  50.     15.7128
  51.     1.4586
  52.   )
  53.   (40 . 0.0)
  54.   (41 . 0.0)
  55.   (42 . 0.0)
  56.   (210 0.0 0.0 1.0)
  57.   (-3
  58.     ("my_tag" (1000 . "CIRCLEPATH")
  59.               (1000 . "CirclePath")
  60.               (1000 . "NO_COR")
  61.               (1000 . " ")
  62.               (1000 . "WPCAM")
  63.               (1000 . "无屑切割(1)[5]")
  64.               (1000 . "WIRE_DATA0")
  65.               (1000 . "0.000 -98.00 3  0.0000  0.000 0")
  66.               (1000 . "WIRE_DATA1")
  67.               (1000 . " 0.2120 150 150  6.900 71 ")
  68.               (1000 . "WIRE_DATA2")
  69.               (1000 . " 0.1520 450 450  9.050 0 ")
  70.               (1000 . "WIRE_DATA3")
  71.               (1000 . " 0.1320 832 832  6.900 0 ")
  72.               (1000 . "WIRE_DATA4")
  73.               (1000 . " 0.1290 833 833  5.850 0 ")
  74.               (1000 . "WPCAM-PRI")
  75.               (1000 . "0.10 0.10"  )
  76.               (1000 . "WIRED_DATA")
  77.               (1000 . "5 无屑切割(1)[NO_COR] 0.000 -98 3 0.000 0.000 ")
  78.               (1000 . "PLATHKDIAMATER")
  79.               (1000 . "20.00 0.25 SKD11")
  80.               (1000 . "ORDNO")
  81.               (1000 . "2")
  82.               (1000 . "NO_COR0")
  83.               (1000 . " ")
  84.               (1000 . "OFFSET_NO")
  85.               (1000 . "3 110 0.212 4 111 0.152 5 112 0.132 6 113 0.129 ")
  86.     )
  87.   )
  88. )



  89. ;;;;圆形孔,,角度 2度,修1次,放0.21间隙
  90. ((-1 . <图元名: 7ef90568>)
  91.   (0 . "LWPOLYLINE")
  92.   (5 . "155")
  93.   (100 . "AcDbEntity")
  94.   (67 . 0)
  95.   (410 . "Model")
  96.   (8 . "0")
  97.   (62 . 4)
  98.   (100 . "AcDbPolyline")
  99.   (90 . 6)
  100.   (70 . 0)
  101.   (43 . 0.0)
  102.   (38 . 0.0)
  103.   (39 . 0.0)
  104.   (10 6.51043 -0.646734)
  105.   (40 . 0.0)
  106.   (41 . 0.0)
  107.   (42 . 0.0)
  108.   (10 6.51043 -2.64673)
  109.   (40 . 0.0)
  110.   (41 . 0.0)
  111.   (42 . -0.414214)
  112.   (10 4.51043 -0.646734)
  113.   (40 . 0.0)
  114.   (41 . 0.0)
  115.   (42 . -0.414214)
  116.   (10 6.51043 1.35327)
  117.   (40 . 0.0)
  118.   (41 . 0.0)
  119.   (42 . -0.414214)
  120.   (10 8.51043 -0.646734)
  121.   (40 . 0.0)
  122.   (41 . 0.0)
  123.   (42 . -0.414214)
  124.   (10 6.51043 -2.64673)
  125.   (40 . 0.0)
  126.   (41 . 0.0)
  127.   (42 . 0.0)
  128.   (210 0.0 0.0 1.0)
  129.   (-3("my_tag" (1000 . "CIRCLEPATH")
  130.               (1000 . "CirclePath")
  131.               (1000 . "WPCAM")
  132.               (1000 . "圆型孔(4)[2]")
  133.               (1000 . "WIRE_DATA0")
  134.               (1000 . "  2.000 -98.00 1  0.2100  0.000
  135. 0")              (1000 . "WIRE_DATA1")
  136.               (1000 . " 0.1930 150 150  6.900 21 ")
  137.               (1000 . "WIRE_DATA2")
  138.               (1000 . " 0.1330 450 450  9.050 31 ")
  139.               (1000 . "WPCAM-PRI")
  140.               (1000 . "0.10 0.10"  )
  141.               (1000 . "WIRED_DATA")
  142.               (1000 . "2 圆型孔(4) 2.000 -98 1 0.210 0.000 ")
  143.                (1000 . "PLATHKDIAMATER")
  144.               (1000 . "20.00 0.25 SKD11")
  145.               (1000 . "ORDNO")
  146.               (1000 . "1")
  147.               (1000 . "OFFSET_NO")
  148.               (1000 . "1 110 -0.017 2 121 -0.077 ")
  149.     )
  150.   )
  151. )



  152. ;;;;冲头,,角度五度,整修1次
  153. ((-1 . <图元名: 7ef908b0>)
  154.   (0 . "LWPOLYLINE")
  155.   (330 .
  156.        <图元名:
  157.        7ef76cf8>
  158.   )
  159.   (5 . "1B6")
  160.   (100 . "AcDbEntity")
  161.   (67 . 0)
  162.   (410 . "Model")
  163.   (8 . "0")
  164.   (62 . 5)
  165.   (100 . "AcDbPolyline")
  166.   (90 . 7)
  167.   (70 . 0)
  168.   (43 . 0.0)
  169.   (38 . 0.0)
  170.   (39 .
  171.       0.0
  172.   )
  173.   (10 -7.30103 0.679924)
  174.   (40 . 0.0)
  175.   (41 . 0.0)
  176.   (42 . 0.0)
  177.   (10 -2.30103
  178.       0.679924
  179.   )
  180.   (40 . 0.0)
  181.   (41 . 0.0)
  182.   (42 . 0.0)
  183.   (10 -2.30103 1.92992)
  184.   (40 . 0.0)
  185.   (41
  186.     .
  187.     0.0
  188.   )
  189.   (42 . 0.0)
  190.   (10 2.69897 1.92992)
  191.   (40 . 0.0)
  192.   (41 . 0.0)
  193.   (42 . 0.0)
  194.   (10
  195.     2.69897
  196.     -3.07008
  197.   )
  198.   (40 . 0.0)
  199.   (41 . 0.0)
  200.   (42 . 0.0)
  201.   (10 -2.30103 -3.07008)
  202.   (40 .
  203.       0.0
  204.   )
  205.   (41 . 0.0)
  206.   (42 . 0.0)
  207.   (10 -2.30103 0.679924)
  208.   (40 . 0.0)
  209.   (41 . 0.0)
  210.   (42 .
  211.       0.0
  212.   )
  213.   (210 0.0 0.0 1.0)
  214.   (-3
  215.     ("my_tag" (1000 . "WPCAM")
  216.               (1000 . "冲头(5)[11]")
  217.               (1000 . "WIRE_DATA0")
  218.               (1000 . "  5.000 -98.00 -1  0.0000  0.000 8")
  219.               (1000 . "WIRE_DATA1"  )
  220.               (1000 . " 0.1930 150 150  6.900 21 ")
  221.               (1000 . "WIRE_DATA2")
  222.               (1000 . " 0.1330 450 450  9.050 31 " )
  223.               (1000 . "WIRE_DATA3")
  224.               (1000 . " 0.1930 150 150  6.900 21 ")   (1000 . "WPCAM-PRI")
  225.               (1000 . "0.10 0.10")
  226.               (1000 . "WIRED_DATA")
  227.               (1000 . "11 冲头(5) 5.000 -98 -1 0.000 0.000 ")
  228.               (1000 . "PLATHKDIAMATER")
  229.               (1000 . "20.00 0.25 SKD11")
  230.               (1000 . "ORDNO")
  231.               (1000 . "3")
  232.               (1000 . "OFFSET_NO")
  233.               (1000 . "7 108 0.193 8 121 0.133 9 122 0.193 ")
  234.     )
  235.   )
  236. )
原来,WPCAM中的ARX,也是通过添加多义线的扩展属性,里面包含了其加工参数
 楼主| 发表于 2012-7-21 08:08:43 | 显示全部楼层
(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)
)

;;;这段代码实现这效果



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-7-21 13:26:47 | 显示全部楼层
用统赢方便多了!

点评

一个WT.ARX文件  发表于 2012-7-21 19:32
只是想,,,提取统赢中的一部分,,  发表于 2012-7-21 19:31
发表于 2012-7-31 09:59:57 | 显示全部楼层
未见专门求多段线起、终点、圆心的部分啊?
发表于 2012-7-31 10:41:50 | 显示全部楼层
http://www.faqs.org/faqs/CAD/autolisp-faq/part2/

     [23] Polylines
       [23.1] How to access polyline VERTICES?
       [23.2] How to JOIN multiple lines to polylines?
       [23.3] Change WIDTH of multiple polylines
       [23.4] Create a polyline or spline: with (ENTMAKE) or (COMMAND)
       [23.5] How to calculate the LENGTH of polylines?
       [23.6] How to revert the polyline direction?
       [23.7] How to get the CENTER of a polyline?
     [24] Circle/Arc Geometry:  BULGE conversion, some trigonometry

点评

上不去?需要翻墙吗?  发表于 2012-7-31 11:47
好多资料呀,谢谢了  发表于 2012-7-31 11:26
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-18 20:43 , Processed in 0.240615 second(s), 39 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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