马蹄型圆管接口放样

ljcgq

;========================================================
;
; 本程序适用于直斜锥台式连接钢板的实体放样.
; 2000.6.8 LJC
; 2000.5.30 2000.6.10
;
;========================================================
(defun c:mt()
(setq d(getreal "请输入大管直径 d=:"))
(setq d1(getreal "请输入小管直径 d1=:"))
(setq h(getreal "请输入直斜锥台高h=:"))
(setq b1(getpoint "\n请选取放样中心: "))
(command "ucsicon" "on" )
(command "ucsicon" "or" )
(setq ang3 0)
(command "ucs" "o" b1)
(setq h0 (/ (* d h) (- d d1)) )
(setq i(* pi d1))
(setq i(fix i))
(setq ang(/ (/ pi 2) i))
(setq ang0 0)
(setq j 0)
(setq l(sqrt (+(expt d 2)(expt h0 2))))
(setq pt1(list l 0 0))
(command "pline" pt1)

(repeat i
(setq J(+ j 1))
(setq ang1(+ ang0 (* ang j)))
(setq ang2(+ ang1 ang))
(setq m(* d (cos ang1)))
(setq n(* d (cos ang2)))
(setq z1(+ (expt m 2) (expt n 2)))
(setq z2 (cos ang ))
(setq z(sqrt (- z1 (* 2(* m ( * n z2))))))
(setq X(SQRT (+ (expt m 2) (expt h0 2))))
(setq y(SQRT (+ (expt n 2) (expt h0 2))))
(setq z3(+ (expt x 2) (expt y 2)))
(setq cos0 ( /(- z3 (expt z 2)) (* 2 (* x y ))))
(setq tg0 (SQRT (- (expt (/ 1 cos0) 2) 1)))
(setq ang0 (atan tg0))
(setq ang3(+ ang3 ang0))
(setq a(* x (cos ang3)))
(setq b(* x (sin ang3)))
(setq pt(list a b ))
(command pt)
(princ"正在生成,请稍等!! ")
)
(setq ptt pt)
(command "")
:=========================================================

(setq ang0 0)
(setq j 0)
(setq d d1)
(setq ang3 0)
(setq h0(- h0 h))
(setq l(sqrt (+(expt d 2)(expt h0 2))))
(setq pt2(list l 0 0))
(command "pline" pt2)
(setq i(* pi d1))
(setq i(fix i))
(setq ang(/ (/ pi 2) i))
(repeat i
(setq J(+ j 1))
(setq ang1(+ ang0 (* ang j)))
(setq ang2(+ ang1 ang))
(setq m(* d (cos ang1)))
(setq n(* d (cos ang2)))
(setq z1(+ (expt m 2) (expt n 2)))
(setq z2 (cos ang ))
(setq z(sqrt (- z1 (* 2(* m ( * n z2))))))
(setq X(SQRT (+ (expt m 2) (expt h0 2))))
(setq y(SQRT (+ (expt n 2) (expt h0 2))))
(setq z3(+ (expt x 2) (expt y 2)))
(setq cos0 ( /(- z3 (expt z 2)) (* 2 (* x y ))))
(setq tg0 (SQRT (- (expt (/ 1 cos0) 2) 1)))
(setq ang0 (atan tg0))
(setq ang3(+ ang3 ang0))
(setq a(* x (cos ang3)))
(setq b(* x (sin ang3)))
(setq pt(list a b ))
(command pt)
(princ"正在生成,请稍等!! ")
)
(command "")
(setq ptt2 pt)
(command "line" ptt ptt2 "") ;==========================================================
(setq dimtext0(getvar "dimtxt"))
(setq dimtsz0 (getvar "dimtsz"))
(setvar "dimtxt" (/ h0 8))
(setvar "dimtsz" (/ h0 20))
;--------------------------------------
(setq qx(nth 0 ptt))
(setq qx1(+ 2 qx))
(setq qy(nth 1 ptt))
(setq dimqy(+ h qy))
(setq dimqy1(* -1 dimqy))
(setq dimptt(list qx1 dimqy))
(setq dimptt1(list qx1 dimqy1))
(setq ptk1(list -1 -1))
(COMMAND "ZOOM" DIMPTT PTK1)
(setq s(ssget "c" dimptt ptk1))
(command "mirror" s "" pt1 pt2 "" )
;--------------------------------------
(command "dimlinear" ptt2 pt1 dimptt )
;--------------------------------------------------
(setq qx2(nth 0 ptt2))
(setq qy2(nth 1 ptt2))
(setq qy3(* -1 qy2))
(setq dimqx2(- qx2 (/ h 3)))
(setq dimptt4(list qx2 qy3))
(setq dimptt3(list dimqx2 qy2))
(command "dimlinear" ptt2 dimptt4 dimptt3 )
;----------------------------------------------
(setq qy1(* -1 qy))
(setq miptt(list qx qy1))
(setq qx1(nth 0 pt1))
(setq qy1(nth 1 pt1))
(setq dimqx1(+ (/ h 3) qx1))
(setq dimpt1(list dimqx1 qy1))
(command "dimlinear" ptt miptt dimpt1 )
(setq dimqx5(* 1.2 dimqx1))
(setq dimptt2(list dimqx5 qy1))
(setq b1 (list 0 0))
(Command "dimangular" "" b1 ptt miptt dimptt2 )
(Command "dimaligned" ptt2 ptt dimptt)
(command "ucsicon" "off" )
;--------------------------------------------------
(setvar "dimtxt" dimtext0)
(setvar "dimtsz" dimtsz0)
(COMMAND "ZOOM" "E")
)

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！

ljcgq

看来明经做钢结构的认真的是太少了，好像大家对这个、贴子一点也不感兴趣。

王咣生

可能是专业性质不同吧, 不过从您的程序结构,条理足可见思维的严谨.

龙龙仔

没办法我也只会些猪肉零售, 钢结构…… 8-(

ljcgq

谢谢斑竹门的捧场。。

CADghost

哥们和你是同行，为我们这些明经的稀有动物


顶

sztk2001

可惜我不是搞钢结构的

az98hxq

经常为这样的事情烦恼


坚决支持顶

yuweng

希望多发些这样的帖子。你那有那些给各种角度管子的马鞍口放样的LISP程序吗？

lzws03

版主，您把　lsp　语句帖出来，大家看得很清楚，如果您再把这个 .lsp程序做个附件传上来，再写一个使用说明，这样大家都会感觉很方便的。您说呢?


每位朋友的CAD水平都不一样，所以您做　lsp　程序时最好把使用说明写详细一点，这样才能达到您那“好东西与大家分享”的初衷呀！