CAD齿轮开发

飞龙

一、齿轮轮齿渐开渐开线

(defun c:gear(/)
(
setq
p0 (getpoint"输入齿轮中心p0: ")
m (getreal"输入齿轮模数M: ")
z (getint"输入齿轮齿数Z: ")
ha 1
c 0.25
a (/ pi 9)
ra(/ (* (+ z (+ ha ha)) m) 2)
rf(/ (* (- z (+ (+ ha ha) c)) m) 2)
r(/ ( * m z) 2)
rb ( * r (cos a))
ri rb
ang 0
g (polar p0 ang rb)
)
(command "circle" p0 ra)
(command "circle" p0 rf)
(command "circle" p0 r)
(command "line" g)

(while (< ri ra)
(setq
ang ( + ang(/ pi 360))
ri ( / rb (cos ang))
cta ( - (/ (sin ang) (cos ang)) ang)
g(polar p0 cta ri)
)

(command g)
)
(command )
)


二、螺旋源程序

(defun errMsg (s)
(if (/= s "function cancelled") (princ (strcat "\nError: " s)))
  ; 当命令执行时出现错误
(setvar "cmdecho" ocmdold)                         ; 例如用户按下了CTRL + C
(setvar "osmode" osmold)
(setq *error* olderr)   ; 恢复旧的错误处理
(princ)
)

(defun c:3Dthread (/ radouter threadpitch threadlength threadangle
            ptStart innerdiafactor radmid radinner ocmdold osmold 4H 5H 6H h6 g6)
  ;-------------------------------------------------------------------
  ; 获取公制外径大小、螺距总长
  ; 然后计算一系列几何点
  ; 并且关闭对象捕捉、命令回显
  ;-------------------------------------------------------------------
  (setq 4H (list 0.0015 0.002 0.002 0.0025 0.003 0.0035 0.004 0.005 0.006 0.007 0.008 0.009 0.010))   
  (setq 5H (list 0.002 0.0025 0.003 0.004 0.0045 0.0055 0.0065 0.0075 0.009 0.010 0.0115 0.0125 0.0135))   
  (setq 6H (list 0.003 0.004 0.0045 0.0055 0.0065 0.008 0.0095 0.011 0.0125 0.0145 0.016 0.018 0.020))   
  (setq h6 (list -0.003 -0.004 -0.0045 -0.0055 -0.0065 -0.008 -0.0095 -0.011 -0.0125 -0.0145 -0.016 -0.018 -0.020))   
  (setq g6 (list -0.005 -0.008 -0.0095 -0.0115 -0.0135 -0.017 -0.0195 -0.023 -0.0265 -0.0295 -0.033 -0.036 -0.0515))   

  (setq osmold (getvar "osmode"))   ; 保存调用前的osmode系统变量值
  (setq ocmdold (getvar "cmdecho"))   ; 保存调用前的cmdecho系统变量值
  (setvar "osmode" 0)   ; 关闭对象捕捉      
  (setvar "cmdecho" 0)                                   ; 关闭命令的回显

  (setq innerdiafactor 1.5)                               ; 设置内径系数
  (initget 7)                                         ; radmid 必须非零、非空、非负
  (setq radmid (getdist "\n公制外径: "))
  (initget 7)                                         ; threadpitch 必须非零、非空、非负
  (setq threadpitch (getreal "\n螺距: "))
  (initget 1)                                         ; ptStart 必须非空
  (setq ptStart (getpoint "\n起始点: "))
  (initget 3)                                         ; threadlength 必须非零、非空、非负
  (setq threadlength (getdist "\n螺纹总长(Y方向): "))

; 对公制外径添加公差
  (if (<= radmid 3) (setq order 0)                         ; 根据公制外径确定公差带中位置
  (if (<= radmid 6) (setq order 1)
  (if (<= radmid 10) (setq order 2)
  (if (<= radmid 18) (setq order 3)
  (if (<= radmid 30) (setq order 4)
  (if (<= radmid 50) (setq order 5)
  (if (<= radmid 80) (setq order 6)
  (if (<= radmid 120) (setq order 7)
  (if (<= radmid 180) (setq order 8)
  (if (<= radmid 250) (setq order 9)
  (if (<= radmid 315) (setq order 10)
  (if (<= radmid 400) (setq order 11)
  (if (<= radmid 500) (setq order 12)
  )))))))))))))

  (if (< threadpitch 0.25) (setq radmid (+ radmid (nth order 4H)))     ; 根据螺距确定公差带
  (if (< threadpitch 0.35) (setq radmid (+ radmid (nth order 5H)))
  (if (>= threadpitch 0.35) (setq radmid (+ radmid (nth order 6H)))
  )))
  
  (setq h (* 0.866025 threadpitch))                           ; 计算齿高
  (setq radouter (+ radmid (/ h 4)))                             ; 计算外径
  (setq radinner (- radouter (* h innerdiafactor)))                   ; 计算内径
  (setq threadangle (+ 30 0))                               ; 计算齿顶角

  (auxithread radouter radmid radinner threadpitch threadlength threadangle ptStart) ; 调用绘制三维螺纹的子函数

  (princ "\n三维螺纹创建完成")
  (setvar "osmode" osmold)   ; 恢复调用前的osmode系统变量值
  (setvar "cmdecho" ocmdold)   ; 恢复调用前的cmdecho系统变量值
  (princ)
)

