对话框绘制链轮

chg

最近工作中接触链轮比较多，看见论坛上也有绘制链轮的程序，参照论坛上的程序，自己做了一些改动，整合，并采用了对话框的形式，比较直观，现公布源码，提供给需要的朋友使用。程序可能有错误的地方，希望大家指正。
发现sld文件不能上传，不知如何解决。
说明：本程序仅供交流使用，不用于商业用途，不保证程序及绘制出的链轮尺寸的正确。对此造成的损失概不负责。（虽然是废话，还是写上比较好）

chengang2001ren

楼主，autocad2010加载运行显示错误：_chain ; 错误: quit / exit abort   

白色微風1991

漂亮，沙發的支持

669423907

漂亮，沙发的支持

669423907

打个包就什么都可以上传了

自贡黄明儒

669423907 发表于 2013-8-25 18:49
漂亮，沙发的支持

先顶—个，明天给你加分。问—下，SLd打包没？

chg

哦，原来是这样，我马上打包上传

669423907

稍微改了一下，指定了图层和线型比例
(setq bl (* 0.5 d) bll (* 0.035 d))

        (entmake (list '(0 . "LINE")
                       '(100 . "AcDbEntity")
;                       '(6 . "CENTER")
;                       '(62 . 1)
                       '(8 . "3中心线")
                       (cons 10 p3)
                       (cons 11 p6)
                       (cons 48 bl)
                       )
                 )

        (entmake (list '(0 . "LINE")
                       '(100 . "AcDbEntity")
;                       '(6 . "CENTER")
;                       '(62 . 1)
                       '(8 . "3中心线")
                       (cons 10 p8)
                       (cons 11 p9)
                       (cons 48 bl)
                       )
                 )

        (entmake (list '(0 . "CIRCLE")
                       '(100 . "AcDbEntity")
;                       '(6 . "CENTER")
;                       '(62 . 1)
                       '(8 . "3中心线")
                       (cons 10 cpt)
                       (cons 40 (/ d 2.0))
                       (cons 48 bll)
                       )
                 )

还想向楼主请教一个问题，我想把 chain.dcl  改成 链轮.dcl，不知要改哪几个 chain  ？？？

669423907

