一个在CAD中实现G代码生成的二次开发.

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

前生

乱七八糟的有60M,有需要的朋友,发邮件给我.我发邮件给大家.谢谢!
这个主要是针对冲压模具CNC加工的备料程序.

逍遥天下

有点眼花缭乱

自贡黄明儒

"借鉴高飞大侠的像素功能"制作界面的程序，可否分享一下

cnks

复杂。。。

前生

将白色过滤掉
(defun putb(ff  /       *error* dch     dcl     des     i       images
               j       x       y       R       G       B       W
               H       wStr    hStr    rStr    key     ColorObj
               DCLHead DCLList DCLTail ImageHead       IndexColor
               Version
              )  ;;读取文本文件
  (defun RGB->Index (ColorObj r g b / i)
;;;    (if (or (and (equal 0 r 10) (equal 0 g 10) (equal 0 b 10))
;;;      (and (equal 255 r 10) (equal 255 g 10) (equal 255 b 10))
;;;            )
    (if (and (equal 0 r 10) (equal 0 g 10) (equal 0 b 10))
      -15                                                        ;It should be 0,but if you have set the CAD background color,then it looks strange.
    (progn
      (vla-setRGB ColorObj r g b)
      (setq i (vla-get-ColorIndex ColorObj))
      (if (= i 7)                                             ;A little confused!
        255
        i
      )
      )
      )
    )
  (setq images (load(strcat "c:\\ourscad\\pic\\" ff ".lsp")))
  (setq ffff (open (strcat "c:\\ourscad\\pic\\" ff ".lsp") "r"))
  (setq file (open (strcat "c:\\ourscad\\pic\\" ff "12.lsp") "w"))
;;;  (setq file (open "c:/OURSCAD/hanzi.wmf" "w"))
;  (setq str (read-line f))
  (write-line (read-line ffff) file)
  (and (null Images) (exit))
;;获取CAD颜色对象，为颜色转化做准备
  (setq Version (substr (getvar 'acadver) 1 2))
  (setq Version (strcat "AutoCAD.AcCmColor." version))
  (setq ColorObj (vlax-create-object version))
  (setq i 0)
  (foreach image Images
    (foreach pt        (cdr Image)
      (setq x (car pt))
      (setq y (cadr pt))
      (setq r (nth 2 pt))
      (setq g (nth 3 pt))
      (setq b (nth 4 pt))
      (setq IndexColor (RGB->Index ColorObj r g b))
      (write-line (vl-prin1-to-string (list x y IndexColor)) file)
    )
    (end_image)
    (setq i (1+ i))
  )
  (write-line "))" file)
  (Close file)(close ffff)
  (and ColorObj (vlax-release-object ColorObj))
  (setq ffff (open (strcat "c:\\ourscad\\pic\\" ff ".lsp") "r"))
  (setq file (open (strcat "c:\\ourscad\\pic\\" ff "bak.lsp") "w"))
  (setq str (read-line ffff))
  (write-line str file)
  (while (setq str (read-line ffff))
   (write-line str file)
    )
  (close ffff)(Close file)
  
  (setq ffff (open (strcat "c:\\ourscad\\pic\\" ff ".lsp") "w"))
  (setq file (open (strcat "c:\\ourscad\\pic\\" ff "12.lsp") "r"))
  (setq str (read-line file))
  (write-line str ffff)
  (while (setq str (read-line file))
    (setq lll (strlen str))
    (cond
      ((< lll 4) (write-line str ffff))
      ((and (>= lll 4)(/= "255)" (substr str (- lll 3))))
;       ((and (>= lll 4)(/= "5)" (substr str (- lll 1))))
       (write-line str ffff))
    )
;    (write-line str ffff)
    )
  (close ffff)(Close file)
  (princ)
)










FF为文件名.xs为倍数
(defun put(ff xs /       *error* dch     dcl     des     i       images
               j       x       y       R       G       B       W
               H       wStr    hStr    rStr    key     ColorObj
               DCLHead DCLList DCLTail ImageHead       IndexColor
               IC
              )  ;;读取文本文件,xs为正整数
  (setq images (load(strcat "c:\\ourscad\\pic\\" ff ".lsp")))
  (and (null Images) (exit))
   ;;填充图像控件
  (setq i 0)
  (foreach image Images
    (foreach pt        (cdr Image)
      (setq x (car pt))
      (setq y (cadr pt))
      (setq ic (nth 2 pt))
;       (fill_image x y 1 1 ic)
;;;      (if (/= 255 ic)
      (fill_image (* xs x)(* xs y) xs xs ic)
;;;        (fill_image (* xs x)(* xs y) xs xs ic)
;;;        )
    )
    (end_image)
    (setq i (1+ i))
  )
  ;;开始对话框演示
;;;  (and (< 0 dch) (unload_dialog dch))
  (and ColorObj (vlax-release-object ColorObj))
  (princ)
)

机械小男人雄起

给楼主发送邮件失败了，楼主可不可以给我发一份源码，邮箱470247532@qq.com，万分感谢！

xiaolong1487

可以给份我吗？我有个朋友是做CNC的！ xiaolong100.168@163.com

hhh454

实用型工具，给楼主点赞

TPG辉

可以给份我吗？我也是做CNC方面的 498091367@qq.com