[新手源码指导]建库程序，以轴承为例

wwwbxd · 发表于 2012-5-1 21:25:31

wwwbxd 发表于 2012-4-27 21:12
常用的还用作用lisp程序吗事先画好了做成块用的时候一粘贴多省事

还是想不太清楚可能自己想的东西太少和楼主及各位大侠多学点

xyp1964 · 发表于 2012-5-1 22:01:59

参考对话框：

(setq ll1 '(po1 po2 po3 bo1)
ll2 '("0" "0" "0""0")
)
(defun ajbcs () (xyp-Multiple-Settile ll1 ll2))
(xyp-initSet ll1 ll2)
(setq lst1 '("22" "20" "25" "28" "30" "32" "35" "40" "45" "50" "55" "60" "65" "70")
lst2 '("44" "47" "52" "55" "58" "62" "68" "75" "80" "90" "955" "100" "110")
lst3 '("15" "16" "17" "18" "19" "20" "23" "25")
ilst '(":row{"
("k0" "" "imagebutton" "-2" "48" "gundongzhoucheng01" "(XYP-ABOUTME)")
("" "参数" ":boxed_column{")
("po1" "内径(d)" "poplist" "lst1" "6")
("po2" "外径(D)" "poplist" "lst2" "6")
("po3" "宽度(B)" "poplist" "lst3" "6")
("bo1" "标尺寸" "bool" )
"spacer;"
("jbcs" "缺省参数" "button1" "(ajbcs)")
"spacer;"
"}"
"}"
"spacer;"
"ioc"
)
)
(if (= (xyp-Dcl-Init Ilst "【滚动轴承 GB/T 276-94 】" t) 1)
(main-pro)
)

(setq ll1 '(po1 po2 po3 bo1) 
 ll2 '("0" "0" "0""0") 
  ) 
  (defun ajbcs () (xyp-Multiple-Settile ll1 ll2)) 
  (xyp-initSet ll1 ll2) 
  (setq lst1 '("22" "20" "25" "28" "30" "32" "35" "40" "45" "50" "55" "60" "65" "70") 
 lst2 '("44" "47" "52" "55" "58" "62" "68" "75" "80" "90" "955" "100" "110") 
 lst3 '("15" "16" "17" "18" "19" "20" "23" "25") 
 ilst '(":row{" 
        ("k0" "" "imagebutton" "-2" "48" "gundongzhoucheng01" "(XYP-ABOUTME)") 
        ("" "参数" ":boxed_column{") 
        ("po1" "内径(d)" "poplist" "lst1" "6") 
        ("po2" "外径(D)" "poplist" "lst2" "6") 
        ("po3" "宽度(B)" "poplist" "lst3" "6") 
        ("bo1" "标尺寸" "bool" ) 
        "spacer;" 
        ("jbcs" "缺省参数" "button1" "(ajbcs)") 
        "spacer;" 
        "}" 
        "}" 
        "spacer;" 
        "ioc" 
       ) 
  ) 
  (if (= (xyp-Dcl-Init Ilst "【滚动轴承 GB/T 276-94 】" t) 1) 
    (main-pro) 
  )

村夫 · 发表于 2012-5-1 23:29:08

xyp1964的对话框中参数选取时：1）如果能连锁，则更方便运用；2）另外，有时要设计定制非标轴承，也能添加扩展数据的话，那就太好了。

xyp1964 · 发表于 2012-5-2 00:12:48

村夫发表于 2012-5-1 23:29
xyp1964的对话框中参数选取时：1）如果能连锁，则更方便运用；2）另外，有时要设计定制非标轴承，也能添加扩 ...

滚动轴承：

功夫佬 · 发表于 2012-5-2 00:39:53

厉害，学习，谢谢

cabinsummer · 发表于 2012-5-2 07:42:34

本帖最后由 cabinsummer 于 2012-5-2 07:44 编辑

xyp1964 发表于 2012-5-1 22:01
参考对话框：

院长的程序是不能看内容的，只能看界面。全部是伪代码。建议练习者按照院长的界面写出源程序。

timmy521 · 发表于 2012-5-2 13:22:09

这里面能人很多啊。哈哈。

snddd2000 · 发表于 2012-5-2 14:40:54

本帖最后由 snddd2000 于 2012-5-3 08:57 编辑

更新内容
添加简单的轴承绘图部分（不带剖面线和圆角）替换原来的一个圆。
增加判断块名是否存在，如存在则不再创建直接插入块。
将数据表另存为txt文件，测试时需更改lsp文件里面的目录