楼主如果方便的话，帮看一下我收藏的一个画链轮侧视图的程序，排数大于1就出不来了，不知道是什么原因
(defun c:lianlunn()
(command "undo" "be")
(command "layer" "m" "3中心线" "c" "1" "" "lw" "0.13" "" "l" "CENTER" "" "" "clayer" "0")
(setvar "cmdecho" 0)
;(initget "05B 06B 08A 08B 10A 12A 16A 20A 24A 28A 32A 40A 48A")
;(setq no (getkword "请输入链号05B,06B,08A,08B,10A,12A,16A,20A,24A,28A,32A,40A或48A<08A>:"))

(initget "5 6 8A 8B 10 12 16 20 24 28 32 40 48")
(setq no (getkword "请输入链号5<05B>,6<06B>,8A<08A>,8B<08B>,10,12,16,20,24,28,32,40,48<08A>:"))

(if (= no nil) (setq no "8A"))
(setq z (getint "请输入齿数<11>:"))
(if (null z) (setq z 11))
(setq m (getint "请输入排数<1>:"))
(if (null m) (setq m 1))
(setq no (strcase no))
(cond ((= no "5") (setq p 8.00) (setq dr 5.00) (setq pt 5.64) (setq b1 3.00))
((= no "6") (setq p 9.525) (setq dr 6.35) (setq pt 10.24) (setq b1 5.72))
((= no "8A") (setq p 12.7) (setq dr 7.95) (setq pt 14.38) (setq b1 7.85))
((= no "8B") (setq p 12.7) (setq dr 8.51) (setq pt 13.92) (setq b1 7.75))
((= no "10") (setq p 15.875) (setq dr 10.16) (setq pt 18.11) (setq b1 9.4))
((= no "12") (setq p 19.05) (setq dr 11.91) (setq pt 22.78) (setq b1 12.57))
((= no "16") (setq p 25.4) (setq dr 15.88) (setq pt 29.29) (setq b1 15.75))
((= no "20") (setq p 31.75) (setq dr 19.05) (setq pt 35.76) (setq b1 18.9))
((= no "24") (setq p 38.1) (setq dr 22.23) (setq pt 45.44) (setq b1 25.22))
((= no "28") (setq p 44.45) (setq dr 25.4) (setq pt 48.87) (setq b1 25.22))
((= no "32") (setq p 50.8) (setq dr 28.585) (setq pt 58.55) (setbbq b1 31.55))
((= no "40") (setq p 63.5) (setq dr 39.68) (setq pt 71.55) (setq b1 37.85))
((= no "48") (setq p 76.2) (setq dr 47.63) (setq pt 87.83) (setq b1 47.35))
(t (setq dr 7.95) (setq pt 14.38) (setq b1 7.85))
)
(cond ((= m 1) (setq bf1 (* 0.93 b1)))
((= m 2) (setq bf1 (* 0.91 b1)))
((= m 3) (setq bf1 (* 0.91 b1)))
((>= m 4) (setq bf1 (* 0.88 b1)))
(t(setq bf1 (* 0.93 b1)))
)
(setq ba (* p 0.125))
(setq h (* p 0.5))
(setq ra (* p 0.04))
(setq bfm (+ bf1 (* pt (- m 1))))
(setq ang1 (/ pi z));;;ang1为180/z的弧度值
(setq d (/ p (sin ang1)))
(setq da (fix (- (+ d (* p 1.25)) dr)))
(setq df (- d dr))
(setq dg (fix (- (* p (/ (cos ang1) (sin ang1))) (* h 1.04) 0.76 dr)))
(setq pt1 (getpoint "请输入起点:"))
(setq pt2 (getpoint pt1 "请输入链轮宽度:"))
(setq l (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq pt3 (polar pt1 (+ (* pi 0.5) ang) (/ df 2)))
(setq pt4 (polar pt3 (+ (* pi 0.5) ang) (- (/ (- da df) 2) h)))
(setq x1 (polar pt1 (+ ang (* 0.5 pi)) (/ da 2)))
(setq x2 (polar x1 ang bf1))
(setq xb (polar pt1 ang bf1))
(setq m1 (polar pt1 (+ ang pi) 2))
(setq m2 (polar xb ang 2))
(setq pt5 (polar x1 ang ba))
(setq pt6 (polar pt5 ang (- bf1 (* ba 2))))
(setq pt7 (polar pt4 ang bf1))
(setq pt8 (polar pt3 ang bf1))
(setq pt9 (polar xb (+ ang (* pi 0.5)) (/ dg 2)))
(setq pt10 (polar pt2 (+ ang (* 0.5 pi)) (/ dg 2)))
(setq pt11 (polar pt2 (+ ang (* 1.5 pi)) (/ dg 2)))
(setq pt12 (polar xb (+ ang (* 1.5 pi)) (/ dg 2)))
(setq o1 (polar pt7 (+ ang pi) p))
(setq o2 (polar pt4 ang p))
(if (= m 1)
(progn
(command "pline" pt3 "w" 0 "" pt4 "a" pt5 "l" pt6 "")
(setq en1 (entlast))
(command "pline" pt9 "w" 0 "" pt8 pt7 "a" pt6 "")
(setq en2 (entlast))
(command "pline" pt9 "w" 0 "" pt10 pt11 pt12 "")
(command "chamfer" "d" 1 "")
(command "chamfer" "p" (entlast))
(command "chamfer" "d" 0 "")
(command "line" pt3 pt8 "")
(setq en3 (entlast))
(command "line" pt3 (polar pt3 (+ ang (* pi 1.5)) df) "")
(command "mirror" en1 en2 en3 "" pt1 pt2 "n" "")
(command "mline" "st" "standard" "s" d "j" "z" m1 m2 "")

(setq bl (* 0.5 b1))
(command "change" (entlast) "" "p" "la" "3中心线" "ltscale" bl "")

))
(setvar "osmode" os)
(command "undo" "e")
(princ))

chg

669423907 发表于 2013-8-25 21:36
楼主如果方便的话，帮看一下我收藏的一个画链轮侧视图的程序，排数大于1就出不来了，不知道是什么原因
(de ...

改了.dcl的名字后，程序里应该做如下更改：(setq dcl_chain (load_dialog "chain"))改为(setq dcl_chain (load_dialog "链轮"))就可以了。
你的这个程序没有针对排数大于1的情况作任何动作
(if (= m 1)
(progn。。。））没有m等于2及以上的程序，所以画不出来。

xhq1954425

在CAD2008中不能运行？错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "osmode" nil

chg

我这个应该在CAD2000-2011都能正常运行，你这个变量不能被设置，还真不清楚是啥原因，这是一个经常设置的变量。