[LISP程序]：单面带钝边J形焊缝

li_seagull

2. ===============================================================================
   
3. ;     钢 结 构 工 具 箱 v8.1                    作者：李海斌  日期：2004-08-01
   
4. ; ===============================================================================
   
5. ;***  
   
6. (defun belt_ddj (/ olderr pt1 pt2 pt3 pt4 pt5 pt6 text s a b c d e f g h i j k l old orth text1 text2 text3)
   
7.    (setq olderr *error* *error* user_err)                                                         //设置文字字体
   
8.    (setq orth (getvar "orthomode"))                                                   //设置正交变量
   
9.    (setq old (getvar "osmode"))                                                       //设置捕捉变量
   
10.    (princ "\n")                                                      //显示焊缝类型
    
11.    (setq s (getvar "DIMSCALE")
    
12.          a (* s 3)
    
13.          b (* s 0.5)
    
14.          c (* s 4)
    
15.          d (* s 3.5)
    
16.          e (* s 14)
    
17.          f (* s 7.5)
    
18.          g (* s 1.4)
    
19.          h (* s 1.9)
    
20.          i (* s 2.5)
    
21.          j (* s 1.1)
    
22.          k (* s 2.7)
    
23.          l (* s 1.6)
    
24.    )                                                                                  //设置变量
    
25.    (setvar "osmode" 0)                                                                //设置捕捉为关
    
26.    (setq pt1 (getpoint "\n基准线起点:"))                                              //基准线起点
    
27.    (setq pt2 (getpoint pt1 "\n基准线方向:"))
    
28.    (setq pt3 (list (car pt2) (cadr pt1)))                                             //基准线方向
    
29.    (setq pt4 (polar pt1 (angle pt1 pt3) e))                                           //基准线终点
    
30.    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))    //基准线中点
    
31.    (command ".-layer" "s" "尺寸" ""
    
32.             ".line" pt1 pt4 ""
    
33.             ".pline" pt5 "W" b b (list (+ (car pt5) 0) (+ (cadr pt5) d)) ""
    
34.             ".pline" (list (+ (car pt5) 0) (+ (cadr pt5) j)) "W" b b "a" "ce"
    
35.                      (list (+ (car pt5) 0) (+ (cadr pt5) k))
    
36.                      (list (+ (car pt5) l) (+ (cadr pt5) k)) "l"
    
37.                      (list (+ (car pt5) l) (+ (cadr pt5) d)) ""
    
38.             ".-layer" "s" "粗实线" ""
    
39.    )                                                                                  //绘制焊缝符号
    
40.    (setvar "orthomode" 0)                                                             //设置正交为关
    
41.    (setq pt6 (getpoint pt4 "\n箭头线终点<若选择拐点,按enter>:"))                      //箭头线终点
    
42.    (if (not pt6)
    
43.        (progn
    
44.          (setvar "osmode" 0)
    
45.          (initget 1)
    
46.          (setq pt6 (getpoint pt4 "\n拐点:"))
    
47.          (command ".-layer" "s" "尺寸" ""
    
48.                   ".line" pt4 pt6 ""
    
49.                   ".-layer" "s" "粗实线" ""
    
50.          )
    
51.          (setq pt4 pt6)
    
52.          (setq pt6 (getpoint pt4 "\n箭头线终点:"))
    
53.          (while (< (distance pt4 pt6) a)
    
54.                 (prompt "\n距离太短,请重新输入!")
    
55.                 (initget 1)
    
56.                 (setq pt6 (getpoint pt4 "\n射头线终点:"))
    
57.          )
    
58.        )
    
59.    )
    
60.    (while (< (distance pt4 pt6) a)
    
61.           (prompt "\n距离太短,请重新输入!")
    
62.           (initget 1)
    
63.           (setq pt6 (getpoint pt4 "\n箭头线终点:"))
    
64.    )
    
65.    (command ".line" pt4 pt6 ""
    
66.             ".pline" pt6 "w" "0" b (polar pt6 (angle pt6 pt4) a) ""
    
67.    )
    
68.    (setq text1 (getstring "\n根部间隙<>:"))
    
69.    (command ".text" "j" "bl" (list (+ (car pt5) 0) (+ (cadr pt5) c)) a "0" text1
    
70.    )
    
71.    (setq text2 (getstring "\n坡口角度<>:"))
    
72.    (setq text2 (strcat text2 "%%d"))
    
73.    (command ".text" "j" "bl" (list (+ (car pt5) 0) (+ (cadr pt5) f)) a "0" text2
    
74.    )
    
75.    (setq text3 (getstring "\n钝边高度<>:"))
    
76.    (setq text4 (getstring "\n根部半径:"))
    
77.    (command ".text" "j" "br" (list (- (car pt5) i) (+ (cadr pt5) s)) a "0" (strcat text3 "X" text4)
    
78.    (setvar "osmode" old)                                                              //设置捕捉为初始状态
    
79.    (setvar "orthomode" orth)                                                          //设置正交为初始状态
    
80.    (if olderr (setq *error* olderr))
    
81.    (princ)
    
82. );defun                                                                               //定义命令结束
    