dcl文件没有什么变动，添加的按钮<添加新规格...>目前点击无效。

(defun c:q1 ()
;;;风的画图通用函数
(defun DefBlock (BlockName) ;_定义有名块
(entmake (list '(0 . "BLOCK") '(10 0.0 0.0 0.0) '(70 . 0) (cons 2 BlockName)))
);_ (setq blockname (entmake '((0 . "ENDBLK"))));_与此句配对使用且不可嵌套。
(defun RefBlock (BlockName PNT) ;_插入块返回图元名
(entmakex (list '(0 . "INSERT") (cons 2 BlockName) (cons 10 PNT)))
)
(defun CheckBlockName (BlockName)
(setq re nil)
(setq BlockList (tblnext "block" T))
(while BlockList
(if (eq BlockName (cdr (assoc 2 BlockList)))
(setq re T)
)
(setq BlockList (tblnext "block"))
(if re (setq BlockList nil))
)
re
)
;;;画图函数
(defun DrawingBearing (BearingDataList index1 index2)
;;;;;;;_起始模拟捕捉图元，
(setq r1 (/ (getvar "viewsize") 500))
(setq r1 (* (read (getenv "AutoSnapSize")) r1))
(setq pt1 '(0 0))
(setq lst1 '()
setp0 (/ pi 10)
)
(repeat 5
(setq lst1 (cons (polar pt1 setp0 r1) lst1))
(setq setp0 (+ setp0 (/ (* 2 pi) 5)))
)
(setq entlist00 (entmake
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length lst1))
(cons 70 1)
(cons 62 (read (getenv "AutoSnapColor")))
(cons 43 (/ r1 5))
)
(mapcar '(lambda (p) (cons 10 p)) lst1)
)
)
)
(setq ent00 (entlast)
pd t
)
(entdel ent00)
(setq pd00 nil) ;_起始模拟捕捉图元，先挂起；标记pd00为nil则不显示
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq List2Data (cdr (nth (atoi index1) BearingDataList)))
(setq List3Data (cadr (nth (atoi index2) List2Data)))
(setq BlockName (strcat "mjtd_" (car (nth (atoi index1) BearingDataList)) "_" (car (nth (atoi index2) List2Data))));_块名
(setq dInside (nth 0 List3Data)) ;_内径
(setq DOutside (nth 1 List3Data)) ;_外径
(setq BWidth (nth 2 List3Data)) ;_轴向厚度
(setq AWidth (/ (- DOutside dInside) 2.0));_径向厚度
(setq 2cirRa (/ AWidth 4.0));_两个小圆弹珠的半径
(setq 4PointList (list (list (- 0 (/ DOutside 2.0)) 0 0)
(list (- 0 (/ DOutside 2.0)) BWidth 0)
(list (/ DOutside 2.0) BWidth 0)
(list (/ DOutside 2.0) 0 0)
));_外围四点表
(setq mm (grread t 15 0))
(setq pt0 (cadr mm))
;;;判断块名是否已存在
(if (null (CheckBlockName BlockName))
(progn
;;;块定义头
(DefBlock BlockName)
;;;块定义图形
(setq cir1 (entmakex (list (cons 0 "CIRCLE")
(cons 10 (setq cir1cent (list (/ (- DOutside AWidth) 2.0) (/ BWidth 2.0) 0)))
(cons 40 2cirRa))))
(setq cir2 (entmakex (list (cons 0 "CIRCLE")
(cons 10 (setq cir2cent (list (/ (- AWidth DOutside) 2.0) (/ BWidth 2.0) 0)))
(cons 40 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (+ (/ dInside 2.0) (* 0.375 AWidth)) 0.0 0.0))
(cons 11 (polar cir1cent (* pi (/ 240 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (+ (/ dInside 2.0) (* 0.625 AWidth)) 0.0 0.0))
(cons 11 (polar cir1cent (* pi (/ 300 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (+ (/ dInside 2.0) (* 0.375 AWidth)) BWidth 0.0))
(cons 11 (polar cir1cent (* pi (/ 120 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (+ (/ dInside 2.0) (* 0.625 AWidth)) BWidth 0.0))
(cons 11 (polar cir1cent (* pi (/ 60 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.375 AWidth))) 0.0 0.0))
(cons 11 (polar cir2cent (* pi (/ 300 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.625 AWidth))) 0.0 0.0))
(cons 11 (polar cir2cent (* pi (/ 240 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.375 AWidth))) BWidth 0.0))
(cons 11 (polar cir2cent (* pi (/ 60 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.625 AWidth))) BWidth 0.0))
(cons 11 (polar cir2cent (* pi (/ 120 180.0)) 2cirRa))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (/ dInside 2.0) 0.0 0.0))
(cons 11 (list (/ dInside 2.0) BWidth 0.0))))
(entmakex (list '(0 . "LINE")
(cons 10 (list (- 0 (/ dInside 2.0)) 0.0 0.0))
(cons 11 (list (- 0 (/ dInside 2.0)) BWidth 0.0))))
(entmakex (append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length 4PointList))
(cons 70 1)
)
(mapcar '(lambda (p) (cons 10 p)) 4PointList)
)
)
;;;块定义尾
(setq BlockName (entmake '((0 . "ENDBLK"))))
;;;块定义结束
));_end if 已有同名块则不创建块
;;;插入块
(RefBlock BlockName pt0)
(setq ent1 (entlast)
ent1list (entget ent1)
pd T)
(while pd
(setq mm (grread t 15 0))
(setq pdMode (car mm))
(cond
((= 5 pdMode)
(progn
(setq pt0 (cadr mm))
(entdel ent1)
(if pd00
(progn (entdel ent00)
(setq pd00 nil)
)
)
(setq pt1 (osnap pt0 "_EXT,_end,_int"))
(entdel ent1)
(if pt1
(setq pt0 pt1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if pt1
(progn
(setq r1 (/ (getvar "viewsize") 500))
(setq r1 (* (read (getenv "AutoSnapSize")) r1))
(setq lst1 '()
setp0 (/ pi 10)
)
(if (null pd00)
(progn (entdel ent00)
(setq pd00 t) ;_捕捉图元，显示,标记pd00为t则显示
)
) ;_end if
(setq entlist00 (entget ent00))
(setq entlist00
(mapcar
'(lambda (e)
(cond
((= 10 (car e))
(progn
(setq e (cons 10 (polar pt1 setp0 r1)))
(setq setp0 (+ setp0 (/ (* 2 pi) 5)))
(setq e e)
) ;_end progn
)
((= 43 (car e)) (setq e (cons 43 (/ r1 5))))
(t (setq e e))
) ;_end cond
) ;_end lambda
entlist00
) ;_end mapcar
) ;_end setq entlist00
(entmod entlist00)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq ent1list (subst (cons 10 pt0) (assoc 10 ent1list) ent1list))
(entmod ent1list)
(setq pd T)
))
((= 3 pdMode)
(progn (setq pd nil)
(print (car mm))
(if pd00
(progn (entdel ent00)
(setq pd00 nil)
)
)
)) ;_左键确认
((= 25 pdMode) (progn (entdel ent1) (setq pd nil))) ;_右键取消
)
)
)
;;;定义局域函数
(defun BearingDataListToList2Data (BearingDataList index)
(setq List2Data (cdr (nth (atoi index) BearingDataList)))
(setq List2Data (mapcar '(lambda (x)
(car x)
)
List2Data
))
List2Data
)
(defun BearingDataListToList3Data (BearingDataList index1 index2)
(setq List2Data (cdr (nth (atoi index1) BearingDataList)))
(setq List3Data (cadr (nth (atoi index2) List2Data)))
(setq DimzinOld (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq List3Data (mapcar '(lambda (x)
(rtos x 2 4)
)
List3Data
))
(setvar "DIMZIN" DimzinOld)
(setq n -1)
(setq List3Data (mapcar '(lambda (x)
(setq n (1+ n))
(strcat (nth n BearingKeyUnit) x)
)
List3Data
))
List3Data
)
(defun InputNewDataToList (lst key mode) ;_list str str
(start_list key (atoi mode))
(mapcar 'add_list lst)
(end_list)
)
;;;
(setq BearingKeyUnit (list "d(mm) ="
"D(mm) ="
"B(mm) ="
"da(mm) ="
"Da(mm) ="
"ra(mm) ="
"d2(mm) ="
"D2(mm) ="
"r(mm) ="
"Cr(KN) ="
"C0r(KN) ="
"脂(r.min-1) ="
"油(r.min-1) ="
"W(Kg) ="))
;;;;;; (setq BearingDataList ;_d/mm,D/mm,B/mm,da/mm,Da/mm,ra/mm,d2/mm,D2/mm,r/mm,Cr/KN,C0r/KN,脂/r.min-1,油/r.min-1,W/Kg.
;;;;;; (list
;;;;;; (list
;;;;;; "60000"
;;;;;; (list "613"
;;;;;; (list 3 8 3 4.2 6.8 0.15 4.5 6.5 0.15 0.45 0.15 38000 48000 0.0008))
;;;;;; (list "623"
;;;;;; (list 3 10 4 4.2 8.8 0.15 5.2 8.1 0.15 0.65 0.22 38000 48000 0.002))
;;;;;; ;_添加60000型规格....
;;;;;; )
;;;;;; (list
;;;;;; "60000-Z"
;;;;;; (list "613-Z"
;;;;;; (list 3 8 3 4.2 6.8 0.15 4.5 6.8 0.15 0.45 0.15 38000 48000 0.0008))
;;;;;; (list "623-Z"
;;;;;; (list 3 10 4 4.2 8.8 0.15 5.2 8.3 0.15 0.65 0.22 38000 48000 0.002))
;;;;;; ;_添加60000-Z型规格....
;;;;;; )
;;;;;; ;_添加其他型及其规格....
;;;;;; )
;;;;;; )
(setq BearingData (open "I:\\BearingData.txt" "r"))
(setq BearingDataList (read (read-line BearingData)))
(close BearingData)
;;;--- Load the dcl file
(setq dcl_id (load_dialog "BEARING.dcl"))
;;;--- Load the dialog definition if it is not already loaded
(if (not (new_dialog "BEARING" dcl_id))
(progn
(alert "The BEARING.DCL file could not be loaded!")
(exit)
)
)
;;;--- load data to list1
(setq List1Data (mapcar '(lambda (x)
(car x)
)
BearingDataList
))
(start_list "list1" 3)
(mapcar 'add_list List1Data)
(end_list)
;;;--- load data to list2---test!!!
;;; (setq List2Data (mapcar '(lambda (x)
;;; (cadr x)
;;; )
;;; BearingDataList
;;; ))
;;; (setq List2Data (mapcar '(lambda (x)
;;; (car x)
;;; )
;;; List2Data
;;; ))
;;; (start_list "list2" 3)
;;; (mapcar 'add_list List2Data)
;;; (end_list)
;;;--- If an action event occurs, do this function
(action_tile "accept" "(setq ddiag 2)(done_dialog)")
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
(action_tile "list1" (strcat
"(InputNewDataToList (BearingDataListToList2Data BearingDataList (get_tile \"list1\")) \"list2\" \"3\")"
"(InputNewDataToList (list) \"list3\" \"3\")"
"(setq Index1 (get_tile \"list1\"))(setq Index2 nil)"
))
(action_tile "list2" (strcat
"(InputNewDataToList (BearingDataListToList3Data BearingDataList (get_tile \"list1\") (get_tile \"list2\")) \"list3\" \"3\")"
"(setq Index2 (get_tile \"list2\"))"
))
;;;--- Display the dialog box
(start_dialog)
;;;--- Unload the dialog box
;;; (unload_dialog dcl_id)
;;;--- If the user pressed the Cancel button
(if (= ddiag 1)
(princ "\n Sample3 cancelled!")
)
;;;--- If the user pressed the Okay button
(if (= ddiag 2)
(progn
(if (and Index1 Index2)
(DrawingBearing BearingDataList Index1 Index2)
(progn (alert "没有选择规格，需重新选择！") (c:q1))
)
(princ "\n The user pressed Okay!")
)
)
)

(defun c:q1  () 
;;;风的画图通用函数 
(defun DefBlock         (BlockName) ;_定义有名块 
  (entmake (list '(0 . "BLOCK") '(10 0.0 0.0 0.0) '(70 . 0) (cons 2 BlockName))) 
  );_ (setq blockname (entmake '((0 . "ENDBLK"))));_与此句配对使用且不可嵌套。 
(defun RefBlock         (BlockName PNT) ;_插入块返回图元名 
  (entmakex (list '(0 . "INSERT") (cons 2 BlockName) (cons 10 PNT))) 
  ) 
 
(defun CheckBlockName (BlockName) 
  (setq        re nil) 
  (setq BlockList (tblnext "block" T)) 
  (while BlockList 
    (if        (eq BlockName (cdr (assoc 2 BlockList))) 
      (setq re T) 
      ) 
    (setq BlockList (tblnext "block")) 
    (if re (setq BlockList nil)) 
    ) 
  re 
  ) 
 
   
;;;画图函数 
(defun DrawingBearing  (BearingDataList index1 index2) 
;;;;;;;_起始模拟捕捉图元， 
  (setq r1 (/ (getvar "viewsize") 500)) 
  (setq r1 (* (read (getenv "AutoSnapSize")) r1)) 
  (setq pt1 '(0 0)) 
  (setq        lst1  '() 
        setp0 (/ pi 10) 
        ) 
  (repeat 5 
    (setq lst1 (cons (polar pt1 setp0 r1) lst1)) 
    (setq setp0 (+ setp0 (/ (* 2 pi) 5))) 
    ) 
  (setq        entlist00 (entmake 
                    (append 
                      (list 
                        (cons 0 "LWPOLYLINE") 
                        (cons 100 "AcDbEntity") 
                        (cons 100 "AcDbPolyline") 
                        (cons 90 (length lst1)) 
                        (cons 70 1) 
                        (cons 62 (read (getenv "AutoSnapColor"))) 
                        (cons 43 (/ r1 5)) 
                        ) 
                      (mapcar '(lambda (p) (cons 10 p)) lst1) 
                      ) 
                    ) 
        ) 
  (setq        ent00 (entlast) 
        pd    t 
        ) 
  (entdel ent00) 
  (setq pd00 nil) ;_起始模拟捕捉图元，先挂起；标记pd00为nil则不显示 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (setq List2Data (cdr (nth (atoi index1) BearingDataList))) 
  (setq List3Data (cadr (nth (atoi index2) List2Data))) 
  (setq BlockName (strcat "mjtd_" (car (nth (atoi index1) BearingDataList)) "_" (car (nth (atoi index2) List2Data))));_块名 
  (setq dInside (nth 0 List3Data)) ;_内径 
  (setq DOutside (nth 1 List3Data)) ;_外径 
  (setq BWidth (nth 2 List3Data)) ;_轴向厚度 
  (setq AWidth (/ (- DOutside dInside) 2.0));_径向厚度 
  (setq 2cirRa (/ AWidth 4.0));_两个小圆弹珠的半径 
  (setq 4PointList (list (list (- 0 (/ DOutside 2.0)) 0 0) 
                         (list (- 0 (/ DOutside 2.0)) BWidth 0) 
                         (list (/ DOutside 2.0) BWidth 0) 
                         (list (/ DOutside 2.0) 0 0) 
                         ));_外围四点表 
  (setq mm (grread t 15 0)) 
  (setq pt0 (cadr mm)) 
;;;判断块名是否已存在 
(if (null  (CheckBlockName BlockName)) 
  (progn 
;;;块定义头 
  (DefBlock BlockName) 
;;;块定义图形 
(setq cir1 (entmakex (list (cons 0 "CIRCLE") 
                           (cons 10 (setq cir1cent (list (/ (- DOutside AWidth) 2.0) (/ BWidth 2.0) 0))) 
                           (cons 40 2cirRa)))) 
(setq cir2 (entmakex (list (cons 0 "CIRCLE") 
                           (cons 10 (setq cir2cent (list (/ (- AWidth DOutside) 2.0) (/ BWidth 2.0) 0))) 
                           (cons 40 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (+ (/ dInside 2.0) (* 0.375 AWidth)) 0.0 0.0)) 
                (cons 11 (polar cir1cent (* pi (/ 240 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (+ (/ dInside 2.0) (* 0.625 AWidth)) 0.0 0.0)) 
                (cons 11 (polar cir1cent (* pi (/ 300 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (+ (/ dInside 2.0) (* 0.375 AWidth)) BWidth 0.0)) 
                (cons 11 (polar cir1cent (* pi (/ 120 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (+ (/ dInside 2.0) (* 0.625 AWidth)) BWidth 0.0)) 
                (cons 11 (polar cir1cent (* pi (/ 60 180.0)) 2cirRa)))) 
 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.375 AWidth))) 0.0 0.0)) 
                (cons 11 (polar cir2cent (* pi (/ 300 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.625 AWidth))) 0.0 0.0)) 
                (cons 11 (polar cir2cent (* pi (/ 240 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.375 AWidth))) BWidth 0.0)) 
                (cons 11 (polar cir2cent (* pi (/ 60 180.0)) 2cirRa)))) 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (- 0 (+ (/ dInside 2.0) (* 0.625 AWidth))) BWidth 0.0)) 
                (cons 11 (polar cir2cent (* pi (/ 120 180.0)) 2cirRa)))) 
 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (/ dInside 2.0) 0.0 0.0)) 
                (cons 11 (list (/ dInside 2.0) BWidth 0.0)))) 
 
(entmakex (list        '(0 . "LINE") 
                (cons 10 (list (- 0 (/ dInside 2.0)) 0.0 0.0)) 
                (cons 11 (list (- 0 (/ dInside 2.0)) BWidth 0.0)))) 
 
   
(entmakex (append 
            (list 
              (cons 0 "LWPOLYLINE") 
              (cons 100 "AcDbEntity") 
              (cons 100 "AcDbPolyline") 
              (cons 90 (length 4PointList)) 
              (cons 70 1) 
              ) 
            (mapcar '(lambda (p) (cons 10 p)) 4PointList) 
            ) 
          ) 
 
;;;块定义尾 
  (setq BlockName (entmake '((0 . "ENDBLK")))) 
;;;块定义结束 
));_end if 已有同名块则不创建块 
;;;插入块 
  (RefBlock BlockName pt0) 
  (setq ent1 (entlast) 
        ent1list (entget ent1) 
        pd   T) 
   
  (while pd 
    (setq mm (grread t 15 0)) 
    (setq pdMode (car mm)) 
    (cond 
      ((= 5 pdMode) 
       (progn 
         (setq pt0 (cadr mm)) 
         (entdel ent1) 
         (if pd00 
           (progn (entdel ent00) 
                  (setq pd00 nil) 
                  ) 
           ) 
         (setq pt1 (osnap pt0 "_EXT,_end,_int")) 
         (entdel ent1) 
         (if pt1 
           (setq pt0 pt1) 
           ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
         (if pt1 
           (progn 
             (setq r1 (/ (getvar "viewsize") 500)) 
             (setq r1 (* (read (getenv "AutoSnapSize")) r1)) 
             (setq lst1         '() 
                   setp0 (/ pi 10) 
                   ) 
             (if (null pd00) 
               (progn (entdel ent00) 
                      (setq pd00 t) ;_捕捉图元，显示,标记pd00为t则显示 
                      ) 
               ) ;_end if 
             (setq entlist00 (entget ent00)) 
             (setq entlist00 
                    (mapcar 
                      '(lambda (e) 
                         (cond 
                           ((= 10 (car e)) 
                            (progn 
                              (setq e (cons 10 (polar pt1 setp0 r1))) 
                              (setq setp0 (+ setp0 (/ (* 2 pi) 5))) 
                              (setq e e) 
                              ) ;_end progn 
                            ) 
                           ((= 43 (car e)) (setq e (cons 43 (/ r1 5)))) 
                           (t (setq e e)) 
                           ) ;_end cond 
                         ) ;_end lambda 
                      entlist00 
                      ) ;_end mapcar 
                   ) ;_end setq entlist00 
             (entmod entlist00) 
             ) 
           ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
         (setq ent1list (subst (cons 10 pt0) (assoc 10 ent1list) ent1list)) 
         (entmod ent1list) 
         (setq pd T) 
         )) 
      ((= 3 pdMode) 
       (progn (setq pd nil) 
              (print (car mm)) 
              (if pd00 
                (progn (entdel ent00) 
                       (setq pd00 nil) 
                       ) 
                ) 
              )) ;_左键确认 
      ((= 25 pdMode) (progn (entdel ent1) (setq pd nil))) ;_右键取消 
      ) 
    ) 
 
  ) 
 
 
 
 
 
   
;;;定义局域函数 
  (defun BearingDataListToList2Data  (BearingDataList index) 
    (setq List2Data (cdr (nth (atoi index) BearingDataList))) 
    (setq List2Data (mapcar '(lambda (x) 
                               (car x) 
                               ) 
                            List2Data 
                            )) 
    List2Data 
    ) 
 
  (defun BearingDataListToList3Data  (BearingDataList index1 index2) 
    (setq List2Data (cdr (nth (atoi index1) BearingDataList))) 
    (setq List3Data (cadr (nth (atoi index2) List2Data))) 
    (setq DimzinOld (getvar "DIMZIN")) 
    (setvar "DIMZIN" 8) 
    (setq List3Data (mapcar '(lambda (x) 
                               (rtos x 2 4) 
                               ) 
                            List3Data 
                            )) 
    (setvar "DIMZIN" DimzinOld) 
    (setq n -1) 
    (setq List3Data (mapcar '(lambda (x) 
                               (setq n (1+ n)) 
                               (strcat (nth n BearingKeyUnit) x) 
                               ) 
                            List3Data 
                            )) 
    List3Data 
    ) 
 
  (defun InputNewDataToList  (lst key mode) ;_list str str 
    (start_list key (atoi mode)) 
    (mapcar 'add_list lst) 
    (end_list) 
    ) 
;;; 
(setq BearingKeyUnit (list "d(mm)       =" 
                           "D(mm)       =" 
                           "B(mm)       =" 
                           "da(mm)      =" 
                           "Da(mm)      =" 
                           "ra(mm)      =" 
                           "d2(mm)      =" 
                           "D2(mm)      =" 
                           "r(mm)       =" 
                           "Cr(KN)      =" 
                           "C0r(KN)     =" 
                           "脂(r.min-1) =" 
                           "油(r.min-1) =" 
                           "W(Kg)       =")) 
   
;;;;;;  (setq        BearingDataList ;_d/mm,D/mm,B/mm,da/mm,Da/mm,ra/mm,d2/mm,D2/mm,r/mm,Cr/KN,C0r/KN,脂/r.min-1,油/r.min-1,W/Kg. 
;;;;;;         (list 
;;;;;;           (list 
;;;;;;             "60000" 
;;;;;;             (list "613" 
;;;;;;                   (list 3 8 3 4.2 6.8 0.15 4.5 6.5 0.15 0.45 0.15 38000 48000 0.0008)) 
;;;;;;             (list "623" 
;;;;;;                   (list 3 10 4 4.2 8.8 0.15 5.2 8.1 0.15 0.65 0.22 38000 48000 0.002)) 
;;;;;; ;_添加60000型规格.... 
;;;;;;             ) 
;;;;;;           (list 
;;;;;;             "60000-Z" 
;;;;;;             (list "613-Z" 
;;;;;;                   (list 3 8 3 4.2 6.8 0.15 4.5 6.8 0.15 0.45 0.15 38000 48000 0.0008)) 
;;;;;;             (list "623-Z" 
;;;;;;                   (list 3 10 4 4.2 8.8 0.15 5.2 8.3 0.15 0.65 0.22 38000 48000 0.002)) 
;;;;;; ;_添加60000-Z型规格.... 
;;;;;;             ) 
;;;;;; ;_添加其他型及其规格.... 
;;;;;;           ) 
;;;;;;        ) 
  (setq BearingData (open "I:\\BearingData.txt" "r")) 
  (setq        BearingDataList (read (read-line BearingData))) 
  (close BearingData) 
   
;;;--- Load the dcl file 
  (setq dcl_id (load_dialog "BEARING.dcl")) 
 
;;;--- Load the dialog definition if it is not already loaded 
  (if (not (new_dialog "BEARING" dcl_id)) 
    (progn 
      (alert "The BEARING.DCL file could not be loaded!") 
      (exit) 
      ) 
    ) 
;;;--- load data to list1 
  (setq        List1Data (mapcar '(lambda (x) 
                             (car x) 
                             ) 
                          BearingDataList 
                          )) 
 
  (start_list "list1" 3) 
  (mapcar 'add_list List1Data) 
  (end_list) 
;;;--- load data to list2---test!!! 
;;;  (setq        List2Data (mapcar '(lambda (x) 
;;;                             (cadr x) 
;;;                             ) 
;;;                          BearingDataList 
;;;                          )) 
;;;  (setq        List2Data (mapcar '(lambda (x) 
;;;                             (car x) 
;;;                             ) 
;;;                          List2Data 
;;;                          )) 
;;;  (start_list "list2" 3) 
;;;  (mapcar 'add_list List2Data) 
;;;  (end_list) 
 
;;;--- If an action event occurs, do this function 
  (action_tile "accept" "(setq ddiag 2)(done_dialog)") 
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)") 
  (action_tile "list1" (strcat 
               "(InputNewDataToList (BearingDataListToList2Data BearingDataList (get_tile \"list1\"))  \"list2\" \"3\")" 
               "(InputNewDataToList (list)  \"list3\" \"3\")" 
               "(setq Index1 (get_tile \"list1\"))(setq Index2 nil)" 
               )) 
 
  (action_tile "list2" (strcat 
               "(InputNewDataToList (BearingDataListToList3Data BearingDataList (get_tile \"list1\") (get_tile \"list2\")) \"list3\" \"3\")" 
               "(setq Index2 (get_tile \"list2\"))" 
               )) 
 
