求一个CNC钻孔的程序。谢谢。

st788796 · 发表于 2014-4-7 15:46:16

Lisphk 发表于 2014-4-7 15:40
你安装OPENDCL后，加载晓东LISP函数库，会自动加载OPENDCL的。

这个库的反应器自动写一个常用命令.txt 文件，这个写出用到那个tofile函数，上面的程序修改了tofile函数，加载函数库会冲突

ghoust · 发表于 2014-4-7 16:20:22

st788796 发表于 2014-4-7 15:27
命令行输入 opendcl 就可以用了

大师请看，测试有以下问题：
   1：输入的数据和对应的参数不匹配，刚好错位了。
   2：除了切削速度那个输入框输入数据OK，其它4个输入数据的地方，只要一输入马上就反应，而不是等用户输入完了再判断。
   3：输入命令后，直接点模板的连框会出现“致命错误”。用之前那个打点的LISP先做好路径，再运行可以输出文件。但是打点的需要加载xd-lisp-lib.VLX而钻孔的不能加载xd-lisp-lib.VLX，所以两个会有冲突。能不能将点选变成框选，和打点的程序一样，点击选择以后，直接框选整个模板，然后就出路径了。
   4：麻烦大师将“单孔深度”改为“单次钻深”吧，孔内排屑和孔外排屑，写完整的话，需要改对话框吗？
暂时测试发现这些问题，大师，修改起来会不会很麻烦啊？真的是太麻烦你了。

st788796 · 发表于 2014-4-7 18:42:26

ghoust 发表于 2014-4-7 16:20
大师请看，测试有以下问题：
1：输入的数据和对应的参数不匹配，刚好错位了。
2：除了 ...

MouseEntered 事件中关闭Form会出错，暂时注释掉，测试能用

