| 俊超's profile金地三维钢结构详图设计工作室PhotosBlogLists | Help |
There are no categories in use.
|
金地三维钢结构详图设计工作室www.tsdetailing.com April 03 两直线倒内直角 [原创][LISP]两垂直线倒内直角 ;======================== ;两垂直线倒内直角 ;2004.6.5 ljc ;======================== (defun c:dj( / l ll p1) (setq cm(getvar "cmdecho") os(getvar "osmode")) (setvar "cmdecho" 0) (setq l(car (nentsel "请选择直线1")) h1(getdist "线1切割值:") ll(car (nentsel "请选择直线2")) h2(getdist "线2切割值:") ) (setq p1 (inters (cdr (assoc 10 (entget l))) (cdr (assoc 11 (entget l))) (cdr (assoc 10 (entget ll))) (cdr (assoc 11 (entget ll))) nil)) (command "_chamfer" "d" h1 h2) (command) (command "_chamfer" l ll) (setq line(entlast)) (setvar "osmode" 0) (command "rectang" (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line))) ) (command "trim" line "" p1 "") (setvar "osmode" os) (command "erase" line "") (command "explode" (entlast) ) (setvar "cmdecho" cm) (print) )March 14 材料表输入
March 11 把spline变成铁路线示图;把spline变成铁路线示图 ;ljc 2004.3 (DEFUN O1O( name cd / cm tc os q zd qd ang qdz zdy w1 w2 w3 w4 p1p2 p3 p4 ) ;name--spline的图元名 cd铁路线的宽度 (setq cm(getvar "cmdecho") tc(getvar "clayer") os(getvar "osmode")) (command "osnap" "off") (setq cd(/ cd 2)) (setq q(entget name)) (setq Zd (cdr(assoc 10 q))) (setq qd (cdr(LAST q))) (SETQ ANG (ANGLE QD ZD)) (SETQ qdz (polar qd (+ ANG ( / PI 2)) cd)) (setq qdy (polar qd (- ANG ( / PI 2)) cd)) (command "offset" cd name qdz "") (setq w1(entlast)) (setq p1 (cdr(assoc 10 (entget w1)))) (setq p2 (cdr(last (entget w1)))) (command "offset" cd name qdy "") (setq w2(entlast)) (setq p4 (cdr(assoc 10 (entget w2)))) (setq p3 (cdr(last (entget w2)))) (command "line" p1 p4 "") (setq w3(entlast)) (command "line" p2 p3 "") (setq w4(entlast)) (command "-bhatch" "p" "solid" "s" w1 w2 w3 w4 "" "") (command "erase" w1 w2 w3 w4 name "") (setvar "cmdecho" cm) (setvar "osmode" os) (setvar "clayer" tc) ) (defun c:tl( / line n0 j linex q qd zd cdd ang qdz dqy) (setq cm(getvar "cmdecho") tc(getvar "clayer") os(getvar "osmode")) (command "osnap" "off") (print "请选择铁路线:") (print) (setq line (ssget '((0 . "SPLINE")))) (setq ds(getint "请输黑白段长度:")) (setq cd(getreal "请输入绘制铁路线的宽度:")) (command "ucs" "" "") (command "erase" (ssget "x" '((0 . "point"))) "") (setq n0 (sslength line)) (setq j 0 n2 0) (repeat n0 (setq linex (ssname line j)) (setq cdd(/ cd 2)) (setq q(entget linex)) (setq Zd (cdr(assoc 10 q))) (setq qd (cdr(LAST q))) (SETQ ANG (ANGLE QD ZD)) (SETQ qdz (polar qd (+ ANG ( / PI 2)) (* 10 cd))) (setq qdy (polar qd (- ANG ( / PI 2)) (* 10 cd))) (command "offset" cdd linex qdz linex qdy "") (command "measure" linex ds "") (command) (setq point (ssget "x" '((0 . "point")))) (setq n (sslength point)) (setq i 0 ii 0) (repeat n (setq p1 (cdr(assoc 10 (entget(ssname point i))))) (command "erase" (ssname point i) "") (command "zoom" "w" (polar p1 (* pi 0.75) ds ) (polar p1 (* pi -0.25) ds ) ) (command "break" (list (car p1) (cadr p1) (caddr p1)) "@" ) (if (= 2 ii) (setq ii 0)) (if (= 0 ii) (o1o (entlast) cd) (command "erase" (entlast) "")) (setq ii (1+ ii)) (setq i (+ i 1)) ) (setq j (+ j 1)) (if (= 2 ii) (o1o linex cd) (command "erase" linex "")) ) (command "zoom" "e" "") (setvar "cmdecho" cm) (setvar "osmode" os) (setvar "clayer" tc) ) (print "敲入tL运行程序---LJC") (PRINT) February 25 cad马蹄接管放样源代码;======================================================== ; ; 本程序适用于直斜锥台式连接钢板的实体放样. ; 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") |
||||
|
|