;;;--- Display the dialog box 
  (start_dialog) 
 
;;;--- Unload the dialog box 
;;;  (unload_dialog dcl_id) 
;;;--- If the user pressed the Cancel button 
  (if (= ddiag 1) 
    (princ "\n Sample3 cancelled!") 
    ) 
 
;;;--- If the user pressed the Okay button 
(if (= ddiag 2) 
  (progn 
    (if        (and Index1 Index2) 
      (DrawingBearing BearingDataList Index1 Index2) 
      (progn (alert "没有选择规格，需重新选择！") (c:q1)) 
      ) 
    (princ "\n The user pressed Okay!") 
    ) 
  ) 
)

BEARING : dialog {
label = "Sample Dialog Box Routine " ;
:boxed_row {
label = "SELECT...";
: list_box {
key = "list1" ;
label ="Choose Item";
height = 15;
list = "" ;
value = ""; }
:list_box {
key = "list2" ;
label ="Choose Item";
height = 15;
list = "" ;
value = ""; }
:list_box {
key = "list3" ;
label ="Show Item";
width = 20;
height = 15;
list = "" ;
value = "";
//is_enable = false;
}
}
ok_cancel;
:boxed_column{
label = "添加新规格...";
:button{
key = "addnew";
label = "添加新规格...";
}
}
}
BearingAddNew : dialog {
label = "Add New Item Dialog Box Routine " ;
:boxed_column {
label = "Item...";
: edit_box {
label ="d =";
key = "EditBox1";
edit_width = 10;
value = "";
}
: edit_box {
label ="D =";
key = "EditBox2";
edit_width = 10;
value = "";
}
: edit_box {
label ="B =";
key = "EditBox3";
edit_width = 10;
value = "";
}
}
ok_cancel;
}