(defun auxithread (radouter radmid radinner threadpitch threadlength threadangle ptStart / ttal pt1z ang pt1a
pt1az pt3a pt1b pt1bz pt3b pttmp1 pttmp2 pttmp3 pttmp4 pttmp5 pttmp6 pttmp7 pttmp8 pttmp9 pttmp10 pttmp11 pttmp12 tstmp startcone endcone)

  ;(command "undo" "begin")                   ; 开始undo步骤

  (setq ttal (+ (fix (/ (abs threadlength) threadpitch)) 3)
    pttmp1 (list (- (car ptStart) (/ radouter 2.0)) (cadr ptStart) (caddr ptStart))
    pt1z (list (- (car ptStart) (/ radouter 2.0)) (cadr ptStart) (+ (caddr pttmp1) 1.0))
    pttmp2 (polar pttmp1 (/ (* threadangle pi) 180.0) 1)
    pttmp3 (list (+ (car pttmp1) radouter) (+ (cadr pttmp1) (/ threadpitch 2.0)) (caddr ptStart))
    ang (angle pttmp1 pttmp3)
    pt1a (polar pttmp1 (+ ang (/ pi 2.0)) threadpitch)
    pt1az (list (car pt1a) (cadr pt1a) (+ (caddr pt1a) 1.0))
    pt3a (polar pt1a ang radouter)
    pt1b (polar pttmp1 (- ang (/ pi 2.0)) threadpitch)
    pt1bz (list (car pt1b) (cadr pt1b) (+ (caddr pt1b) 1.0))
    pt3b (polar pt1b ang radouter)
    pttmp4 (polar pttmp3 (/ (* (- 180 threadangle) pi) 180.0) 1)
    pttmp5 (inters pttmp1 pttmp2 pttmp3 pttmp4 nil)
    pttmp6 (list (car pttmp5) (cadr ptStart) (caddr ptStart))
    pttmp7 (polar pttmp1 (/ (* (- 360 threadangle) pi) 180.0) 1)
    pttmp8 (polar pttmp3 (/ (* (+ 180 threadangle) pi) 180.0) 1)
    pttmp9 (inters pttmp1 pttmp7 pttmp3 pttmp8 nil)
    pttmp10 (list (car pttmp9) (cadr pttmp3) (caddr pttmp3))
    pttmp11 (polar ptStart (/ pi 2.0) threadpitch)
    pttmp12 (polar pttmp11 (/ pi 2.0) (abs threadlength))
  )

  ;-------------------------------------------------------------------
  ; 绘制两个倒置的并偏移1/2螺距的圆锥
  ; 这两个圆锥都以中剖面剖分
  ; 进行并集运算
  ;-------------------------------------------------------------------

(SETQ startcone "order")
(SETQ endcone "Y")
  (command "zoom" "w" (list (car pt1a) (+ (cadr pt1a) (abs threadlength)) (caddr pt1a)) pt3b)

  (princ "\n正在绘制三维螺纹，请等待")
  (command "pline" pttmp1 pttmp5 pttmp6 "c")
  (command "revolve" "l" "" pttmp5 pttmp6 "")
  (command "slice" "l" "" pttmp1 pttmp3 pt1z pttmp5)
  (command "slice" "l" "" pt1a pt3a pt1az pttmp3)
  (setq tstmp (ssadd (entlast)))
  (command "pline" pttmp3 pttmp9 pttmp10 "c")
  (command "revolve" "l" "" pttmp9 pttmp10 "")
  (command "slice" "l" "" pttmp1 pttmp3 pt1z pttmp9)
  (command "slice" "l" "" pt1b pt3b pt1bz pttmp3)
  (setq tstmp (ssadd (entlast) tstmp))
  (command "union" tstmp "")

  ;-------------------------------------------------------------------
  ; 上面的实体被剖切成两份，然后进行镜像以获得螺旋线的螺旋
  ; 单线的高度实际上等于两倍螺距，但是超出或者是在内部或者是
  ; 在最后一步被切除
  ;-------------------------------------------------------------------

  (command "slice" tstmp "" "xy" ptStart "b")
  (setq tstmp (ssadd (entlast) tstmp))
  (command "mirror" "l" "" pttmp1 "@10<0" "y")
  (command "union" tstmp "")

  ;-------------------------------------------------------------------
  ; 螺旋进行阵列操作，然后再作并集（可能会耗费一定时间）
  ; 得到的实体再切除到指定的螺旋高度
  ;-------------------------------------------------------------------

  (setq e (entlast))
  (command "array" tstmp "" "r" ttal 1 threadpitch)
  (repeat (1- ttal)
    (setq e (entnext e)
      tstmp (ssadd e tstmp)
    )
  )
  (command "union" tstmp "")

; 若开始创建45度的圆锥
  (if (/= startcone "order")
  (progn (setq e (entlast))
  (command "cone" (list (car ptStart) (+ (cadr ptStart) threadpitch) (caddr ptStart)) "d" radmid "a" (list (car ptStart) (+ (+ (cadr ptStart) (/ radmid 2)) threadpitch) (caddr ptStart)))
  (command "union" "l" e "")
  )
  )

  (command "slice" "l" "" "zx" pttmp11 pttmp12)
  (command "slice" "l" "" "zx" pttmp12 pttmp11)
  (command "move" "l" "" ptStart (list (car ptStart) (- (cadr ptStart) threadpitch) (caddr ptStart)))

; 创建最小直径的圆柱体，然后与螺旋作交集
  (setq e (entlast))
  (command "cylinder" ptStart "d" radinner "c" (list (car ptStart) (+ (cadr ptStart) (abs threadlength)) (caddr ptStart)))
  (command "union" "l" e "")
  (setq tstmp (entlast))

; 创建中空的圆柱体
  (command "cylinder" ptStart "d" radmid "c" (list (car ptStart) (+ (cadr ptStart) (abs threadlength)) (caddr ptStart)))   ; minor dia
  (setq e (entlast))

; 若最后创建45度的圆锥
  (if (/= endcone "order")
  (progn (command "move" "l" "" ptStart (list (car ptStart) (- (cadr ptStart) (/ (- radmid radinner) 2)) (caddr ptStart)))     
  (command "cone" ptStart "d" radmid "a" (list (car ptStart) (+ (cadr ptStart) (/ radmid 2)) (caddr ptStart)))
  (command "move" "l" "" ptStart (list (car ptStart) (- (+ (cadr ptStart) (abs threadlength)) (/ (- radmid radinner) 2)) (caddr ptStart)))
  (command "union" "l" e "")           
  (setq e (entlast))
  )
  )

; 从大圆柱中减去小直径圆柱
  (command "cylinder" ptStart "d" (* radmid 1.5) "c" (list (car ptStart) (+ (cadr ptStart) (abs threadlength)) (caddr ptStart)))
  (command "subtract" "l" "" e "")
  (setq e (entlast))

; 从螺旋中减去圆柱
  (command "subtract" tstmp "" e "")

; 如果螺旋长度为负然后镜像
  (setq e (entlast))
  (if (< threadlength 0) (mirror3d e "zx" ptStart "y"))

  (command "zoom" "p")
;   (command "undo" "end")                       ; 结束undo步骤
)