;;=========================================================================================;
;;说明: ;
;;1 切换文档将关闭对话框 ;
;;2 **XXGlobleParam** 默认参数 ;
;; **XXPathOutputPath** 未输出路径Pline ;
;; **XXPathOutputDir** 保存路径 ;
;; **XXPathFileNum** 文件编号 ;
;;=========================================================================================;
;; Author: st788796 From www.xdcad.net 2014.04.04 ;
;;=========================================================================================;
(defun XD::Pnts:RemoveDup (pts fuzz / remove i)
(defun remove (pts fuzz / ptl)
(while pts
(if (equal (caar pts) (caar ptl) fuzz)
(setq pts (cdr pts))
(setq ptl (cons (car pts) ptl)
pts (cdr pts)
)
)
)
ptl
)
(setq i 0
pts (mapcar '(lambda (x) (cons x (setq i (1+ i)))) pts)
pts (vl-sort pts
'(lambda (p1 p2)
(if (= (cadar p1) (cadar p2))
(< (caar p1) (caar p2))
(< (cadar p1) (cadar p2))
)
)
)
pts (remove pts fuzz)
pts (vl-sort pts
'(lambda (p1 p2)
(if (= (caar p1) (caar p2))
(< (cadar p1) (cadar p2))
(< (caar p1) (caar p2))
)
)
)
pts (remove pts fuzz)
pts (vl-sort pts
'(lambda (p1 p2) (< (cdr p1) (cdr p2)))
)
pts (mapcar 'car pts)
)
pts
)
(defun XD::Entity->PickSet (entl / n ss x)
(setq ss (ssadd))
(foreach n entl
(ssadd n ss)
)
ss
)
(defun XD::String:Strpad (intval pad sp str / zeros nstr)
(xdrx_sysvar_push '(("Dimzin" 0)))
(setq nstr (strcat
(apply 'strcat
(repeat (- pad (strlen (rtos intval 2 str)))
(setq zeros (cons sp zeros)) ; make list
)
)
(rtos intval 2 str)
)
)
(xdrx_sysvar_pop)
nstr
)
(defun XD::List:ToFile (fn lst / fl x)
(setq fl (open fn "w"))
(if (and
fl
(> (length lst) 0)
)
(progn
(mapcar
'(lambda (x)
(write-line x fl)
)
lst
)
(close fl)
t
)
)
)
;;处理路径
(defun Path_Output_List (/ header param bp ptl)
(if **XXPathOutputPath**
(progn
(setq param (mapcar '(lambda (x y)
(if (listp y)
(if (zerop x)
(cadr y)
(car y)
)
(strcat y (itoa x))
)
)
**XXGlobleParam**
'(("G73" "G83") "F" "G0z" "S" "Q" "Z-" )
)
;;G91G28X0Y0Z0
;;G40G17G80G49
;;G90G54
;;G0z5
;;M03 S1500
;;M00
header (list "G91G28X0Y0Z0"
"G40G17G80G49"
"G90G54"
(cadr param)
"M00"
(strcat "M03" " " (caddr param))
"M00"
)
;;G0X坐标Y坐标Z2 坐标就是框选圆心的坐标，按我的理解，这个应该是离UCS最近那个。
;;G01Z-2F50 这里的50就是用户输入的切削速度了。哦，最大值不能超过200，要不然机器就麻烦了。
;;G0Z5 这个5也是用户输入的，这是安全高度。最大值50，太高了机器行程不够。
;;G73 x5 y5 z-20 R1 Q5 F200
;;G0z5
;;G73 x10 y10 z-20 R1 Q5 F200
;;G0z5
;;G73 x15.525 y65.755 z-20 R1 Q5 F200
;;G0z5
bp (vlax-curve-getstartpoint **XXPathOutputPath**)
ptl (xdrx_entity_getstretchpoint **XXPathOutputPath**)
ptl (apply
'append
(mapcar
'(lambda (x)
(list
(strcat
(car param)
" " ;_"G0X"
"x"
(rtos (car x)
2
3
)
" "
"y"
(rtos (cadr x)
2
3
)
(nth 5 param)
" R1 "
(nth 4 param)
" "
(cadr param)
)
(caddr param)
)
)
(mapcar
'(lambda (a)
(mapcar '- a bp)
)
(cdr ptl)
)
)
)
lst (append header ptl '("M30"))
)
(xd::list:tofile
(strcat (if (= (vl-filename-directory **XXPathOutputDir**)
**XXPathOutputDir**
)
(strcat **XXPathOutputDir** "XDNC-")
(strcat **XXPathOutputDir** "\\XDNC-")
)
(xd::string:strpad **XXPathFileNum** 3 "0" 0)
".nc"
)
lst
)
(princ
(strcat
"\n写出 "
(strcat (if (= (vl-filename-directory **XXPathOutputDir**)
**XXPathOutputDir**
)
(strcat **XXPathOutputDir** "XDNC-")
(strcat **XXPathOutputDir** "\\XDNC-")
)
(xd::string:strpad **XXPathFileNum** 3 "0" 0)
".nc"
)
" 文件, Ok"
)
)
(setq **XXPathFileNum** (1+ **XXPathFileNum**))
(setq **XXPathOutputPath** nil)
;(if (dcl_form_isactive path_form1)
; (dcl_form_close path_form1)
;)
)
)
(princ)
)
;;选择轮廓
(defun Path_Select_Polyline (/ GetPntsPath _SelectPathByPolyline ss)
(defun GetPntsPath (bp pts / ptl)
(setq ptl (list bp))
(while pts
(setq pts (mapcar '(lambda (x)
(list (distance (car ptl) x) x)
)
pts
)
pts (vl-sort pts
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
ptl (cons (cadar pts) ptl)
pts (cdr (mapcar 'cadr pts))
)
)
(reverse ptl)
)
(defun _SelectPathByPolyline (e / pl box ss pts ptl bp)
(setq box (xdrx_entity_box e)
bp (car box)
)
(or
(and (setq ss (ssget "_C"
(car box)
(caddr box)
'((0 . "LWPOLYLINE") (8 . "XD-CIRCLE-PATH"))
)
)
(if (> (sslength ss) 1)
(progn
(princ "\n重复路径!")
t
)
(setq pl (ssname ss 0))
)
)
(and (setq ss (ssget "_C"
(car box)
(caddr box)
'((0 . "circle"))
)
) ;_选择整个零件，自动计算Box左下角点
(progn
(setq
pts (XD::Pnts:RemoveDup
(mapcar
'(lambda (x) (xdrx_getpropertyvalue x "Center"))
(xdrx_pickset->ents ss)
)
1e-3
)
ptl (getpntspath
bp
(vl-remove-if '(lambda (x) (equal bp x 0.001)) pts)
)
)
(xdrx_layer_make "XD-Circle-Path" 1)
(setq pl (apply 'xdrx_polyline_make ptl))
(xdrx_setpropertyvalue
pl
"layer"
"XD-Circle-Path"
)
)
)
)
pl
)
(if (and (setq e (car (xdrx_entsel
"\n点选轮廓线: "
'((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))
)
)
)
(setq **XXPathOutputPath** (_SelectPathByPolyline e))
(= (xdrx_yesorno "直接输出文件" 1) 1)
)
(Path_Output_List)
(if **XXPathOutputPath**
(progn
(sssetfirst
nil
(XD::Entity->pickset (list **XXPathOutputPath**))
)
(princ "\n手动调整后，鼠标进入对话框直接输出文件!")
)
(princ "\n未找到路径或圆!")
)
)
)
;;=========================================================================================;
;; ODCL ;
;;=========================================================================================;
;;参数控件
(defun ODCL_Path_ParamControl ()
(list path_form1_cuttingspeed path_form1_safeheight
path_form1_rotationrate path_form1_holedepth
path_form1_drill
)
)
;;获取参数设置
(defun ODCL_Path_GetParam ()
(setq **XXGlobleParam**
(cons (dcl_grid_getcellcheckstate path_form1_option1 0 0)
(mapcar '(lambda (x)
(atoi (dcl_control_gettext x))
)
(ODCL_Path_ParamControl)
)
)
)
)
;;option state
(defun ODCL_Path_OptionState (mod)
(dcl_grid_setcellcheckstate path_form1_option1 0 0 mod)
(dcl_grid_setcellcheckstate
path_form1_option1
0
1
(abs (1- mod))
)
)
;;检查输入合法性
;;超过最大值自动设置为最大值，小于最小值时自动设置为最小值
(defun ODCL_Path_Pamram_CheckInput (str e var)
(mapcar '(lambda (x)
(if (= (car x) str)
(cond
((> (atoi var) (last x))
(dcl_control_settext e (last x))
)
((< (atoi var) (cadr x))
(dcl_control_settext e (cadr x))
)
(t)
)
)
)
'(("cuttingspeed" 1 500)
("safeheight" 3 100)
("rotationrate" 300 5000)
("holedepth" 1 8)
("drill" 2 150)
)
)
)
;;控件提示
(defun ODCL_Path_Input_Prompt (str e)
(mapcar '(lambda (x)
(if (= str (car x))
(dcl_control_setcaption path_form1_prompt (cadr x))
)
)
'(("cuttingspeed" "切削速度建议范围 1-300,最大值500")
("safeheight" "安全高度取值范围 3-100")
("rotationrate" "主轴转速取值范围 300-5000")
("holedepth" "单孔深度取值范围 1-8")
("drill" "钻穿深度取值范围 2-150")
)
)
)
;;OpenDCL Event
(mapcar '(lambda (x)
(eval (list 'defun
(read (strcat "c:path_form1_" (car x)))
(cadr x)
'(dcl_form_close path_form1)
)
)
)
'(("OnCacel" nil)
("OnDocActivated" nil)
("OnEnteringNoDocState" nil)
("OnClose" (UpperLeftX UpperLeftY /))
)
)
(mapcar
'(lambda (x)
(eval (list 'defun
(read (strcat "c:path_form1_" x "_OnMouseMove"))
'(Flags X Y /)
(list 'ODCL_Path_Input_Prompt
x
(read (strcat "path_form1_" x))
)
)
)
(eval
(list 'defun
(read (strcat "c:path_form1_" x "_OnEditChanged"))
'(NewValue /)
(list 'ODCL_Path_Pamram_CheckInput
x
(read (strcat "path_form1_" x))
'NewValue
)
)
)
)
'("cuttingspeed" "safeheight" "rotationrate" "holedepth" "drill")
)
(defun c:path_form1_pick_OnClicked (/ ptl)
(Path_Select_Polyline)
(princ)
)
(defun c:path_form1_dir_OnClicked (/ dir)
(if (setq dir (dcl_SelectFolder
"选择保存目录"
(getvar "DWGPREFIX")
64
)
)
(progn
(setq **XXPathOutputDir** dir)
(dcl_control_settext
path_form1_folder
(strcat
dir
(if (= (vl-filename-directory dir) dir)
""
"\\"
)
(vl-filename-base (dcl_control_Gettext path_form1_folder))
".nc"
)
)
)
)
)
;;MouseEntered
(defun c:path_Form1_OnMouseEntered (/)
;(dcl_control_setcaption path_form1_prompt " ")
(if **XXPathOutputPath**
(Path_Output_List)
)
(princ)
)
;;MouseOff ODCL
(defun c:path_Form1_OnMouseMovedOff (/)
(dcl_control_setcaption path_form1_prompt " ")
(setq **XXGlobleParam** (ODCL_Path_GetParam)
**XXPathOutputDir** (vl-filename-directory
(dcl_control_gettext path_form1_folder)
)
)
)
(defun c:path_Form1_option1_OnSelChanged (Row Column /)
(ODCL_Path_OptionState (abs (1- Column)))
)
;;ODCL Initialize
(defun c:path_Form1_OnInitialize ()
(dcl_grid_addrow path_form1_option1 "\t")
(mapcar
'(lambda (x)
(apply 'dcl_grid_setcelltext (cons path_form1_option1 x))
)
'((0 0 "孔内排屑") (0 1 "孔外排屑"))
)
(if **XXGlobleParam**
(progn
(mapcar '(lambda (x y)
(dcl_control_settext x (itoa y))
)
(ODCL_Path_ParamControl)
(cdr **XXGlobleParam**)
)
(ODCL_Path_OptionState
(car **XXGlobleParam**)
)
)
)
(if **XXPathOutputDir**
(dcl_control_settext
path_form1_folder
(strcat (if (= (vl-filename-directory **XXPathOutputDir**)
**XXPathOutputDir**
)
(strcat **XXPathOutputDir** "XDNC-")
(strcat **XXPathOutputDir** "\\XDNC-")
)
(xd::string:strpad **XXPathFileNum** 3 "0" 0)
".nc"
)
)
(dcl_control_settext
path_form1_folder
(strcat (getvar "DWGPREFIX")
"\\XDNC-"
(xd::string:strpad **XXPathFileNum** 3 "0" 0)
".NC"
)
)
)
)
;;Main Program
(defun PathOutput_Main (mod / string)
(and **XXGlobleParam**
(/= (car **XXGlobleParam**) mod)
(setq **XXGlobleParam**
(cons mod (reverse **XXGlobleParam**))
)
)
(or **XXGlobleParam**
(setq **XXGlobleParam** (cons mod '(200 3 500 4 2)))
)
(or **XXPathFileNum**
(setq **XXPathFileNum** 1)
)
(setq string
'("YWt6A4o9AABCYgIfBuKTJScSKitmgNmVV1Mm/9wu+yg0XjTPZZMqbf38OO+Qbks7FUXjrDTJ6iQ3"
"IZT9WF7kSBSiYfZxlv11ZMmW5Vg4oQaKv7oj9bQcHHJ/G4KBgTCZ4I0xmTDZyePbshOQigIZh7EM"
"gZFFGZBHDSueDH78CahOCrxWivx5fjCbfJovfm20lN5o1N54kVTWuQ5Hij5bhk4i8M+rnvtQcqud"
"IVucDIDS+ESym/sQgiHz31DCx9x+J9J7QZjUvgpR+NbyYQ2onlkn0r7F7VMoHFfU22iBlEag8YsE"
"j8FxgYIudoca6mTk8Ulq/Yw+eHpRMrTAdfgeeniu7IRxDPx3YDJXjL9TTq2bcM6NCz5tcrwwMmea"
"RIQ/wxjqeksYnquvUosdsl/K2rjzDLuwmwhfiL+TBvE8YfIPQGRba07S6kQlx20RVEn8SHiffkoc"
"xBvHc51T5ZQlr8G5csKox/gFjpCdSAgcMYUe4lLAZjUxZW5BtF0ayegFhMofm8THJN+uZiUWPIGX"
"f+udT4UJN4qJzr4hv7RnYXRE7RT7Uq5QS78wualKhMqEYszziusIhOX6TUMYh/GTCrhhdILvvmF2"
"gtGjYDQuZXPJsUSJsm1jsTMgEi8hZY/eyKYICB72lz3jUdzmpVoDdAJG2t2CDrcHcJ+OhdM57VP4"
"ihNP+pF2wry+5V1BtDZLsMYNSUWlMFKpt0fGS4Pfr56g1/18cfoEk4f54KjuNgE6nlCvhF18oVnO"
"IZ4deKBKoaD4xcoEK6rKIZ5N35kZn7UIsaYxsPTggHfHeFBtm7GnXbmXQ6/X7H8UWDSjUqLKPB7z"
"OGmXvxqnSpyKWEWDdp/t/PiRdwW1eujKwqS4qiJLFsQFfdQcd6DD0oWDZqD74Xk+AxTJnXLLrVWk"
"36+DJLxR9giiWoQrGpmJbBDITyxuqig/iQz/EWqLAV8O9eOBWp8s3eHnK0bpKP6kGJm02iIBds+m"
"2sv0kDhlYVkC0RarYP9leqBTDsMWy2rVsxxqS4/EYUqPVN7mDo9kP6wmDSJh+HjvCr+HEK+6VSzz"
"NS3C4gXlaFEzwgRfUyBfkizCyPn3aWsJbNFTHvSpne46nMviHLy6VdFpN62xfJ85hG+HIrQoJxpc"
"+anrvPwLPZKDMjWra14r2b7q1B8mJteca+xXK+BkPdjGO1daLZp3X+ckP08fTOujsxFolmfE6tns"
"tsrLlTYfJyRBiYDbmzbt3cUfF7QvfCgw4NTmwIyPthUMik5ar9TX7hy8mhYnZWzSeeFcQ7dAAvzD"
"NknpvJqOexbIpCwm3Eiw2dkXz8R8oC9bHJMq46yR2TwVWbS/kClfu1QVZtea/f3edJjEJUwtvKAn"
"zI7S0Zqh+6YakVP/aSTS8LsneNyuIN2LBxQA7Q7YYp0fG5oz45AMM5OHLEclNjxKVBWq2+4wo2Pq"
"gAwWVtMIa6VGPos3FERu8VsxXSB3Un6PHF5k093mFtpu1VYY1VokWLO7XewYleJomupBM0yJWq02"
"u6EQe9ew8JOVDlxrnftc6yWsuj50APmsVrTFW3sGsoiw+VoqHHO7Eu1at6f9KpacT9XqKjfFg4KZ"
"6BfPGpoKxxpKF+/rpcTFC72q9/lsSKEWKt9RJISs7pNod1QWKo8EeitCsCofhWQrIPyGsGFr3i+d"
"ZPQP3Dgr5GT327iviKDoESAP2HidWt54xcw4c0B22i+dTtpuSxa0Cto4C+Rkj914UU56SxATYuOS"
"4aJO63SqDkUV7hWUqh5UW/RkFVe492RLFxRa6GSFpIjIgUvuZHVUyc04LC8dY7tGLx0F5GSP3XiR"
"lnYUAoiCugbULr2T0q9yWEsWOVdfqlZ7hNN8IAk2FJpwj7dqlT5jAG8BLkYlwL5BJvlhd/myLtPB"
"5I//ntvAyQBWb/Q5caalgBq1zcDogygGs31qKOH2BAD3HpG5do+tzgSoCIMYw9119YGnyk0N1eGy"
"hpie0+j1iAtSTJcdoxdFlMateJRX/3WZhN1wrUHSCeoTsk/PqWaRI8lWTIvF3osX5WjC1di3ptvH"
"tqb3OySqwFGStsn41V5RGlluiHCP87aRat2zlVIQofcgA1e6mAuv1QYRobleCLk/JXkiMU+flf4f"
"QD1CvlDjMpX+wemIRP5aK9J9YsnTZ1G8ggE/soFKG8bngaeb7QbRlEIWWSaoLTKmd+jiYEDdpLNB"
"/PWdt3ug4ye+7XXybQ4M/405Ded7Qse+UClUIj5FyQ4fvKdbaRvZtrvHewwv6XnYbMGGDECY6gp5"
"6paEYdk6HYQ="
)
)
(dcl_project_import string)
(dcl_form_show path_form1)
(princ)
)
(defun c:dacm ()
(PathOutput_Main 1)
(Path_Select_Polyline)
(princ)
)
(defun c:dbcm ()
(PathOutput_Main 0)
(Path_Select_Polyline)
(princ)
)

;;=========================================================================================; 
;;说明:                                                                                    ; 
;;1 切换文档将关闭对话框                                                                   ; 
;;2 **XXGlobleParam**    默认参数                                                          ; 
;;  **XXPathOutputPath** 未输出路径Pline                                                   ; 
;;  **XXPathOutputDir**  保存路径                                                          ; 
;;  **XXPathFileNum**    文件编号                                                          ; 
;;=========================================================================================; 
;; Author: st788796 From www.xdcad.net 2014.04.04                                          ; 
;;=========================================================================================; 
(defun XD::Pnts:RemoveDup (pts fuzz / remove i) 
  (defun remove        (pts fuzz / ptl) 
    (while pts 
      (if (equal (caar pts) (caar ptl) fuzz) 
        (setq pts (cdr pts)) 
        (setq ptl (cons (car pts) ptl) 
              pts (cdr pts) 
        ) 
      ) 
    ) 
    ptl 
  ) 
  (setq        i   0 
        pts (mapcar '(lambda (x) (cons x (setq i (1+ i)))) pts) 
        pts (vl-sort pts 
                     '(lambda (p1 p2) 
                        (if (= (cadar p1) (cadar p2)) 
                          (< (caar p1) (caar p2)) 
                          (< (cadar p1) (cadar p2)) 
                        ) 
                      ) 
            ) 
        pts (remove pts fuzz) 
        pts (vl-sort pts 
                     '(lambda (p1 p2) 
                        (if (= (caar p1) (caar p2)) 
                          (< (cadar p1) (cadar p2)) 
                          (< (caar p1) (caar p2)) 
                        ) 
                      ) 
            ) 
        pts (remove pts fuzz) 
        pts (vl-sort pts 
                     '(lambda (p1 p2) (< (cdr p1) (cdr p2))) 
            ) 
        pts (mapcar 'car pts) 
  ) 
  pts 
) 
(defun XD::Entity->PickSet (entl / n ss x) 
  (setq ss (ssadd)) 
  (foreach n entl 
    (ssadd n ss) 
  ) 
  ss 
) 
(defun XD::String:Strpad (intval pad sp str / zeros nstr) 
  (xdrx_sysvar_push '(("Dimzin" 0))) 
  (setq        nstr (strcat 
               (apply 'strcat 
                      (repeat (- pad (strlen (rtos intval 2 str))) 
                        (setq zeros (cons sp zeros)) ; make list 
                      ) 
               ) 
               (rtos intval 2 str) 
             ) 
  ) 
  (xdrx_sysvar_pop) 
  nstr 
) 
(defun XD::List:ToFile (fn lst / fl x) 
  (setq fl (open fn "w")) 
  (if (and 
        fl 
        (> (length lst) 0) 
      ) 
    (progn 
      (mapcar 
        '(lambda (x) 
           (write-line x fl) 
         ) 
        lst 
      ) 
      (close fl) 
      t 
    ) 
  ) 
) 
;;处理路径 
(defun Path_Output_List        (/ header param bp ptl) 
  (if **XXPathOutputPath** 
    (progn 
      (setq param  (mapcar '(lambda (x y) 
                              (if (listp y) 
                                (if (zerop x) 
                                  (cadr y) 
                                  (car y) 
                                ) 
                                (strcat y (itoa x)) 
                              ) 
                            ) 
                           **XXGlobleParam** 
                           '(("G73" "G83") "F" "G0z" "S" "Q" "Z-" ) 
                   ) 
            ;;G91G28X0Y0Z0 
            ;;G40G17G80G49 
            ;;G90G54 
            ;;G0z5 
            ;;M03  S1500 
            ;;M00 
            header (list "G91G28X0Y0Z0" 
                         "G40G17G80G49" 
                         "G90G54" 
                         (cadr param) 
                         "M00" 
                         (strcat "M03" " " (caddr param)) 
                         "M00" 
                   ) 
            ;;G0X坐标Y坐标Z2       坐标就是框选圆心的坐标，按我的理解，这个应该是离UCS最近那个。 
            ;;G01Z-2F50          这里的50就是用户输入的切削速度了。哦，最大值不能超过200，要不然机器就麻烦了。 
            ;;G0Z5               这个5也是用户输入的，这是安全高度。最大值50，太高了机器行程不够。 
            ;;G73  x5 y5                   z-20  R1 Q5  F200 
            ;;G0z5 
            ;;G73  x10 y10                z-20  R1 Q5  F200 
            ;;G0z5 
            ;;G73  x15.525  y65.755   z-20  R1 Q5  F200 
            ;;G0z5 
            bp           (vlax-curve-getstartpoint **XXPathOutputPath**) 
            ptl           (xdrx_entity_getstretchpoint **XXPathOutputPath**) 
            ptl           (apply 
                     'append 
                     (mapcar 
                       '(lambda        (x) 
                          (list 
                            (strcat 
                              (car param) 
                              " " ;_"G0X" 
                              "x" 
                              (rtos (car x) 
                                    2 
                                    3 
                              ) 
                              " " 
                              "y" 
                              (rtos (cadr x) 
                                    2 
                                    3 
                              ) 
                              (nth 5 param) 
                              " R1 " 
                              (nth 4 param) 
                              " " 
                              (cadr param) 
                            ) 
                            (caddr param) 
                          ) 
                        ) 
                       (mapcar 
                         '(lambda (a) 
                            (mapcar '- a bp) 
                          ) 
                         (cdr ptl) 
                       ) 
                     ) 
                   ) 
            lst           (append header ptl '("M30")) 
      ) 
      (xd::list:tofile 
        (strcat        (if (= (vl-filename-directory **XXPathOutputDir**) 
                       **XXPathOutputDir** 
                    ) 
                  (strcat **XXPathOutputDir** "XDNC-") 
                  (strcat **XXPathOutputDir** "\\XDNC-") 
                ) 
                (xd::string:strpad **XXPathFileNum** 3 "0" 0) 
                ".nc" 
        ) 
        lst 
      ) 
      (princ 
        (strcat 
          "\n写出 " 
          (strcat (if (= (vl-filename-directory **XXPathOutputDir**) 
                         **XXPathOutputDir** 
                      ) 
                    (strcat **XXPathOutputDir** "XDNC-") 
                    (strcat **XXPathOutputDir** "\\XDNC-") 
                  ) 
                  (xd::string:strpad **XXPathFileNum** 3 "0" 0) 
                  ".nc" 
          ) 
          " 文件, Ok" 
        ) 
      ) 
      (setq **XXPathFileNum** (1+ **XXPathFileNum**)) 
      (setq **XXPathOutputPath** nil) 
      ;(if (dcl_form_isactive path_form1) 
;        (dcl_form_close path_form1) 
      ;) 
    ) 
  ) 
  (princ) 
) 
;;选择轮廓 
(defun Path_Select_Polyline (/ GetPntsPath _SelectPathByPolyline ss) 
  (defun GetPntsPath (bp pts / ptl) 
    (setq ptl (list bp)) 
    (while pts 
      (setq pts        (mapcar        '(lambda (x) 
                           (list (distance (car ptl) x) x) 
                         ) 
                        pts 
                ) 
            pts        (vl-sort pts 
                         (function (lambda (e1 e2) 
                                     (< (car e1) (car e2)) 
                                   ) 
                         ) 
                ) 
            ptl        (cons (cadar pts) ptl) 
            pts        (cdr (mapcar 'cadr pts)) 
      ) 
    ) 
    (reverse ptl) 
  ) 
  (defun _SelectPathByPolyline (e / pl box ss pts ptl bp) 
    (setq box (xdrx_entity_box e) 
          bp  (car box) 
    ) 
    (or 
      (and (setq ss (ssget "_C" 
                           (car box) 
                           (caddr box) 
                           '((0 . "LWPOLYLINE") (8 . "XD-CIRCLE-PATH")) 
                    ) 
           ) 
           (if (> (sslength ss) 1) 
             (progn 
               (princ "\n重复路径!") 
               t 
             ) 
             (setq pl (ssname ss 0)) 
           ) 
      ) 
      (and (setq ss (ssget "_C" 
                           (car box) 
                           (caddr box) 
                           '((0 . "circle")) 
                    ) 
           ) ;_选择整个零件，自动计算Box左下角点 
           (progn 
             (setq 
               pts (XD::Pnts:RemoveDup 
                     (mapcar 
                       '(lambda (x) (xdrx_getpropertyvalue x "Center")) 
                       (xdrx_pickset->ents ss) 
                     ) 
                     1e-3 
                   ) 
               ptl (getpntspath 
                     bp 
                     (vl-remove-if '(lambda (x) (equal bp x 0.001)) pts) 
                   ) 
             ) 
             (xdrx_layer_make "XD-Circle-Path" 1) 
             (setq pl (apply 'xdrx_polyline_make ptl)) 
             (xdrx_setpropertyvalue 
               pl 
               "layer" 
               "XD-Circle-Path" 
             ) 
           ) 
      ) 
    ) 
    pl 
  ) 
 
  (if (and (setq e (car        (xdrx_entsel 
                          "\n点选轮廓线: " 
                          '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)) 
                        ) 
                   ) 
           ) 
           (setq **XXPathOutputPath** (_SelectPathByPolyline e)) 
           (= (xdrx_yesorno "直接输出文件" 1) 1) 
      ) 
    (Path_Output_List) 
    (if        **XXPathOutputPath** 
      (progn 
        (sssetfirst 
          nil 
          (XD::Entity->pickset (list **XXPathOutputPath**)) 
        ) 
        (princ "\n手动调整后，鼠标进入对话框直接输出文件!") 
      ) 
      (princ "\n未找到路径或圆!") 
    ) 
  ) 
) 
;;=========================================================================================; 
;;                        ODCL                                                             ; 
;;=========================================================================================; 
;;参数控件 
(defun ODCL_Path_ParamControl () 
  (list        path_form1_cuttingspeed               path_form1_safeheight 
        path_form1_rotationrate               path_form1_holedepth 
        path_form1_drill 
       ) 
) 
;;获取参数设置 
(defun ODCL_Path_GetParam () 
  (setq        **XXGlobleParam** 
         (cons (dcl_grid_getcellcheckstate path_form1_option1 0 0) 
               (mapcar '(lambda        (x) 
                          (atoi (dcl_control_gettext x)) 
                        ) 
                       (ODCL_Path_ParamControl) 
               ) 
         ) 
  ) 
) 
;;option state 
(defun ODCL_Path_OptionState (mod) 
  (dcl_grid_setcellcheckstate path_form1_option1 0 0 mod) 
  (dcl_grid_setcellcheckstate 
    path_form1_option1 
    0 
    1 
    (abs (1- mod)) 
  ) 
) 
;;检查输入合法性 
;;超过最大值自动设置为最大值，小于最小值时自动设置为最小值 
(defun ODCL_Path_Pamram_CheckInput (str e var) 
  (mapcar '(lambda (x) 
             (if (= (car x) str) 
               (cond 
                 ((> (atoi var) (last x)) 
                  (dcl_control_settext e (last x)) 
                 ) 
                 ((< (atoi var) (cadr x)) 
                  (dcl_control_settext e (cadr x)) 
                 ) 
                 (t) 
               ) 
             ) 
           ) 
          '(("cuttingspeed" 1 500) 
            ("safeheight" 3 100) 
            ("rotationrate" 300 5000) 
            ("holedepth" 1 8) 
            ("drill" 2 150) 
           ) 
  ) 
) 
;;控件提示 
(defun ODCL_Path_Input_Prompt (str e) 
  (mapcar '(lambda (x) 
             (if (= str (car x)) 
               (dcl_control_setcaption path_form1_prompt (cadr x)) 
             ) 
           ) 
          '(("cuttingspeed" "切削速度建议范围 1-300,最大值500") 
            ("safeheight" "安全高度取值范围 3-100") 
            ("rotationrate" "主轴转速取值范围 300-5000") 
            ("holedepth" "单孔深度取值范围 1-8") 
            ("drill" "钻穿深度取值范围 2-150") 
           ) 
  ) 
) 
;;OpenDCL Event 
(mapcar        '(lambda (x) 
           (eval (list 'defun 
                       (read (strcat "c:path_form1_" (car x))) 
                       (cadr x) 
                       '(dcl_form_close path_form1) 
                 ) 
           ) 
         ) 
        '(("OnCacel" nil) 
          ("OnDocActivated" nil) 
          ("OnEnteringNoDocState" nil) 
          ("OnClose" (UpperLeftX UpperLeftY /)) 
         ) 
) 
(mapcar 
  '(lambda (x) 
     (eval (list 'defun 
                 (read (strcat "c:path_form1_" x "_OnMouseMove")) 
                 '(Flags X Y /) 
                 (list 'ODCL_Path_Input_Prompt 
                       x 
                       (read (strcat "path_form1_" x)) 
                 ) 
           ) 
     ) 
     (eval 
       (list 'defun 
             (read (strcat "c:path_form1_" x "_OnEditChanged")) 
             '(NewValue /) 
             (list 'ODCL_Path_Pamram_CheckInput 
                   x 
                   (read (strcat "path_form1_" x)) 
                   'NewValue 
             ) 
       ) 
     ) 
   ) 
  '("cuttingspeed" "safeheight"        "rotationrate" "holedepth" "drill") 
) 
(defun c:path_form1_pick_OnClicked (/ ptl) 
  (Path_Select_Polyline) 
  (princ) 
) 
(defun c:path_form1_dir_OnClicked (/ dir) 
  (if (setq dir        (dcl_SelectFolder 
                  "选择保存目录" 
                  (getvar "DWGPREFIX") 
                  64 
                ) 
      ) 
    (progn 
      (setq **XXPathOutputDir** dir) 
      (dcl_control_settext 
        path_form1_folder 
        (strcat 
          dir 
          (if (= (vl-filename-directory dir) dir) 
            "" 
            "\\" 
          ) 
          (vl-filename-base (dcl_control_Gettext path_form1_folder)) 
          ".nc" 
        ) 
      ) 
    ) 
  ) 
) 
;;MouseEntered 
(defun c:path_Form1_OnMouseEntered (/) 
  ;(dcl_control_setcaption path_form1_prompt " ") 
  (if **XXPathOutputPath** 
    (Path_Output_List) 
  ) 
  (princ) 
) 
;;MouseOff ODCL 
(defun c:path_Form1_OnMouseMovedOff (/) 
  (dcl_control_setcaption path_form1_prompt " ") 
  (setq        **XXGlobleParam**   (ODCL_Path_GetParam) 
        **XXPathOutputDir** (vl-filename-directory 
                              (dcl_control_gettext path_form1_folder) 
                            ) 
  ) 
) 
(defun c:path_Form1_option1_OnSelChanged (Row Column /) 
  (ODCL_Path_OptionState (abs (1- Column))) 
) 
;;ODCL Initialize 
(defun c:path_Form1_OnInitialize () 
  (dcl_grid_addrow path_form1_option1 "\t") 
  (mapcar 
    '(lambda (x) 
       (apply 'dcl_grid_setcelltext (cons path_form1_option1 x)) 
     ) 
    '((0 0 "孔内排屑") (0 1 "孔外排屑")) 
  ) 
  (if **XXGlobleParam** 
    (progn 
      (mapcar '(lambda (x y) 
                 (dcl_control_settext x (itoa y)) 
               ) 
              (ODCL_Path_ParamControl) 
              (cdr **XXGlobleParam**) 
      ) 
      (ODCL_Path_OptionState 
        (car **XXGlobleParam**) 
      ) 
    ) 
  ) 
  (if **XXPathOutputDir** 
    (dcl_control_settext 
      path_form1_folder 
      (strcat (if (= (vl-filename-directory **XXPathOutputDir**) 
                     **XXPathOutputDir** 
                  ) 
                (strcat **XXPathOutputDir** "XDNC-") 
                (strcat **XXPathOutputDir** "\\XDNC-") 
              ) 
              (xd::string:strpad **XXPathFileNum** 3 "0" 0) 
              ".nc" 
      ) 
    ) 
    (dcl_control_settext 
      path_form1_folder 
      (strcat (getvar "DWGPREFIX") 
              "\\XDNC-" 
              (xd::string:strpad **XXPathFileNum** 3 "0" 0) 
              ".NC" 
      ) 
    ) 
  ) 
) 
;;Main Program 
(defun PathOutput_Main (mod / string) 
  (and **XXGlobleParam** 
       (/= (car **XXGlobleParam**) mod) 
       (setq **XXGlobleParam** 
              (cons mod (reverse **XXGlobleParam**)) 
       ) 
  ) 
  (or **XXGlobleParam** 
      (setq **XXGlobleParam** (cons mod '(200 3 500 4 2))) 
  ) 
  (or **XXPathFileNum** 
      (setq **XXPathFileNum** 1) 
  ) 
  (setq        string 
         '("YWt6A4o9AABCYgIfBuKTJScSKitmgNmVV1Mm/9wu+yg0XjTPZZMqbf38OO+Qbks7FUXjrDTJ6iQ3" 
           "IZT9WF7kSBSiYfZxlv11ZMmW5Vg4oQaKv7oj9bQcHHJ/G4KBgTCZ4I0xmTDZyePbshOQigIZh7EM" 
           "gZFFGZBHDSueDH78CahOCrxWivx5fjCbfJovfm20lN5o1N54kVTWuQ5Hij5bhk4i8M+rnvtQcqud" 
           "IVucDIDS+ESym/sQgiHz31DCx9x+J9J7QZjUvgpR+NbyYQ2onlkn0r7F7VMoHFfU22iBlEag8YsE" 
           "j8FxgYIudoca6mTk8Ulq/Yw+eHpRMrTAdfgeeniu7IRxDPx3YDJXjL9TTq2bcM6NCz5tcrwwMmea" 
           "RIQ/wxjqeksYnquvUosdsl/K2rjzDLuwmwhfiL+TBvE8YfIPQGRba07S6kQlx20RVEn8SHiffkoc" 
           "xBvHc51T5ZQlr8G5csKox/gFjpCdSAgcMYUe4lLAZjUxZW5BtF0ayegFhMofm8THJN+uZiUWPIGX" 
           "f+udT4UJN4qJzr4hv7RnYXRE7RT7Uq5QS78wualKhMqEYszziusIhOX6TUMYh/GTCrhhdILvvmF2" 
           "gtGjYDQuZXPJsUSJsm1jsTMgEi8hZY/eyKYICB72lz3jUdzmpVoDdAJG2t2CDrcHcJ+OhdM57VP4" 
           "ihNP+pF2wry+5V1BtDZLsMYNSUWlMFKpt0fGS4Pfr56g1/18cfoEk4f54KjuNgE6nlCvhF18oVnO" 
           "IZ4deKBKoaD4xcoEK6rKIZ5N35kZn7UIsaYxsPTggHfHeFBtm7GnXbmXQ6/X7H8UWDSjUqLKPB7z" 
           "OGmXvxqnSpyKWEWDdp/t/PiRdwW1eujKwqS4qiJLFsQFfdQcd6DD0oWDZqD74Xk+AxTJnXLLrVWk" 
           "36+DJLxR9giiWoQrGpmJbBDITyxuqig/iQz/EWqLAV8O9eOBWp8s3eHnK0bpKP6kGJm02iIBds+m" 
           "2sv0kDhlYVkC0RarYP9leqBTDsMWy2rVsxxqS4/EYUqPVN7mDo9kP6wmDSJh+HjvCr+HEK+6VSzz" 
           "NS3C4gXlaFEzwgRfUyBfkizCyPn3aWsJbNFTHvSpne46nMviHLy6VdFpN62xfJ85hG+HIrQoJxpc" 
           "+anrvPwLPZKDMjWra14r2b7q1B8mJteca+xXK+BkPdjGO1daLZp3X+ckP08fTOujsxFolmfE6tns" 
           "tsrLlTYfJyRBiYDbmzbt3cUfF7QvfCgw4NTmwIyPthUMik5ar9TX7hy8mhYnZWzSeeFcQ7dAAvzD" 
           "NknpvJqOexbIpCwm3Eiw2dkXz8R8oC9bHJMq46yR2TwVWbS/kClfu1QVZtea/f3edJjEJUwtvKAn" 
           "zI7S0Zqh+6YakVP/aSTS8LsneNyuIN2LBxQA7Q7YYp0fG5oz45AMM5OHLEclNjxKVBWq2+4wo2Pq" 
           "gAwWVtMIa6VGPos3FERu8VsxXSB3Un6PHF5k093mFtpu1VYY1VokWLO7XewYleJomupBM0yJWq02" 
           "u6EQe9ew8JOVDlxrnftc6yWsuj50APmsVrTFW3sGsoiw+VoqHHO7Eu1at6f9KpacT9XqKjfFg4KZ" 
           "6BfPGpoKxxpKF+/rpcTFC72q9/lsSKEWKt9RJISs7pNod1QWKo8EeitCsCofhWQrIPyGsGFr3i+d" 
           "ZPQP3Dgr5GT327iviKDoESAP2HidWt54xcw4c0B22i+dTtpuSxa0Cto4C+Rkj914UU56SxATYuOS" 
           "4aJO63SqDkUV7hWUqh5UW/RkFVe492RLFxRa6GSFpIjIgUvuZHVUyc04LC8dY7tGLx0F5GSP3XiR" 
           "lnYUAoiCugbULr2T0q9yWEsWOVdfqlZ7hNN8IAk2FJpwj7dqlT5jAG8BLkYlwL5BJvlhd/myLtPB" 
           "5I//ntvAyQBWb/Q5caalgBq1zcDogygGs31qKOH2BAD3HpG5do+tzgSoCIMYw9119YGnyk0N1eGy" 
           "hpie0+j1iAtSTJcdoxdFlMateJRX/3WZhN1wrUHSCeoTsk/PqWaRI8lWTIvF3osX5WjC1di3ptvH" 
           "tqb3OySqwFGStsn41V5RGlluiHCP87aRat2zlVIQofcgA1e6mAuv1QYRobleCLk/JXkiMU+flf4f" 
           "QD1CvlDjMpX+wemIRP5aK9J9YsnTZ1G8ggE/soFKG8bngaeb7QbRlEIWWSaoLTKmd+jiYEDdpLNB" 
           "/PWdt3ug4ye+7XXybQ4M/405Ded7Qse+UClUIj5FyQ4fvKdbaRvZtrvHewwv6XnYbMGGDECY6gp5" 
           "6paEYdk6HYQ=" 
          ) 
  ) 
  (dcl_project_import string) 
  (dcl_form_show path_form1) 
  (princ) 
) 
(defun c:dacm () 
  (PathOutput_Main 1) 
  (Path_Select_Polyline) 
  (princ) 
) 
(defun c:dbcm () 
  (PathOutput_Main 0) 
  (Path_Select_Polyline) 
  (princ) 
)

ghoust · 发表于 2014-4-8 09:12:34

st788796 发表于 2014-4-7 18:42
MouseEntered 事件中关闭Form会出错，暂时注释掉，测试能用

大师，这次数据不错位了。非常OK，我测试基本能用了。现在只是程序头那里有点不对，这个我现在可以手动修改使用，毕竟只修改几个字符。相对来说比全手写容易太多了。
如果大师能在百忙之中修正更好，非常感谢你一直以来的无私奉献。减轻了我好多工作上的重复性动作。谢谢你。

未命名.JPG

ghoust · 发表于 2014-4-12 08:40:19

st788796 发表于 2014-4-8 10:29
表是固定的，取值位置错位了

大师请看，这是机器在钻孔。输出的钻孔代码稍微修改可以使用了。非常感谢。

ghoust · 发表于 2014-4-12 11:00:51

这是视频，用的G73，不提刀钻孔。钻头直径9mm。钻深25。http://v.youku.com/v_show/id_XNjk3NzI1NDA0.html

Gdlprfcu · 发表于 2014-4-14 12:44:10

ghoust 发表于 2014-4-12 11:00
这是视频，用的G73，不提刀钻孔。钻头直径9mm。钻深25。http://v.youku.com/v_show/id_XNjk3NzI1NDA0.html

好强大，也想自己做一台，请问主轴电机、步进电机等用什么型号？能钻多大的孔？能传一份DIY图纸分享下吗？

ghoust · 发表于 2014-4-15 09:35:34

Gdlprfcu 发表于 2014-4-14 12:44
好强大，也想自己做一台，请问主轴电机、步进电机等用什么型号？能钻多大的孔？能传一份DIY图纸分享下吗 ...

86-150的步进。主轴0.75KW伺服。能钻直径12的孔。兄弟别做啊，累死个人啊。做个机脱层皮啊。不是工厂不实用的。投资还不少呢。图纸都是做一步看一步。最终的实物和当初的设计图有相当的差距啊。我就不发来害兄弟你了。还有，就算有图，也千万别相信啊。一定要自己重新建模，设计一次。等你按图加工出来，有任何问题，那将是多么痛的领悟，，，，

Gdlprfcu · 发表于 2014-4-15 12:00:56

ghoust 发表于 2014-4-15 09:35
86-150的步进。主轴0.75KW伺服。能钻直径12的孔。兄弟别做啊，累死个人啊。做个机脱层皮啊。不是工厂不实 ...

最近在外面接了几十个产品的连续模，现手上只有一台钻床一台磨床和一台铣床，不太够用，兼职做的也没多少时间，我主轴打算用普通的三相电机，皮带手动变速，我想Y轴做成工件移动的，这样龙门的钢性要好点，但工作台的利用率就低了，不知道你现在的结构钢性如何？能用来锣工件的避空吗？你现在做的成本大概花了多少钱？

ghoust · 发表于 2014-4-15 13:46:01

Gdlprfcu 发表于 2014-4-15 12:00
最近在外面接了几十个产品的连续模，现手上只有一台钻床一台磨床和一台铣床，不太够用，兼职做的也没多少 ...

请问兄弟是在哪里啊？

几十个产品的连续模，量还是比较大的。有一个能自动钻孔的，能省出一个人工来。三相电机，皮带变速，你的主轴会变得非常重，非常大。不太好设计，如果你有丰富的机械设计经验应该没问题。这种结构钻弹簧孔有点不现实。固定龙门刚性确实好一些，但工作台移动的，工件的重量就要在负载以内。我现在这个结构钻孔没有问题。也可以用来锣避位，但下刀量要小，在0每刀0.5左右。进给要慢在F200左右。我实验时锣了一个直径40的圆，Cr12的软料，25厚，用了半小时。这台机器成本大概3W左右。

Gdlprfcu · 发表于 2014-4-15 16:04:43

ghoust 发表于 2014-4-15 13:46
请问兄弟是在哪里啊？

几十个产品的连续模，量还是比较大的。有一个能自动钻孔的，能省出一个人工来。 ...

我现在在广东台山市，3W实在太贵了，吃不消，看来还是以后再说了。

woailjl · 发表于 2014-6-26 23:15:45

好帖,学习了.
平时依赖自动编程软件,很想学习手工CAD编程,加深理解.

woailjl · 发表于 2014-6-26 23:16:50

很想得到楼主和大师S的指点:)

woailjl · 发表于 2014-6-26 23:22:46

这里有个问题想请教下:
S大师能不能写个CAD LISP,就是用多段线以最优路径将很多等半径的圆自动连接起来,由使用者指定路径的起点和终点
万分感激!

前生 · 发表于 2014-10-2 00:16:10

ghoust 发表于 2014-4-15 13:46
请问兄弟是在哪里啊？

几十个产品的连续模，量还是比较大的。有一个能自动钻孔的，能省出一个人工来。 ...

3W真心不贵。
12以下的孔钻出来。大孔用摇臂钻加工即可。

账号		自动登录	找回密码
密码			立即注册

[编程申请] 求一个CNC钻孔的程序。谢谢。

点评

点评

点评

点评

点评

点评