BEARING : dialog { 
                label = "Sample Dialog Box Routine " ; 
                :boxed_row { 
                        label = "SELECT..."; 
                        : list_box { 
                                key = "list1" ; 
                                label ="Choose Item"; 
                                height = 15; 
                                list = "" ; 
                                value = ""; } 
                        :list_box { 
                                key = "list2" ; 
                                label ="Choose Item"; 
                                height = 15; 
                                list = "" ; 
                                value = ""; } 
                        :list_box { 
                                key = "list3" ; 
                                label ="Show Item"; 
                                width = 20; 
                                height = 15; 
                                list = "" ; 
                                value = ""; 
                                //is_enable = false; 
                                } 
                        } 
                        ok_cancel; 
                :boxed_column{ 
                        label = "添加新规格..."; 
                        :button{ 
                                key = "addnew"; 
                                label = "添加新规格..."; 
                                } 
                        } 
                } 
BearingAddNew : dialog { 
                label = "Add New Item Dialog Box Routine " ; 
                :boxed_column { 
                        label = "Item..."; 
                        : edit_box { 
                                label ="d   ="; 
                                key = "EditBox1"; 
                                edit_width = 10; 
                                value = ""; 
                                } 
                        : edit_box { 
                                label ="D   ="; 
                                key = "EditBox2"; 
                                edit_width = 10; 
                                value = ""; 
                                } 
                        : edit_box { 
                                label ="B   ="; 
                                key = "EditBox3"; 
                                edit_width = 10; 
                                value = ""; 
                                } 
 
 
 
                        } 
                ok_cancel; 
                }

(("60000" ("613"( 3 8 3 4.2 6.8 0.15 4.5 6.5 0.15 0.45 0.15 38000 48000 0.0008))("623" (3 10 4 4.2 8.8 0.15 5.2 8.1 0.15 0.65 0.22 38000 48000 0.002)))("60000-Z"( "613-Z"( 3 8 3 4.2 6.8 0.15 4.5 6.8 0.15 0.45 0.15 38000 48000 0.0008))("623-Z"(3 10 4 4.2 8.8 0.15 5.2 8.3 0.15 0.65 0.22 38000 48000 0.002))))

复制代码

邹锋 · 发表于 2012-5-3 09:19:24

cabinsummer 发表于 2012-5-2 07:42
院长的程序是不能看内容的，只能看界面。全部是伪代码。建议练习者按照院长的界面写出源程序。

去试试，，

不敢保证一定能行，

fdb2007 · 发表于 2012-5-3 13:25:12

这个贴一直关注，只是自己水平低参与不了

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

[【风之影】] [新手源码指导]建库程序，以轴承为例

本帖子中包含更多资源

本帖子中包含更多资源

点评

点评

本帖子中包含更多资源

点评