;;;---------------------------------------------------------------------------------------------------------------------;
(arxload "geom3d" nil)
(princ "\n3DThread 已加载。 ")
(princ)

三、弹簧源程序

(defun errMsg (s)             ; 当命令执行时出现错误
                        ; 例如用户按下了CTRL + C
(if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
)
(setvar "cmdecho" cmdch)         ; 恢复调用前的cmdecho系统变量值
(setvar "blipmode" blpmd)     ; 恢复调用前的blipmode系统变量值
(setq *error* olderror)         ; 恢复旧的错误处理
(princ)
)

(defun spring (nRepeat cntPoint bhfac lr strad bvfac
          / angle distnc tp aGrw dhGrw dvGrw Pi2 dv)

(setvar "blipmode" 0)           ; 关闭 blipmode
(setvar "cmdecho" 0)           ; 关闭 cmdecho
(setq Pi2 (* 3.14159265 2))
(setq aGrw (/ Pi2 lr))
(setq dhGrw (/ bhfac lr))
(if bvfac (setq dvGrw (/ bvfac lr)))
(setq angle 0.0)
(if bvfac
  (setq distnc strad dv 0.0)
  (setq distnc 0.0)
)
(if bvfac
  (command "3dpoly")           ; 开始绘制弹簧
  (command "pline" cntPoint)       ; 从基点开始绘制弹簧
)
(repeat nRepeat
  (repeat lr
    (setq tp (polar cntPoint (setq angle (+ angle aGrw))
              (setq distnc (+ distnc dhGrw))
          )
    )
    (if bvfac
      (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
          dv (+ dv dvGrw)
      )
    )
    (command tp)             ; 继续输入下一点
  )
)
(command "")                 ; 输入结束
(princ)
)