83. ********************************************************************************

===============================================================================<br /> ;     钢 结 构 工 具 箱 v8.1                    作者：李海斌  日期：2004-08-01<br /> ; ===============================================================================<br /> ;***  <br /> (defun belt_ddj (/ olderr pt1 pt2 pt3 pt4 pt5 pt6 text s a b c d e f g h i j k l old orth text1 text2 text3)<br />    (setq olderr *error* *error* user_err)                                                         //设置文字字体<br />    (setq orth (getvar "orthomode"))                                                   //设置正交变量<br />    (setq old (getvar "osmode"))                                                       //设置捕捉变量<br />    (princ "\n")                                                      //显示焊缝类型<br />    (setq s (getvar "DIMSCALE")<br />          a (* s 3)<br />          b (* s 0.5)<br />          c (* s 4)<br />          d (* s 3.5)<br />          e (* s 14)<br />          f (* s 7.5)<br />          g (* s 1.4)<br />          h (* s 1.9)<br />          i (* s 2.5)<br />          j (* s 1.1)<br />          k (* s 2.7)<br />          l (* s 1.6)<br />    )                                                                                  //设置变量<br />    (setvar "osmode" 0)                                                                //设置捕捉为关<br />    (setq pt1 (getpoint "\n基准线起点:"))                                              //基准线起点<br />    (setq pt2 (getpoint pt1 "\n基准线方向:"))<br />    (setq pt3 (list (car pt2) (cadr pt1)))                                             //基准线方向<br />    (setq pt4 (polar pt1 (angle pt1 pt3) e))                                           //基准线终点<br />    (setq pt5 (list (/ (+ (car pt1) (car pt4)) 2) (/ (+ (cadr pt1) (cadr pt4)) 2)))    //基准线中点<br />    (command ".-layer" "s" "尺寸" ""<br />             ".line" pt1 pt4 ""<br />             ".pline" pt5 "W" b b (list (+ (car pt5) 0) (+ (cadr pt5) d)) ""<br />             ".pline" (list (+ (car pt5) 0) (+ (cadr pt5) j)) "W" b b "a" "ce"<br />                      (list (+ (car pt5) 0) (+ (cadr pt5) k))<br />                      (list (+ (car pt5) l) (+ (cadr pt5) k)) "l"<br />                      (list (+ (car pt5) l) (+ (cadr pt5) d)) ""<br />             ".-layer" "s" "粗实线" ""<br />    )                                                                                  //绘制焊缝符号<br />    (setvar "orthomode" 0)                                                             //设置正交为关<br />    (setq pt6 (getpoint pt4 "\n箭头线终点<若选择拐点,按enter>:"))                      //箭头线终点<br />    (if (not pt6)<br />        (progn<br />          (setvar "osmode" 0)<br />          (initget 1)<br />          (setq pt6 (getpoint pt4 "\n拐点:"))<br />          (command ".-layer" "s" "尺寸" ""<br />                   ".line" pt4 pt6 ""<br />                   ".-layer" "s" "粗实线" ""<br />          )<br />          (setq pt4 pt6)<br />          (setq pt6 (getpoint pt4 "\n箭头线终点:"))<br />          (while (< (distance pt4 pt6) a)<br />                 (prompt "\n距离太短,请重新输入!")<br />                 (initget 1)<br />                 (setq pt6 (getpoint pt4 "\n射头线终点:"))<br />          ) <br />        )<br />    )<br />    (while (< (distance pt4 pt6) a)<br />           (prompt "\n距离太短,请重新输入!")<br />           (initget 1)<br />           (setq pt6 (getpoint pt4 "\n箭头线终点:"))<br />    ) <br />    (command ".line" pt4 pt6 ""<br />             ".pline" pt6 "w" "0" b (polar pt6 (angle pt6 pt4) a) ""<br />    )<br />    (setq text1 (getstring "\n根部间隙<>:"))<br />    (command ".text" "j" "bl" (list (+ (car pt5) 0) (+ (cadr pt5) c)) a "0" text1<br />    )<br />    (setq text2 (getstring "\n坡口角度<>:"))<br />    (setq text2 (strcat text2 "%%d"))<br />    (command ".text" "j" "bl" (list (+ (car pt5) 0) (+ (cadr pt5) f)) a "0" text2<br />    )<br />    (setq text3 (getstring "\n钝边高度<>:"))<br />    (setq text4 (getstring "\n根部半径:")) <br />    (command ".text" "j" "br" (list (- (car pt5) i) (+ (cadr pt5) s)) a "0" (strcat text3 "X" text4)<br />    (setvar "osmode" old)                                                              //设置捕捉为初始状态<br />    (setvar "orthomode" orth)                                                          //设置正交为初始状态 <br />    (if olderr (setq *error* olderr))<br />    (princ)<br /> );defun                                                                               //定义命令结束<br /> ********************************************************************************