一个用于大批量生产的剪板下料程序
作者：cad 提交日期：2009-7-6| 分类: | 访问量：
一个用于大批量生产的剪板下料程序
这是我自编的一个用于大批量生产的剪板下料程序，用Lisp语言编写的，以ActiveX方式实现。计算准确，运行速度超快！
在AutoCAD中加载此Lisp程序，运行此程序的命令为: cutplan
运行界面
CUTPLAN.rar (7 K) 下载次数:85
*
这个程序里面的参数可以自己修改吗？
*
怎么用呀？把那个文件放到什么位置呀？
*
附上源程序代码，共五个文件
第一个文件名：CPdialog.DCL
CP_mainDialog:dialog{
label = "Cutting Plan (Wrote by H.Yu)";
initial_focus = "cp_tn";
: boxed_radio_column { label = "Base Data Input";
: row {
: edit_box {
label = "&Item No.:";
key = "cp_no";
}
: edit_box {
label = "Drawing &Scale:";
key = "cp_sc";
}
}
: row {
: edit_box { label = "&Material:";
key = "cp_mt";
}
: edit_box {
label = "&Thickness:";
key = "cp_tk";
}
}
}
: boxed_radio_column {
label = "Panel Specification";
: row {
: edit_box { label = "&Width:";
key = "cp_pw";
}
: edit_box {
label = "&Length:";
key = "cp_pl";
}
}
}
: boxed_radio_column {
label = "Part Specification";
: row {
: edit_box { label = "Part N&ame:";
key = "cp_tn";
edit_width = 20;
}
: edit_box { label = "&Quantity:";
key = "cp_tq";
edit_width = 3;
}
}
: row {
: edit_box { label = "Part Wi&dth:";
key = "cp_tw";
}
: edit_box {
label = "Part &Height:";
key = "cp_th";
}
}
}
: row {
: spacer { width = 1; }
: button { label = "Accept";
key = "accept";
width = 8;
fixed_width = true;
}
: button { label = "Exit";
is_cancel = true;
key = "Cancel";
width = 8;
fixed_width = true;
}
: spacer { width = 1; }
}
}
*
第二个，文件名：CP-MAIN.lsp
(defun C:CUTPLAN (/ BasePoint CPlData
CP_dialogResults Thickness panelWidth
panelLength Material drawingScale itemNo
partName partWidth partHeight partQuantity
new old
)
(setq itemNo 1
drawingScale
40.0
Thickness 1.2
Material "M.G.S.S."
panelWidth
1219.0
panelLength
2350.0
partName "Part"
partQuantity
1
partWidth 1219.0
partHeight
2350.0
)
(if (equal nil *CPData*)
(setq CP_dialogResults
(list
(cons 5 itemNo)
(cons 20 drawingScale)
(cons 30 Material)
(cons 41 Thickness)
(cons 42 panelWidth)
(cons 43 panelLength)
(cons 50 partName)
(cons 52 partWidth)
(cons 53 partHeight)
(cons 60 partQuantity)
)
)
(setq CP_dialogResults *CPData*)
)
(while (setq CP_dialogResults (cp:getDialogInput CP_dialogResults))
(if (setq CPlData (cp:checkData CP_dialogResults))
(if (setq BasePoint (getpoint "\nInput Base Point:"))
(progn
(setq CPlData (cons (cons 10 BasePoint) CPlData))
(progn
(cp:drawCuttingPlan CPlData)
(setq old (assoc 5 CPlData)
new (cons 5 (1+ (cdr old)))
)
(setq CP_dialogResults (subst new old CPlData))
)
)
(alert "Please input valid point!")
)
(alert "Please input valid data!")
)
)
(princ)
)
*
第三个，文件名：UTILS.lsp
(defun cp:checkData (InputData / panelWidth
panelLength partWidth partHeight
checkResult mediData DataValid
old new
)
(setq panelWidth (cdr (assoc 42 InputData))
panelLength (cdr (assoc 43 InputData))
partWidth (cdr (assoc 52 InputData))
partHeight (cdr (assoc 53 InputData))
)
(if (> panelWidth panelLength)
(progn
(setq mediData panelWidth)
(setq panelWidth panelLength)
(setq panelLength mediData)
)
)
(if (> partWidth partHeight)
(progn
(setq mediData partWidth)
(setq partWidth partHeight)
(setq partHeight mediData)
)
)
(setq DataValid (and (>= panelWidth partWidth)
(>= panelLength partHeight)
)
)
(if DataValid
(progn
(setq checkResult InputData)
(progn
(setq old (assoc 42 checkResult)
new (cons 42 panelWidth)
)
(setq checkResult (subst new old checkResult))
)
(progn
(setq old (assoc 43 checkResult)
new (cons 43 panelLength)
)
(setq checkResult (subst new old checkResult))
)
(progn
(setq old (assoc 52 checkResult)
new (cons 52 partWidth)
)
(setq checkResult (subst new old checkResult))
)
(progn
(setq old (assoc 53 checkResult)
new (cons 53 partHeight)
)
(setq checkResult (subst new old checkResult))
)
)
(setq checkResult nil)
)
checkResult
)
(defun cp:fix (data0 / fixedData)
(if (> data0 (fix data0))
(setq fixedData (rtos data0 2 1))
(setq fixedData (rtos data0 2 0))
)
fixedData
)
*
第四个，文件名：CP-IO.lsp
;;;----------------------------------------------;
;;; 对话框输入函数cp:getDialogInput ;
;;;----------------------------------------------;
(defun cp:getDialogInput (InData / Thickness
panelWidth panelLength Material
drawingScale itemNo partName
partWidth partHeight partQuantity
Result dcl_id dialogloaded
dialogShow UserClick position
)
(setq itemNo (itoa (cdr (assoc 5 InData)))
drawingScale (cp:fix (cdr (assoc 20 InData)))
Thickness (cp:fix (cdr (assoc 41 InData)))
Material (cdr (assoc 30 InData))
panelWidth (cp:fix (cdr (assoc 42 InData)))
panelLength (cp:fix (cdr (assoc 43 InData)))
partName (cdr (assoc 50 InData))
partQuantity (itoa (cdr (assoc 60 InData)))
partWidth (cp:fix (cdr (assoc 52 InData)))
partHeight (cp:fix (cdr (assoc 53 InData)))
dialogloaded
T
dialogShow
T
)
(if (assoc 99 InData)
(setq position (cdr (assoc 99 InData)))
(setq position '(-1 -1))
)
;;加载对话框文件
(if (= -1 (setq dcl_id (load_dialog "CPdialog.dcl")))
(progn
(princ "\nCannot load dialog file")
(setq dialogloaded nil)
)
)
;;加载指定的对话框
(if (and dialogloaded
(not (NEW_DIALOG
"CP_mainDialog"
dcl_id
" "
position
)
)
)
(progn
(princ "\nCannot show dialog CP_maindialog")
(setq dialogShow nil)
)
)
;;初始化缺省的对话值
(if (and dialogloaded dialogShow)
(progn
(set_tile "cp_no" itemNo)
(set_tile "cp_sc" drawingScale)
(set_tile "cp_mt" Material)
(set_tile "cp_tk" Thickness)
(set_tile "cp_pw" panelWidth)
(set_tile "cp_pl" panelLength)
(set_tile "cp_tn" partName)
(set_tile "cp_tq" partQuantity)
(set_tile "cp_tw" partWidth)
(set_tile "cp_th" partHeight)
(action_tile
"Cancel"
"(setq position (done_dialog))(setq UserClick nil)(princ)"
)
(action_tile
"accept"
(strcat
"(progn
(setq itemNo (atoi (get_tile \"cp_no\")))"
"(setq drawingScale (atof (get_tile \"cp_sc\")))"
"(setq Material (get_tile \"cp_mt\"))"
"(setq Thickness (atof (get_tile \"cp_tk\")))"
"(setq panelWidth (atof (get_tile \"cp_pw\")))"
"(setq panelLength (atof (get_tile \"cp_pl\")))"
"(setq partName (get_tile \"cp_tn\"))"
"(setq partQuantity (atoi (get_tile \"cp_tq\")))"
"(setq partWidth (atof (get_tile \"cp_tw\")))"
"(setq partHeight (atof (get_tile \"cp_th\")))"
"(setq position (done_dialog)) (setq UserClick T))")
)
(start_dialog) ;启动对话框
(unload_dialog dcl_id) ;卸载对话框
(if UserClick
(progn
(setq Result (list
(cons 5 itemNo)
(cons 20 drawingScale)
(cons 30 Material)
(cons 41 Thickness)
(cons 42 panelWidth)
(cons 43 panelLength)
(cons 50 partName)
(cons 52 partWidth)
(cons 53 partHeight)
(cons 60 partQuantity)
(cons 99 position)
)
)
)
)
)
)
(if Result
(setq *CPData* Result)
)
Result ;返回结果
)
*
第五个，文件名：CP-DRAW.lsp
;;;--------------------------------------------------;
;;;选择剪板方案，分别调用cp:drawing1和cp:drawing2函数;
;;;并将调用cp:drawing1或cp:drawing2的结果返回给上一层;
;;;--------------------------------------------------;
(defun cp:drawCuttingPlan (CPData / panelWidth
panelLength partWidth partHeight
Quantity1 Quantity2 LQuantity
WQuantity mediData Result
)
(setq
panelWidth (cdr (assoc 42 CPData))
panelLength (cdr (assoc 43 CPData))
partWidth (cdr (assoc 52 CPData))
partHeight (cdr (assoc 53 CPData))
)
(setq LQuantity (fix (/ panelLength partHeight))
Quantity1 (+
(* (fix (/ panelWidth partWidth)) LQuantity)
(* (fix (/ (- panelLength (* LQuantity partHeight))
partWidth
)
)
(fix (/ panelWidth partHeight))
)
)
)
(setq WQuantity (fix (/ panelWidth partHeight))
Quantity2 (+
(* (fix (/ panelLength partWidth)) WQuantity)
(* (fix
(/ (- panelWidth (* WQuantity partHeight))
partWidth
)
)
(fix (/ panelLength partHeight))
)
)
)
(setq mediData CPData)
(if (>= Quantity1 Quantity2)
(progn
(setq mediData (cons (cons 77 Quantity1) mediData))
(cp:drawingText mediData)
(setq Result (cp:drawing1 mediData))
)
(progn
(setq mediData (cons (cons 77 Quantity2) mediData))
(cp:drawingText mediData)
(setq Result (cp:drawing2 mediData))
)
)
Result
)
(defun cp:drawing1 (LineData / BasePoint
P1 P2 drawingScale
NumberOfRows NumberOfColumns
NRows NColumns panelWidth
panelLength partWidth partHeight
CuttingLine
)
(setq drawingScale (cdr (assoc 20 LineData))
panelWidth (/ (cdr (assoc 42 LineData)) drawingScale)
panelLength (/ (cdr (assoc 43 LineData)) drawingScale)
partWidth (/ (cdr (assoc 52 LineData)) drawingScale)
partHeight (/ (cdr (assoc 53 LineData)) drawingScale)
BasePoint (cdr (assoc 10 LineData))
BasePoint (polar BasePoint 0.0 (/ (* 6.0 40) drawingScale))
BasePoint (polar BasePoint (/ pi 2.0) (/ (* 6.0 40) drawingScale))
NumberOfRows (fix (/ panelWidth partWidth))
NumberOfColumns (fix (/ panelLength partHeight))
NRows (fix (/ panelWidth partHeight))
NColumns (fix (/ (- panelLength (* partHeight NumberOfColumns))
partWidth
)
)
)
;;输出panel外框
(setq P1 BasePoint
P2 (polar P1 0.0 panelWidth)
)
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq P1 (polar P2 (/ pi 2) panelLength))
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq P2 (polar P1 pi panelWidth))
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq p1 BasePoint)
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
;;输出cutting Plan 的第一组纵线
(setq P1 (polar P2 0.0 partWidth)
P2 (polar P1 (/ pi -2.0) (* partHeight NumberOfColumns))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NumberOfRows 1)
(vla-ArrayRectangular
CuttingLine 1 NumberOfRows 1 0.0 partWidth 0.0)
)
;;输出cutting Plan 的第一组横线
(setq P1 (polar BasePoint (/ pi 2.0) (- panelLength partHeight))
P2 (polar P1 0.0 (* partWidth NumberOfRows))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NumberOfColumns 1)
(vla-ArrayRectangular
CuttingLine
NumberOfColumns
1
1
(- partHeight)
0.0
0.0
)
)
;;输出cutting Plan 的第二组纵线
(if (and (> NColumns 0) (> NRows 0))
(progn
(setq
BasePoint
(polar BasePoint
(/ pi 2.0)
(- panelLength (* partHeight NumberOfColumns))
)
)
(if (> (* partHeight NRows) (* partWidth NumberOfRows))
(progn
(setq P1 (polar BasePoint 0.0 (* partWidth NumberOfRows))
P2 (polar BasePoint 0.0 (* partHeight NRows))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
)
)
(setq P1 (polar BasePoint 0.0 partHeight)
P2 (polar P1 (/ pi -2.0) (* partWidth NColumns))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NRows 1)
(vla-ArrayRectangular
CuttingLine 1 NRows 1 0.0 partHeight 0.0)
)
;;输出cutting Plan 的第二组横线
(setq P1 (polar BasePoint (/ pi -2.0) partWidth)
P2 (polar P1 0.0 (* partHeight NRows))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NColumns 1)
(vla-ArrayRectangular
CuttingLine
NColumns
1
1
(- partWidth)
0.0
0.0
)
)
)
)
(vla-update CuttingLine)
T
)
(defun cp:drawing2 (LineData / BasePoint
P1 P2 drawingScale
NumberOfRows NumberOfColumns
NRows NColumns panelWidth
panelLength partWidth partHeight
CuttingLine
)
(setq drawingScale (cdr (assoc 20 LineData))
panelWidth (/ (cdr (assoc 42 LineData)) drawingScale)
panelLength (/ (cdr (assoc 43 LineData)) drawingScale)
partWidth (/ (cdr (assoc 52 LineData)) drawingScale)
partHeight (/ (cdr (assoc 53 LineData)) drawingScale)
BasePoint (cdr (assoc 10 LineData))
BasePoint (polar BasePoint 0.0 (/ (* 6.0 40) drawingScale))
BasePoint (polar BasePoint (/ pi 2.0) (/ (* 6.0 40) drawingScale))
NumberOfRows (fix (/ panelWidth partHeight))
NumberOfColumns (fix (/ panelLength partWidth))
NRows (fix
(/ (- panelWidth (* partHeight NumberOfRows)) partWidth)
)
NColumns (fix (/ panelLength partHeight))
)
;;输出panel外框
(setq P1 BasePoint
P2 (polar P1 0.0 panelWidth)
)
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq P1 (polar P2 (/ pi 2) panelLength))
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq P2 (polar P1 pi panelWidth))
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
(setq p1 BasePoint)
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
;;输出cutting Plan 的第一组纵线
(setq P1 (polar P2 0.0 partHeight)
P2 (polar P1 (/ pi -2.0) (* partWidth NumberOfColumns))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NumberOfRows 1)
(vla-ArrayRectangular
CuttingLine 1 NumberOfRows 1 0.0 partHeight 0.0)
)
;;输出cutting Plan 的第一组横线
(setq P1 (polar BasePoint (/ pi 2.0) (- panelLength partWidth))
P2 (polar P1 0.0 (* partHeight NumberOfRows))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NumberOfColumns 1)
(vla-ArrayRectangular
CuttingLine
NumberOfColumns
1
1
(- partWidth)
0.0
0.0
)
)
;;输出cutting Plan 的第二组纵线
(if (and (> NColumns 0) (> NRows 0))
(progn
(setq BasePoint (polar BasePoint (/ pi 2.0) panelLength)
BasePoint (polar BasePoint 0.0 (* partHeight NumberOfRows))
)
(if (> (* partHeight NColumns) (* partWidth NumberOfColumns))
(progn
(setq P1 (polar BasePoint (/ pi -2.0) (* partWidth NumberOfColumns))
P2 (polar BasePoint (/ pi -2.0) (* partHeight NColumns))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
)
)
(setq P1 (polar BasePoint 0.0 partWidth)
P2 (polar P1 (/ pi -2.0) (* partHeight NColumns))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NRows 1)
(vla-ArrayRectangular
CuttingLine 1 NRows 1 0.0 partWidth 0.0)
)
;;输出cutting Plan 的第二组横线
(setq P1 (polar BasePoint (/ pi -2.0) partHeight)
P2 (polar P1 0.0 (* partWidth NRows))
)
(setq CuttingLine
(vla-addline
*ModelSpace*
(vlax-3d-point P1)
(vlax-3d-point P2)
)
)
(if (> NColumns 1)
(vla-ArrayRectangular
CuttingLine
NColumns
1
1
(- partHeight)
0.0
0.0
)
)
)
)
(vla-update CuttingLine)
T
)
;;;----------------------------------------;
;;; 输出文字 ;
;;;----------------------------------------;
(defun cp:drawingText (Data / BasePoint
Radius Quantity itemNo
drawingScale outputText PCSperSHT
PCSperBOX textHeight partQuantity
panelWidth panelLength partWidth
partHeight panelText itemText
)
(setq panelWidth (cdr (assoc 42 Data))
panelLength (cdr (assoc 43 Data))
partWidth (cdr (assoc 52 Data))
partHeight (cdr (assoc 53 Data))
Quantity (cdr (assoc 77 Data))
partQuantity (cdr (assoc 60 Data))
drawingScale (cdr (assoc 20 Data))
textHeight (/ (* 2.5 40) drawingScale)
)
(setq outputText (itoa (cdr (assoc 5 Data)))
BasePoint (cdr (assoc 10 Data))
)
(setq itemText
(vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
)
)
(vla-put-Alignment itemText acAlignmentMiddle)
(vla-put-TextAlignmentPoint
itemText
(vlax-3d-point BasePoint)
)
(vla-update itemText) ;输出item No.
(setq Radius (/ (* 3.25 40) drawingScale))
(vla-addcircle
*ModelSpace*
(vlax-3d-point BasePoint)
Radius
) ;绘制园
(setq BasePoint (polar BasePoint 0.0 (/ (* 6.0 40) drawingScale))
outputText (cdr (assoc 50 Data))
)
(vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
) ;输出part name
(setq BasePoint (polar BasePoint (/ pi -2.0) (/ (* 5.0 40) drawingScale))
outputText (strcat (rtos (cdr (assoc 41 Data)) 2 1)
"t x "
(cp:fix partWidth)
" x "
(cp:fix partHeight)
)
)
(vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
) ;输出part size
(if (> Quantity 1)
(setq PCSperSHT " PCS/SHT, ")
(setq PCSperSHT " PC/SHT, ")
)
(if (> partQuantity 1)
(setq PCSperBOX " PCS/BOX")
(setq PCSperBOX " PC/BOX")
)
(setq BasePoint (polar BasePoint (/ pi -2.0) (/ (* 5.0 40) drawingScale))
outputText (strcat (itoa Quantity)
PCSperSHT
(itoa partQuantity)
PCSperBOX
)
)
(vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
) ;输出PCS/SHT, PCS/BOX
(setq BasePoint (polar BasePoint (/ pi -2.0) (/ (* 5.0 40) drawingScale))
outputText (strcat "%%u"
(itoa partQuantity)
"/"
(itoa Quantity)
" SHT/BOX"
)
)
(vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
) ;输出SHT/BOX
(setq BasePoint (polar BasePoint
(/ pi 2.0)
(+ (/ (* 31.0 40) drawingScale) (/ panelLength drawingScale))
)
BasePoint (polar BasePoint 0.0 (/ panelWidth 2 drawingScale))
outputText (strcat "%%u"
(rtos (cdr (assoc 41 data)) 2 1)
"t x "
(cp:fix panelWidth)
" x "
(cp:fix panelLength)
" ("
(cdr (assoc 30 data))
")"
)
)
(setq panelText (vla-addtext
*ModelSpace*
outputText
(vlax-3d-point BasePoint)
textHeight
)
) ;输出panel规格
(vla-put-scalefactor panelText 0.8) ;更改文字度
(vla-put-Alignment panelText acAlignmentMiddle)
(vla-put-TextAlignmentPoint
panelText
(vlax-3d-point BasePoint)
)
(vla-update panelText)
T
)
*
不好意思，UTILS.lsp程序的开头少了几句代码，如下：
(vl-load-com)
(setq *ModelSpace*
(vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-Acad-Object))
)
)
*
不能输入汉字啊？怎么？
*
描述：图
图片：
参考下面代码，举一反三，改成喜欢的字好了。
第一个文件中的：
label = "剪板程序 (Wrote by H.Yu)";
initial_focus = "cp_tn";
: boxed_radio_column { label = "基本数据";
: row {
: edit_box {
label = "序号:";
key = "cp_no";
}
第五个文件CP-DRAW.lsp中的：
(if (> Quantity 1)
(setq PCSperSHT " 件/张, ")
(setq PCSperSHT " 件/张, ")
)
(if (> partQuantity 1)
(setq PCSperBOX " 件/台")
(setq PCSperBOX " 件/台")
)
编译的时候，用专家模式，utils放在第一位，其次CP_IO,再次CP_DRAW,最后是CP_MAIN
CPdialog文件是对话框文件
*
楼主,真是太好了.可是我不懂lisp语言,不知道怎么用
*
我就想要一个lisp,用CAD1:1画好若干零件后,能自动排进我指定的方框,而且零件与零件间不相互干涉,可以设置零件间距,以及到框边的距离.
*
下载看看 
*本文摘自：http://www.jxcad.com.cn/read.php?tid=227241
