画六角头螺栓程序

ttmc 发表于 2006-11-27 17:15

标准件,大家应该用得到.还想再加个左视图,以后再加吧.这个程序也参考了些别人的写的代码,但主要是我自己写的.

补充一下，由于楼主没有具体的说明，所以很多人不会用，使用的方法见这个帖子的13楼。谢谢楼主的代码。-------by cad

以下为程序代码:
;画六角头螺栓
;2006.11.21晚解决输入直径错误时的判断,并解决M5时出错问题(除数是整数,自然5/2变2了.
;2006.10.18晚完善
(defun C:xls (/    oce o    a b    sczxang ang1 enl1l2d
      e    h k    l lslgk1h r1r e    d p1p2
      p3p4p5p6p7p8p9p10 p11 p12 p13 p14 p15 p16
      p17 p18 p19 p20 p21 p22 c1c2c3
      )
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(graphscr)
;创建如果与你所用图层不符，可自行修改
(setq clay (getvar "CLAYER")) ;取得图层信息
;创建中心线层center颜色红
(if (null (tblsearch "LAYER" "center"))
(command "_layer" "_m" "center" "_c" 1 "" "_lt" "center" "" "")
)
;创建细实线层continuous颜色青
(if (null (tblsearch "LAYER" "continuous"))
(command "_layer" "_m"    "continuous" "_c"
      4 ""    "_lt"    "continuous"
      "" ""
   )
)

(command ".layer" "s" "0" "")

(setq o (getpoint "\n 输入插入点:"))

(if (not d)
(setq b "默认")
(setq b " 上次输入")
)
(if (not d)
(setq d 10)
)
(setq a d)
(princ
"\n 输入螺栓规格M5/6/8/10/12/16/20/24/30/36/42/48/56<"
)
(princ b)
(princ d)
(princ ">:")

(setq d (getint)) ;"\n 输入螺栓规格M5/6/8/10/12/16/20/24/30/36/42/48/56<默认" d ">:"

(if (not d)
(setq d a)
)
(if (not l)
(setq b "默认")
(setq b " 上次输入")
)
(setq en t)
(while en
(setq en nil)
(cond ((= d 5)
   (setq e 8.63)
   (setq k 3.5)
   (setq l1 20.0)
   (setq l2 16)
   )
   ((= d 6)
   (setq e 11.0)
   (setq k 4.0)
   (setq l1 23.0)
   (setq l2 18)
   )
   ((= d 8)
   (setq e 14.4)
   (setq k 5.3)
   (setq l1 28.25)
   (setq l2 22)
   )
   ((= d 10)
   (setq e 17.8)
   (setq k 6.4)
   (setq l1 33.5)
   (setq l2 26)
   )
   ((= d 12)
   (setq e 20.0)
   (setq k 7.5)
   (setq l1 38.75)
   (setq l2 30)
   )
   ((= d 16)
   (setq e 26.8)
   (setq k 10.0)
   (setq l1 48.0)
   (setq l2 38)
   )
   ((= d 20)
   (setq e 33.0)
   (setq k 12.5)
   (setq l1 58.5)
   (setq l2 46)
   )
   ((= d 24)
   (setq e 39.6)
   (setq k 15.0)
   (setq l1 69.0)
   (setq l2 54)
   )
   ((= d 30)
   (setq e 50.9)
   (setq k 18.7)
   (setq l1 83.5)
   (setq l2 66)
   )
   ((= d 36)
   (setq e 60.8)
   (setq k 22.5)
   (setq l1 95.5)
   (setq l2 78)
   )
   ((= d 42)
   (setq e 72)
   (setq k 26)
   (setq l1 113.5)
   (setq l2 96)
   )
   ((= d 48)
   (setq e 82.6)
   (setq k 30)
   (setq l1 121.5)
   (setq l2 108)
   )
   ((= d 56)
   (setq e 93.6)
   (setq k 35)
   (setq l1 137.5)
   (setq l2 124)
   )
   ((= d 64)
   (setq e 104.9)
   (setq k 40)
   (setq l1 153.5)
   (setq l2 140)
   )
   (t
   (progn ;非上述口径时则令
      (setq d (getint "没有这个直径的螺栓,请重新输入螺栓规格,M=:"))
      (setq en t) ;令en为真,产生循环
   ) ;结束prong
   ) ;结束t

) ;结束cond
) ;结束while
(if (not l)
(setq l 50)
)
(setq a l)
(princ "\n 输入螺栓长度<")
(princ b)
(princ l)
(princ ">:")

(setq l (getDIST))
(if (not l)
(setq l a)
)
(setq ang1 (getangle o "\n 输入旋转角度<默认0>:"))
(if (not ang1)
(setq ang1 0)
)
(setq zx (getstring "\n 是否要中心线(No<Yes>):"))
(if (= zx "")
(setq zx "y")
)
(setq os (getvar "osmode"))
(setq ang (/ (* 180 ang1) Pi))
(command "osmode" 0)

(setq ls (- l l1))

(setq lg (- l l2)) ;长度减螺纹长度
(if (> l2 l)
(setq lg 0)
) ;螺纹长度过小时变成全螺纹
(setq k1 (SQRT (- (* 2.25 (* d d)) (/ (* e e) 16))))
(setq h (- (* 1.5 d) k1))
(setq r1 (+ (* h h) (/ (* e e) 64)))
(setq r (/ (/ r1 2) h))
(setq P1 (list 0 (/ e 2)))
(setq p2 (list 0 (- 0 (/ e 2))))
(command "ucs" "o" o)
(command "ucs" "z" ang)
(command "line" p1 p2 "")
(setq P3 (list (- (* 1.5 d) (+ k k1)) (/ e 4)))
(setq p4 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 4))))
(setq C1 (list (- (* 1.5 d) k) 0))
(command "arc" p3 "c" c1 p4)
(setq p5 (list 0 (/ e 4)))
(setq p6 (list 0 (- 0 (/ e 4))))
(command "line" p3 p5 "")
(command "line" p4 p6 "")
(setq p7 (list (- (* 1.5 d) (+ k k1)) (/ e 2)))
(setq c2 (list (- r k) (* 0.375 e)))
(command "arc" p7 "c" c2 p3)
(setq p8 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 2))))
(setq c3 (list (- r k) (- 0 (* 0.375 e))))
(command "arc" p4 "c" c3 p8)
(command "line" p7 p1 "")
(command "line" P8 p2 "")
(setq p9 (list (- 0 K) (* 0.375 e)))
(setq p10 (list (- 0 k) (- 0 (* 0.375 e))))
(command "line" p9 p10 "")
(setq p11 (list 0 (/ d 2.0)))
(setq p12 (list (- l (* 0.075 d)) (/ d 2.0)))
;如果除数为2,则M=5时就变成了M4,会出错.
(command "line" p11 p12 "")
(setq p13 (list 0 (- 0 (/ d 2.0))))
(setq p14 (list (- l (* 0.075 d)) (- 0 (/ d 2.0))))
(command "line" p13 p14 "")
(setq P19 (list Lg (/ d 2.0)))
(setq p20 (list lg (- 0 (/ d 2.0))))
(command "line" p19 p20 "") ;螺纹终止线
(SETQ P15 (list lg (* 0.425 d)))
(setq p16 (list l (* 0.425 d)))
(setq p17 (list lg (- 0 (* 0.425 D))))
(setq p18 (list l (- 0 (* 0.425 d))))
(setq p21 (list ls (/ d 2)))
(setq p22 (list ls (- 0 (/ d 2))))
(command "line" p16 p18 "") ;螺纹端面
(command "line" p16 p12 "") ;上倒角
(command "line" p14 p18 "") ;倒角
(command "line" p12 p14 "") ;倒角处粗实线
(command ".layer" "s" "continuous" "") ;细线层
(command "line" p15 p16 "") ;上细实线
(command "line" p17 p18 "") ;下细实线
(cond ((or (= zx "y") (= zx "Y"))
(setq zx1 (list (- -3 k) 0))
(setq zx2 (list (+ l 3) 0))
(command ".layer" "s" "center" "") ;中心线层
(command "line" zx1 zx2 "")
)
)
(setvar "clayer" clay) ;回原图层
(command "ucs" "z" (- 0 ang))
(command "ucs" "w")
(command "osmode" os)
(setvar "cmdecho" oce)
(princ)
)

