[LISP程序]：标准件--管接头螺母参数设计(绘图)

lsjjm

应网友要求, 帖出一个标准件--管接头螺母参数设计(绘图)的程序. 由于专业领域不同, 仅供参考. 数据文件以表的形式写在LISP里. 对话框选择螺母类型和尺寸, 当选择的尺寸不存在时, 系统提示警告框. 2000+环境下使用. 原本想帖出全部程序码, 但文件太大, 故仅摘录部分程序码.
(defun c:test ( / r1 r2 r3 r4 l1 l2 l3 l4 l5 l6 l7 mir)
  (setq elist (list "06N" "08N" "130N" "131N" "28N" "32N" "39N" "45N"
                    "59N" "68N" "79N" "C06N" "C07N" "C08N" "C62N" "C68N"
                    "C9N" "CBMN" "CC6N" "CGUN" "CHDN" "CJCN" "CKUN"
                    "CMUN" "CXUN" "CYCN"))
  (diaend "Hpd Nut")
  (setvar "osmode" 37)
  (princ)
)
;
(defun 06n ()
  (setq dlist
    '((6 (0.4415 0.5105 0.58 0.68 0.7939)
         (0.73 0.16 0.66 0.603)
         (0.01 0.05 0.01 0.01)
         (15 45) "65731 B")))
  (setq pro "ex06n")
)
;
(defun ex06n ()
  (if l6 nil (setq l6 0))
  (setq p1 (list 0 (/ d4 2))
        p2 (polar p1 pi l2)
       p3r (list (car p2)(/ d5 2))
        p3 (inters p2 (polar p2 (+ (/ pi 2) a1) 1) p3r (polar p3r pi 1))
        p5 (list (- l3)(cadr p1))
        p4 (inters p3 (polar p3 pi 1) p5 (polar p5 (- (/ pi 2) a1) 1) nil)
        p6 (list (- l1)(cadr p5))
        p7 (list (car p6) 0)
     plist (list '(0 0) p1 p2 p3 p4 p5 p6 p7))
  (dline 1)
  (vl-cmdf "chamfer" "d" r1 "" "chamfer" (ssname ee 5)(ssname ee 6) ""
           "fillet" "r" r2 "fillet" (ssname ee 0)(ssname ee 1) "")
  (if l5 (notch (ssname ee 3) p3 (+ l5 (car p3))(- l6) 0.031));
  (setq q1 (list 0 (/ d3 2))
        q3 (list (- l4)(/ d2 2))
        q2 (inters q1 (polar q1 (+ pi a2) 1) q3 (polar q3 0 1) nil)
        q4 (list (car q3)(/ d1 2))
        q5 (list (car p7)(cadr q4))
        qlist (list q1 q2 q3 q4 q5 p6))
  (dline 0)
  (vl-cmdf "chamfer" "d" r3 "" "chamfer" (ssname ii 0)(ssname ii 1) ""
                               "chamfer" (ssname ii 1)(ssname ii 2) ""
           "fillet" "r" r4 "fillet" (ssname ii 2)(ssname ii 3) ""
           "erase" (ssname ii 0) "")
  (thread (ssname ii 3))
)
;
(defun 08n  ()
  (setq dlist
    '((6 (0.4415 0.573 0.64 0.745 0.866 )
         (0.73 0.16 0.67 0.603 0.44 0)
         (0.01 0.03 0.01 0.01)
         (15 45) "65726 C")))
  (setq pro "ex06n")
)
;
(defun 130n  ()
  (setq dlist
    '((6 (0.5 0.636 0.553 0.7225 0.84)
         (0.93 0.06 0.31 0.155 0.255)
         (0.06 0.01 0.01 0.03)
         (15 30 45) "67377 L")))
  (setq pro "ex130n")
)
;
(defun ex130n  ()
  (setq p2 (list (- l2)(/ d4 2))
        p1 (inters '(0 0) '(0 1) p2 (polar p2 (- a1) 1))
        p3 (list (- l3)(cadr p2))
       p4r (list (car p3)(/ d5 2))
        p4 (inters p3 (polar p3 (+ (/ pi 2) a2) 1) p4r (polar p4r pi 1) nil)
        p5 (list (- l1)(cadr p4))
     plist (list '(0 0) p1 p2 p3 p4 p5))
  (dline 1)
  (vl-cmdf "fillet" "r" r1 "fillet" (ssname ee 1)(ssname ee 2) "")
  (vl-cmdf)
  (setq q1 (list 0 (/ d3 2))
        q2 (polar q1 pi l4)
        q3 (list (car q2)(/ d2 2))
        q4 (polar q3 pi l5)
        q6 (list (- l1)(/ d1 2))
        q5 (inters q4 (polar q4 (+ pi a3) 1) q6 (polar q6 0 1) nil)
     qlist (list p1 q1 q2 q3 q4 q5 q6))
  (dline 0)
  (vl-cmdf "chamfer" "d" r2 "" "chamfer" (ssname ii 4)(ssname ii 5) ""
           "fillet" "r" r3 "fillet" (ssname ii 2)(ssname ii 3) ""
           "fillet" "r" r4 "fillet" (ssname ii 1)(ssname ii 2) ""
           "erase" (ssname ii 5) "")
)
;
(defun 68n  ()
  (setq dlist
    '((4 (0.3065 0.3955 0.45 0.557 0.6495)
         (0.63 0.12 0.54 0.532)
         (0.01 0.03 0.005 0.01)
         (15 45) "65880 C")
      (8 (0.5715 0.6905 0.77 0.87 1.0104)
         (0.85 0.16 0.75 0.723)
         (0.01 0.05 0.01 0.01)
         (15 45) "65731 B")
     (10 (0.6995 0.8605 0.89 0.995 1.1547)
         (0.98 0.17 0.87 0.817)
         (0.01 0.05 0.01 0.01)
         (15 45) "65731 B")))
  (setq pro "ex06n")
)
;
(defun diaend (part / ss0 hex size lp lc)       
  (setq slist (list "2" "3" "4" "5" "6" "8" "10" "12" "13" "14" "15" "16" "18"
                    "20" "21" "22" "24" "25" "26" "28" "30" "32" "35" "38" "42"))
  (setq alist (list "0" "45" "90" "180" "270"))
  (setq ss0 (ssget "x"))
  (vl-cmdf "ucs" "")
  (setvar "osmode" 0)
  (while (not lp)
    (if (findfile "dial.dcl")(setq index (load_dialog (findfile "dial.dcl"))))  
    (if (not (new_dialog "dend" index))(exit))
    (if (member part (list "Hpd" "Tfd" "Tfde" "Brass" "Dayco" "Enzed" "Hpde" "Parflex" "Other"))
      (set_tile "et" (strcat "EndStyle-" part))
      (progn (set_tile "et" (strcat "Stand-Alone Part-" part))(set_tile "es" "PartStyle:"))
    )
    (imagep)
    (start_list "etype")
    (mapcar 'add_list elist)                                       
    (end_list)
    (start_list "size")
    (mapcar 'add_list slist)
    (end_list)
    (start_list "angle")
    (mapcar 'add_list alist)
    (end_list)
    (action_tile "accept"
     "(setq estyle (nth (atoi (get_tile \"etype\")) elist)
              size (nth (atoi (get_tile \"size\")) slist)
               ang (angtof (nth (atoi (get_tile \"angle\")) alist))
               es  (get_tile \"es\")
               fu  (get_tile \"fu\"))
      (done_dialog 1)")
    (action_tile "cancel" "(setq lp 1)(exit)")
    (action_tile "fu" "(tubed)")
    (start_dialog)
    (unload_dialog index)
    (if (= fu "1")
      (progn
        (setq p0 (getpoint "\nDigitise Part's Datum point: "))
        (vl-cmdf "ucs" "n" p0 "")
        (extube)
        (quit)
      )
      (progn
        (eval (read (strcat "(" estyle ")")))
        (if (assoc (atoi size) dlist)
          (progn
            (getdata (assoc (atoi size) dlist))
            (if (= es "Endstyle:")(diaend2)(setq lp 1))
          )
          (progn
            (acet-ui-message (strcat estyle "-" size " Does Not Exist!") "SmartTool" 48)            
            (setq slist nil)
            (foreach i dlist (setq slist (append slist (list (rtos (car i) 2 0)))))
          )
        )
        (setq p0 (getpoint "\nDigitise Part's Datum point: "))
      )
    )
  )
  (setvar "osmode" 0)
  (vl-cmdf "ucs" "n" "3" p0 (polar p0 ang 1)(polar p0 (+ ang (/ pi 2)) 1) "")
  (setq run t hflag t)
  (while run
    (if (= idc "1")(setq dt0 dt dt id))
    (eval (read (strcat "(" pro ")")))
    (princ hflag)
    (if hflag (setq run nil)(diaend2))
  )
  (setvar "clayer" "external")
  (if (= idc "1")(collar (ssname ee 0)))
  (if mir nil
    (progn
      (setq ss (ssget "x") n 0)
      (if ss0 (while (< n (sslength ss0))(ssdel (ssname ss0 n) ss)(setq n (1+ n))))
      (vl-cmdf "mirror" ss "" '(0 0) '(1 0) "n")
    )
  )
  (setq lc (apply 'max (caddr data)))
  (vunit 'lc 4)
  (mlayer "cline" 2 "Center2")
  (if cl nil (command "line" '(0.1 0)(list (- (+ lc 0.1)) 0) ""))
  (if (< ang pi)(setq lang (/ pi 3))(setq lang (- ang (/ pi 3))))
  (vl-cmdf "ucs" "w" "")
  (mlayer "dim" 4 "Continuous")
  (setvar "dimscale" 0.44)
  (if hex nil (setq hex dm))
  (command "_leader" p0 (polar p0 lang (* 0.6 hex)) ""
           (StrCat (strcase estyle) "-" size "\\P" (last data)) "")  
  (setvar "chamfera" 0)(setvar "chamferb" 0)(setvar "chamferc" 0)(setvar "chamferd" 0)
  (setvar "osmode" 37)
)
;
(defun getdata (datal / i j v n)        ;30/04/04
  (setq dm (apply 'max (cadr datal)))
  (if (> dm 5)(setq unit 25.4 dm (/ dm 25.4))(setq unit 1))
  (setq num (cadr (reverse datal)))
  (setq v '("d" "l" "r" "a" "ac") j 1)
  (while (< j 5)
    (setq n (length (nth j datal)) i 0)
    (foreach n (nth j datal)
      (setq i (1+ i))
      (if (< j 4)(setq vn (/ n unit))(setq vn (dtr n)));if
      (set (read (strcat (nth (1- j) v)(itoa i))) vn)
    )
    (setq j (1+ j))
  )
  (setq data datal)
)
;
(defun vunit (x v / m n l iv)
  (setq xx (eval x))
  (if (= (type xx) 'str)
    (progn
      (setq m (vl-string-search "-" xx)
            n (vl-string-search "/" xx)
            l (strlen xx))
      (if n
        (progn
          (if m
            (setq iv (atof (substr xx 1 m)) fz (substr xx (+ 2 m)(- n m 1)))
            (setq iv 0 fz (substr xx 1 n))
          )
          (setq fm (substr xx (+ n 2)(- l n 1)) xv (+ iv (/ (atof fz)(atof fm))))
        )
        (if (> (atof xx) v)(setq xv (/ (atof xx) 25.4))(setq xv (atof xx)))
      )
    )
    (if (> xx v)(setq xv (/ xx 25.4))(setq xv xx))
  )
  (set x xv)
)
;
(defun mlayer (name color ltype)
  (if (tblsearch "layer" name)
      (vl-cmdf "layer" "s" name "")
      (progn
        (setq regen (getvar "regenmode"))
        (setvar "regenmode" 0)
        (vl-cmdf "layer" "m" name)
        (if color (vl-cmdf "c" color name))
        (if ltype (vl-cmdf "lt" ltype name))
        (vl-cmdf "")
        (setvar "regenmode" regen)
      )
  )
)
;
(defun imagep ( / h w)
  (start_image "im")
  (setq w (dimx_tile "im") h (dimy_tile "im"))  
  (fill_image 0 0 w h 1)
  (setq w1 (/ w 2))
  (setq h1 (/ h 2))
  (vector_image 0 h w1 0 2)
  (vector_image w1 0 w h 2)
  (vector_image 0 h w1 h1 2)
  (vector_image w1 h1 w h 2)
  (end_image)
)
(defun dtr (x)(* x (/ pi 180)));
(defun dline (pq / i)         
  (setvar "cecolor" "256")
  (if (= pq 1)
    (progn
      (mlayer "external" "red" "Continuous")
      (command "line" (foreach i plist (command i)) "")
      (setq ee (ssget "x" '((8 . "external"))))
    )
    (progn
      (mlayer "internal" "magenta" "hidden")
      (command "line" (foreach i qlist (command i)) "")
      (setq ii (ssget "x" '((8 . "internal"))))
    )
  )
)
;
对话框文件, 放于支持路径下.
dend : dialog {key= "et";                       
  : image { key="i"; width=10;  color=0;}
  //initial_focus = "etype";
  : row {
    : text { label="Endstyle:"; key="es";}
    : popup_list { key="etype"; edit_width = 10;}
  }
  : popup_list { label="Size:"; key ="size"; value="4"; edit_width = 4;}
  : popup_list { label = "Orientation:"; key = "angle"; edit_width = 5; popup_height = 3;}
  : toggle {label = "Full Dimension"; key = "fu"; is_enabled= false;}
  spacer;
  ok_cancel;
  : row {
    : image { key = "im" ; width = 4; fixed_width= true;}
    : paragraph {
      : text_part { label = "Designed and Created"; alignment=right;}
      : text_part { label = "by Richard Liang"; alignment=right;}
    }
  }
}
//

ynjzlzd

楼主,看不懂你什么意思,无法使用.