;;;
;;;     生成三维弹簧函数调用接口
;;;

(defun C:3DSPRING (/ olderror cmdch blpmd cntPt RottCnt horiGrw vertGrw bgnRdtn ptCntPerCircle)
(setq cmdch (getvar "cmdecho"))     ; 获取cmdecho值，以便调用结束后恢复
(setq blpmd (getvar "blipmode"))   ; 获取blipmode值，以便调用结束后恢复
(setvar "cmdecho" 0)     ; 关闭 cmdecho
(initget 1)                 ; cntPt 必须非空
(setq cntPt (getpoint "\n请输入底部中心点: "))
(initget 7)                 ; RottCnt 必须非零、非空,不可忽略
(setq RottCnt (getint "\n旋转的圈数: "))
(initget 7)                 ; bgnRdtn 必须非零、非空,不可忽略
(setq bgnRdtn (getdist cntPt "\n起始半径: "))
(initget 1)                 ; cf 必须非零、非空
(setq horiGrw (getdist "\n每一圈的水平增长距离: "))
(initget 3)                 ; cf 必须非零、非空
(setq vertGrw (getdist "\n每一圈的垂直增长距离: "))
(initget 6)                 ; ptCntPerCircle 必须非零、不可忽略
(setq ptCntPerCircle (getint "\n每一圈的插值点数<35>: "))
(cond ((null ptCntPerCircle) (setq ptCntPerCircle 35)))
(spring RottCnt cntPt horiGrw ptCntPerCircle bgnRdtn vertGrw)
(setvar "cmdecho" cmdch) ; 恢复调用前的cmdecho系统变量值
(setvar "blipmode" blpmd) ; 恢复调用前的blipmode系统变量值
(setq *error* olderror)           ; Restore old *error* handler
(princ)

飞龙

＂显示选择文件夹对话框＂的源码
(defun getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
  catchit (vl-catch-all-apply
    '(lambda ()
  (setq shFolder (vlax-get-property shFolder 'self))
  (setq path (vlax-get-property shFolder 'path))
    )
  )
)
(if (vl-catch-all-error-p catchit)
  nil
  path
)
)


;; 用法：(getFolder msg)
;; 例子：(getFolder "选择文件夹:")
;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil

飞龙

修改过尺寸变色显示
;;如尺寸值與文本一致，則文本不變色，否則文本被修改但顏色
;;變如紅色，這樣用戶對這個功能會更好理解也容易維護。
;;BY LUCAS
(defun C:TT (/ SS N VOBJ)
  (setq SS (ssget "X" '((0 . "DIMENSION")))
N  0
  )
  (repeat (sslength SS)
    (setq VOBJ (vlax-ename->vla-object (ssname SS N)))
    (if (and VOBJ
      (vlax-read-enabled-p VOBJ)
      (not (wcmatch (vla-get-textoverride VOBJ) "*<>*,"))
      (vlax-write-enabled-p VOBJ)
)
      (vla-put-textcolor VOBJ 1)
    )
    (setq N (1+ N))
  )
  (princ)
)

飞龙

多义线长度标注 (defun c:pdim()
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq scal (getvar "dimlfac"))
  (setq en (entsel)
pt (cadr en)
        ename (car en)
eobject (vlax-ename->vla-object ename)
pt (vlax-curve-getclosestpointto eobject pt)
paramNo (vlax-curve-getparamatpoint eobject pt)
paramNo (fix paramNo)
len     (- (vlax-curve-getdistatparam eobject (1+ paramNo))
     (vlax-curve-getdistatparam eobject paramNo))
  )
  (setq len (/ len scal))
  (vl-cmdf "dimangular" pt "t" (rtos len 2 1) (getpoint"给出标注的位置:"))
  (setvar "cmdecho" 1)

zsdsun

这是一个网上下的齿轮外挂应用程序
在CAD中加载可以用
不会使用的可以与我交流
QQ36414371

yawqyy

ding

ljy0903

顶！！！！！

gohaodo

谢谢了 找了好久了

oucegen

谢谢分享!!

villard