ttmc 发表于 2006-12-1 13:01

我以为有人会用呢,结果没人感兴趣.

nbxhy 发表于 2006-12-5 20:58

ding顶

hellmen 发表于 2006-12-6 16:26

先顶个!!

qixing 发表于 2006-12-6 16:38

哇，天文哦，``顶一下，`

dahai 发表于 2006-12-8 16:23

不错严重支持!!!

ETpig 发表于 2006-12-8 21:38

真是专业啊...
完全不知咋回事

梦萱发表于 2006-12-10 10:42

俺也看不懂，但是支持你！

33973538 发表于 2006-12-15 20:35

好呀

如果再来一个用法那就好那

syq_1978 发表于 2006-12-31 16:37

天书，落后好多呀

wzw 发表于 2007-1-10 19:25

看不懂，看来要学的还真多啊

phenix_1 发表于 2007-1-10 21:52

为什么只写程序出来，不教我们怎么用，其实我们很多人没你水平高的，有些细节说出来估计会帮到不少人。
我根本不知道怎么用这程序，像把一台电脑摆在我爷爷那辈人前面一样，告诉他这个东西很好的，您用用吧，然后走了:@ :@ :@

cad 发表于 2007-1-10 22:14

其实使用方法很简单，将所有的代码复制到记事本里，然后另存为xls.lsp，然后打开autocad，选择“菜单”---“AutoLSP”----加载...，找到你保存的xls.lsp，点“加载”。然后就可以了，使用方法，直接在命令行里输入xls，按照提示操作就可以了。

wzm1234568 发表于 2007-1-11 10:17

试了一下，很好用呢，谢谢。

hellmen 发表于 2007-1-30 14:49

谁说没人关注,只是好多人根本不懂二次开发!!
我自己试了下,感觉蛮好的!!

页: [1] 2 3 4 5 6 7 8

CAD设计论坛's Archiver

画六角头螺栓程序

好呀