画椎椎、柱柱相贯线和展开图

fangmin723 · 发表于前天 11:30

通过三角函数计算点位

;;说明:绘制斜交圆锥管三通相贯线(Diagonal cone tube tee Intersecting line)
;;参数:BMinDN: 大椎小圆直径
;;参数:BMaxDN: 大椎大圆直径
;;参数:BHig: 大椎高度
;;参数:SMinDN: 小椎小圆直径
;;参数:SMaxDN: 小椎大圆直径
;;参数:SHig: 小椎高度
;;参数:CSubLen: 两椎中心轴交点距底面高度
;;参数:ang: 两椎相交角度
;;参数:divnum: 相贯线等分精度
;;(zuixiangguan 120 200 250 50 100 200 100 60.0 36.0)
;;(setq BMinDN 120 BMaxDN 200 BHig 250 SMinDN 50 SMaxDN 100 SHig 200 CSubLen 100 ang 60.0 divnum 12.0)
(defun zuixiangguan(BMinDN BMaxDN BHig SMinDN SMaxDN SHig CSubLen ang divnum / acos ang1011 anglst asidelen divdis divpts i intpt1 intpt2 intpt3 intpt4 intpts itmang itmr makeline makespl pt0 pt1 pt10 pt11 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 radius staper vlsorty)
(progn
(defun makeline (pt1 pt2) ; 画直线
(entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
)
(defun makespl (ptlst / pt); 画样条曲线
(entmakex
(append
(list '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(62 . 3) '(71 . 3))
(mapcar '(lambda (pt) (cons 11 pt) ) ptlst)
)
)
)
(defun acos (x) ; 反余弦
(if (<= (abs x) 1) (atan (sqrt (- 1 (* x x))) x))
)
(defun vlsorty (lst / e1 e2) ; 点按y排序
(vl-sort lst(function (lambda (e1 e2) (< (cadr e1) (cadr e2)))))
)
)
(vl-load-com)
;(setq BMinDN 120) ; 大椎小圆直径
;(setq BMaxDN 200) ; 大椎大圆直径
;(setq BHig 250) ; 大椎高度
;(setq SMinDN 50) ; 小椎小圆直径
;(setq SMaxDN 100) ; 小椎大圆直径
;(setq SHig 200) ; 小椎高度
;(setq CSubLen 100) ; 两椎中心轴交点距底面高度
;(setq ang 60.0) ; 两椎相交角度
;(setq divnum 12.0) ; 计算相贯线的精度
(if (setq pt0 (getpoint "插入点:"))
(progn
;;------计算点位和角度------
(setq ang (* ang (/ pi 180.0)))
(setq pt1 (list (- (car pt0) (* 0.5 BMaxDN)) (- (cadr pt0) CSubLen)))
(setq pt2 (list (- (car pt0) (* 0.5 BMinDN)) (+ (cadr pt0) (- BHig CSubLen))))
(setq pt3 (list (+ (car pt2) BMinDN) (cadr pt2)))
(setq pt4 (list (+ (car pt1) BMaxDN) (cadr pt1)))
(setq pt9 (polar pt0 (+ ang (* 0.5 pi)) SHig))
(setq pt5 (polar pt0 (+ ang pi) (* 0.5 SMaxDN)))
(setq pt6 (polar pt9 (+ ang pi) (* 0.5 SMinDN)))
(setq pt7 (polar pt9 ang (* 0.5 SMinDN)))
(setq pt8 (polar pt0 ang (* 0.5 SMaxDN)))
(setq STaper (atan (/ (* 0.5 (- SMaxDN SMinDN)) SHig)));;小锥锥度
(setq asidelen (* 0.5 SMaxDN (cos STaper)));;小锥底心到锥面的距离
(setq pt10 (inters pt1 pt2 pt5 pt6))
(setq pt11 (inters pt1 pt2 pt7 pt8))
(setq ang1011 (angle pt10 pt11))
;;======创建线条======
(makeline pt1 pt10)
(makeline pt11 pt2)
(makeline pt2 pt3)
(makeline pt3 pt4)
(makeline pt4 pt1)
(vlax-put-property (vlax-ename->vla-object (makeline pt5 pt10)) "color" 6)
(makeline pt10 pt6)
(makeline pt6 pt7)
(makeline pt7 pt11)
(vlax-put-property (vlax-ename->vla-object (makeline pt11 pt8)) "color" 6)
(vlax-put-property (vlax-ename->vla-object (makeline pt8 pt5)) "color" 6)
(vlax-put-property
(vlax-ename->vla-object
(makeline (list (car pt0) (cadr pt1)) (list (car pt0) (cadr pt2)))
)
"color" 1
)
(vlax-put-property (vlax-ename->vla-object (makeline pt0 pt9)) "color" 1)
;;======计算相贯线点位======
(setq divdis (/ (distance pt10 pt11) divnum) i 0 divpts nil)
(while (< (setq i (1+ i)) divnum)
(setq divpts (cons (polar pt10 ang1011 (* divdis i)) divpts))
)
(setq divpts (reverse divpts))
(setq anglst nil)
(foreach pt divpts
(setq radius (distance pt0 pt))
(setq anglst (cons (list (- (* pi 0.5) (acos (/ asidelen radius)) STaper) radius pt) anglst))
)
(setq anglst (vl-sort anglst '(lambda(x y) (> (car x) (car y)))))
(setq intpts nil intpts (cons pt10 intpts))
(foreach itm anglst
(setq itmang (car itm) itmr (cadr itm))
(setq intpt1 (caddr itm))
(setq intpt2 (list (car pt0) (cadr intpt1)))
(setq intpt3 (polar pt0 (+ ang (* 0.5 pi) itmang) itmr))
(setq intpt4 (polar pt0 (- (+ ang (* 0.5 pi)) itmang) itmr))
(setq intpts (cons (inters intpt1 intpt2 intpt3 intpt4) intpts))
)
(setq intpts (vlsorty (cons pt11 intpts)))
(makespl intpts) ; 绘制相贯线
)
)
(princ)
)

;;说明:绘制斜交圆锥管三通相贯线(Diagonal cone tube tee Intersecting line) 
;;参数:BMinDN:  大椎小圆直径 
;;参数:BMaxDN:  大椎大圆直径 
;;参数:BHig:    大椎高度 
;;参数:SMinDN:  小椎小圆直径 
;;参数:SMaxDN:  小椎大圆直径 
;;参数:SHig:    小椎高度 
;;参数:CSubLen:  两椎中心轴交点距底面高度 
;;参数:ang:      两椎相交角度 
;;参数:divnum:  相贯线等分精度 
;;(zuixiangguan 120 200 250 50 100 200 100 60.0 36.0) 
;;(setq BMinDN 120 BMaxDN 200 BHig 250 SMinDN 50 SMaxDN 100 SHig 200 CSubLen 100 ang 60.0 divnum 12.0) 
(defun zuixiangguan(BMinDN BMaxDN BHig SMinDN SMaxDN SHig CSubLen ang divnum / acos ang1011 anglst asidelen divdis divpts i intpt1 intpt2 intpt3 intpt4 intpts itmang itmr makeline makespl pt0 pt1 pt10 pt11 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 radius staper vlsorty) 
  (progn 
    (defun makeline (pt1 pt2)         ; 画直线 
      (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))) 
    ) 
    (defun makespl (ptlst / pt); 画样条曲线 
      (entmakex 
        (append 
          (list '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(62 . 3) '(71 . 3)) 
          (mapcar '(lambda (pt) (cons 11 pt) ) ptlst) 
        ) 
      ) 
    ) 
    (defun acos (x)           ; 反余弦 
      (if (<= (abs x) 1) (atan (sqrt (- 1 (* x x))) x)) 
    ) 
    (defun vlsorty (lst / e1 e2)         ; 点按y排序 
      (vl-sort lst(function (lambda (e1 e2) (< (cadr e1) (cadr e2))))) 
    ) 
  ) 
  (vl-load-com) 
  ;(setq BMinDN 120)             ; 大椎小圆直径 
  ;(setq BMaxDN 200)             ; 大椎大圆直径 
  ;(setq BHig 250)               ; 大椎高度 
  ;(setq SMinDN 50)               ; 小椎小圆直径 
  ;(setq SMaxDN 100)             ; 小椎大圆直径 
  ;(setq SHig 200)               ; 小椎高度 
  ;(setq CSubLen 100)             ; 两椎中心轴交点距底面高度 
  ;(setq ang 60.0)               ; 两椎相交角度 
  ;(setq divnum 12.0)             ; 计算相贯线的精度 
  (if (setq pt0 (getpoint "插入点:")) 
    (progn 
      ;;------计算点位和角度------ 
      (setq ang (* ang (/ pi 180.0))) 
      (setq pt1 (list (- (car pt0) (* 0.5 BMaxDN)) (- (cadr pt0) CSubLen))) 
      (setq pt2 (list (- (car pt0) (* 0.5 BMinDN)) (+ (cadr pt0) (- BHig CSubLen)))) 
      (setq pt3 (list (+ (car pt2) BMinDN) (cadr pt2))) 
      (setq pt4 (list (+ (car pt1) BMaxDN) (cadr pt1))) 
      (setq pt9 (polar pt0 (+ ang (* 0.5 pi)) SHig)) 
      (setq pt5 (polar pt0 (+ ang pi) (* 0.5 SMaxDN))) 
      (setq pt6 (polar pt9 (+ ang pi) (* 0.5 SMinDN))) 
      (setq pt7 (polar pt9 ang (* 0.5 SMinDN))) 
      (setq pt8 (polar pt0 ang (* 0.5 SMaxDN))) 
      (setq STaper (atan (/ (* 0.5 (- SMaxDN SMinDN)) SHig)));;小锥锥度 
      (setq asidelen (* 0.5 SMaxDN (cos STaper)));;小锥底心到锥面的距离 
      (setq pt10 (inters pt1 pt2 pt5 pt6)) 
      (setq pt11 (inters pt1 pt2 pt7 pt8)) 
      (setq ang1011 (angle pt10 pt11)) 
      ;;======创建线条====== 
      (makeline pt1 pt10) 
      (makeline pt11 pt2) 
      (makeline pt2 pt3) 
      (makeline pt3 pt4) 
      (makeline pt4 pt1) 
      (vlax-put-property (vlax-ename->vla-object (makeline pt5 pt10)) "color" 6) 
      (makeline pt10 pt6) 
      (makeline pt6 pt7) 
      (makeline pt7 pt11) 
      (vlax-put-property (vlax-ename->vla-object (makeline pt11 pt8)) "color" 6) 
      (vlax-put-property (vlax-ename->vla-object (makeline pt8 pt5)) "color" 6) 
      (vlax-put-property 
        (vlax-ename->vla-object 
          (makeline (list (car pt0) (cadr pt1)) (list (car pt0) (cadr pt2))) 
        ) 
        "color" 1 
      ) 
      (vlax-put-property (vlax-ename->vla-object (makeline pt0 pt9)) "color" 1) 
      ;;======计算相贯线点位====== 
      (setq divdis (/ (distance pt10 pt11) divnum) i 0 divpts nil) 
      (while (< (setq i (1+ i)) divnum) 
        (setq divpts (cons (polar pt10 ang1011 (* divdis i)) divpts)) 
      ) 
      (setq divpts (reverse divpts)) 
      (setq anglst nil) 
      (foreach pt divpts 
        (setq radius (distance pt0 pt)) 
        (setq anglst (cons (list (- (* pi 0.5) (acos (/ asidelen radius)) STaper) radius pt) anglst)) 
      ) 
      (setq anglst (vl-sort anglst '(lambda(x y) (> (car x) (car y))))) 
      (setq intpts nil intpts (cons pt10 intpts)) 
      (foreach itm anglst 
        (setq itmang (car itm) itmr (cadr itm)) 
        (setq intpt1 (caddr itm)) 
        (setq intpt2 (list (car pt0) (cadr intpt1))) 
        (setq intpt3 (polar pt0 (+ ang (* 0.5 pi) itmang) itmr)) 
        (setq intpt4 (polar pt0 (- (+ ang (* 0.5 pi)) itmang) itmr)) 
        (setq intpts (cons (inters intpt1 intpt2 intpt3 intpt4) intpts)) 
      ) 
      (setq intpts (vlsorty (cons pt11 intpts))) 
      (makespl intpts) ; 绘制相贯线 
    ) 
  ) 
  (princ) 
)

账号		自动登录	找回密码
密码			注册

[源码] 画椎椎、柱柱相贯线和展开图