轴截断面,管道截断面 支持同一根多段线
轴截断面,管道截断面 支持同一根多段线;;轴截断面,管道截断面 支持多段线
;;code by edata @mjtd
;;2014-5-26
(defun sk_mkpl02(lst sk_lay sk_col sk_lt sk_lts sk_lw)
(entmakex
(append(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 (if sk_lay sk_lay (getvar 'clayer)))
(cons 62 (if sk_col sk_col 256))
(cons 6 (if sk_lt sk_lt (getvar 'celtype)))
(cons 48 (if sk_lts sk_lts (getvar 'celtscale)))
(cons 370 (if sk_lw sk_lw (getvar 'celweight)))
)
lst
)
)
)
(defun *error*_jdx (msg)
(if *error*_jdx0(setq *error* *error*_jdx0))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(if(= (getvar "LOCALE") "CHS")
(princ "\n用户按了<Esc>强制退出")
(princ "\nYou cancelled The operation!")
)
(princ (strcat "\n" msg))
)
(progn
(and en1(redraw (car en1) 4))
(and en2(redraw (car en2) 4))
)
(if(= (getvar 'cmdecho) 0)(setvar 'cmdecho 1))
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
;;;计算cp到p1 p2的垂足点
(defun PerToLine(cp p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
cp (trans cp 0 norm)
)
(trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)
(defun sk_ty (ent lst)
(member(cdr(assoc 0 (entget ent)))(mapcar 'strcase lst))
)
(defun sk_dxf(ent code)(cdr(assoc code(entget ent))))
(defun c:tt(/ ang1 b_hd cmpt c_pt1 c_pt2 ds1 e1 e2 elast1 elast2 elist1 elist2 elist3 elist4 en1 en2 index0 index0+ index00 index00+
indexend lst1 lst2 lst3 lst4 obj p0 p00 p00x p0x p1 p2 p3 p4 pl1 pl2 pl3 pl4 px1 px2 px3 px4 x y
e1_lay e1_col e1_lt e1_lts e1_lw)
(vl-load-com)
(setq *error*_jdx0 *error*) ;保存出错处理函数
(setq *error* *error*_jdx)
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lst1'((90 . 6)(10 -0.175 5.55112e-017)(42 . -0.305615)(10 -0.0822974 -0.4375)(42 . -0.6742)(10 -0.267702 -0.4375)(42 . -0.305615)
(10 -0.175 -5.55112e-017)(42 . 0.305615)(10 -0.0822974 0.4375)(42 . 0.305615)(10 -0.175 0.5)(42 . 0.0))
lst2'((90 . 6)(10 0.175 -5.55112e-017)(42 . -0.305615)(10 0.0822974 0.4375)(42 . -0.6742)(10 0.267702 0.4375)(42 . -0.305615)
(10 0.175 5.55112e-017)(42 . 0.305615)(10 0.0822974 -0.4375)(42 . 0.305615)(10 0.175 -0.5)(42 . 0.0))
lst3'((90 . 3)(70 . 1)(10 -0.175 0.0)(42 . 0.305615)(10 -0.267702 -0.4375)(42 . 0.6742)(10 -0.0822974 -0.4375)(42 . 0.305615))
lst4'((90 . 3)(70 . 1)(10 0.267702 0.4375)(42 . 0.6742)(10 0.0822974 0.4375)(42 . 0.305615)(10 0.175 0.0)(42 . 0.305615))
)
(command nil)
(if(and(setq en1(entsel "\n请选择第一条线:"))
(sk_ty (car en1) '("line" "lwpolyline"))
(car(list t(redraw (car en1) 3)))
(setq en2(entsel "\n请选择第二条线:"))
(sk_ty (car en2) '("line" "lwpolyline"))
(car(list t(redraw (car en2) 3)))
)
(progn
(cond
((and (sk_ty (car en1)'("line"))
(sk_ty (car en2)'("line"))
(/=(sk_dxf (car en1) 5)(sk_dxf (car en2) 5)))
(setq e1(car en1)
e2(car en2)
p0(cadr en1)
p1(sk_dxf e1 10)
p2(sk_dxf e1 11)
p3(sk_dxf e2 10)
p4(sk_dxf e2 11)
c_pt1(PerToLine p0 p1 p2)
c_pt2(PerToLine p0 p3 p4)
ang1 (angle c_pt1 c_pt2)
cmpt(mapcar'(lambda(x y)(* 0.5(+ x y))) c_pt1 c_pt2)
)
(if (inters p1 p2 p3 p4 nil)
(princ "\n两条直线不平行.")
(progn
(princ "\n平行直线.")
(setq ds1 (distance c_pt1 c_pt2)
px1(polar c_pt1 (angle p1 p2) (* 0.175 ds1))
px2(polar c_pt1 (angle p2 p1) (* 0.175 ds1))
px3(polar c_pt2 (angle p3 p4) (* 0.175 ds1))
px4(polar c_pt2 (angle p4 p3) (* 0.175 ds1))
)
(if(setq b_hd (getreal (strcat "\n输入壁厚(0/小于当前半径" (rtos (* 0.5 ds1) 2 ) "):")))(princ)(setq b_hd 0))
(if
(and b_hd
(> (distance c_pt1 p1)(distance c_pt1 px2))
(> (distance c_pt1 p2)(distance c_pt1 px1))
(> (distance c_pt2 p3)(distance c_pt2 px4))
(> (distance c_pt2 p4)(distance c_pt2 px3))
(or(< (* b_hd 2) ds1 ) (= b_hd 0)))
(progn
(setq elist1(entget e1)
elist2(entget e2)
elist3(subst(cons 11 px2)(assoc 11 elist1)elist1)
elist4(subst(cons 11 px4)(assoc 11 elist2)elist2))
(entmod(subst(cons 10 px1)(assoc 10 elist1)elist1))
(entmod(subst(cons 10 px3)(assoc 10 elist2)elist2))
(entmake elist3)
(entmake elist4)
(setvar 'cmdecho 0)
(setq e1_lay (sk_dxf e1 8)
e1_col (sk_dxf e1 62)
e1_lt (sk_dxf e1 6)
e1_lts (sk_dxf e1 48)
e1_lw (sk_dxf e1 370))
(setq pl1(sk_mkpl02 lst1 e1_lay e1_col e1_lt e1_lts e1_lw)
pl2(sk_mkpl02 lst2 e1_lay e1_col e1_lt e1_lts e1_lw))
(if(zerop b_hd)
(princ)
(progn
(setq pl3(sk_mkpl02 lst3 e1_lay e1_col e1_lt e1_lts e1_lw)
pl4(sk_mkpl02 lst4 e1_lay e1_col e1_lt e1_lts e1_lw))
(command "_.move" pl3 pl4 "" "_non" "0,0" "_non" cmpt)
(command "_.rotate" pl3 pl4 "" "_non" cmpt "r" "_non" cmpt "_non" (polar cmpt (* 0.5 pi) 1)"_non" c_pt1)
(command "_.scale" pl3 pl4 "" "_non" cmpt ds1)
(command "_.scale" pl3"" (polar cmpt (+ ang1(* 1.5 pi)) (* 0.175 ds1)) "r" "_non" ds1 "_non" (- ds1 (* b_hd 2)))
(command "_.scale" pl4 "" (polar cmpt (+ ang1(* 0.5 pi)) (* 0.175 ds1)) "r" "_non" ds1 "_non" (- ds1 (* b_hd 2)))
)
)
(command "_.move" pl1 pl2 "" "_non" "0,0" "_non" cmpt)
(command "_.rotate" pl1 pl2 "" "_non" cmpt "r" "_non" cmpt "_non" (polar cmpt (* 0.5 pi) 1)"_non" c_pt1)
(command "_.scale" pl1 pl2"" "_non" cmpt ds1)
(setvar 'cmdecho 1)
)
(princ "\n截面距离不够,无法生成.")
)
)
)
)
((and (sk_ty (car en1)'("lwpolyline"))
(sk_ty (car en2)'("lwpolyline"))
(=(sk_dxf (car en1) 5)(sk_dxf (car en2) 5)))
(princ "\n多段线.")
(setq p0(cadr en1)
p00(cadr en2)
e1(car en1)
obj(vlax-ename->vla-object e1)
p0x(vlax-curve-getClosestPointTo obj p0)
p00x(vlax-curve-getClosestPointTo obj p00)
index0(fix(vlax-curve-getParamAtPoint obj p0x))
index00(fix(vlax-curve-getParamAtPoint obj p00x))
indexend(fix(vlax-curve-getEndParam obj))
)
(if (vlax-curve-isClosed obj)
(setq indexend(1- indexend))
)
(setq index0+ (if (= index0 indexend) 0 (1+ index0) ))
(setq index00+ (if (= index00 indexend) 0 (1+ index00) ))
(setq p1(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj index0)))
p2(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj index0+)))
p3(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj index00)))
p4(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj index00+)))
c_pt1(PerToLine p0 p1 p2)
c_pt2(PerToLine p0 p3 p4)
ang1 (angle c_pt1 c_pt2)
cmpt(mapcar'(lambda(x y)(* 0.5(+ x y))) c_pt1 c_pt2)
)
(if (or(not(>(distance c_pt1 c_pt2) 0))(inters p1 p2 p3 p4 nil))
(princ "\n两条直线不平行.")
(progn
(princ "\n平行直线.")
(setq ds1 (distance c_pt1 c_pt2)
px1(polar c_pt1 (angle p1 p2) (* 0.175 ds1))
px2(polar c_pt1 (angle p2 p1) (* 0.175 ds1))
px3(polar c_pt2 (angle p3 p4) (* 0.175 ds1))
px4(polar c_pt2 (angle p4 p3) (* 0.175 ds1))
)
(if(setq b_hd (getreal (strcat "\n输入壁厚(0/小于当前半径" (rtos (* 0.5 ds1) 2 ) "):")))(princ)(setq b_hd 0))
(if
(and b_hd
(> (distance c_pt1 p1)(distance c_pt1 px2))
(> (distance c_pt1 p2)(distance c_pt1 px1))
(> (distance c_pt2 p3)(distance c_pt2 px4))
(> (distance c_pt2 p4)(distance c_pt2 px3))
(or(< (* b_hd 2) ds1 ) (= b_hd 0)))
(progn
(setvar 'cmdecho 0)
(setq e1_lay (sk_dxf e1 8)
e1_col (sk_dxf e1 62)
e1_lt (sk_dxf e1 6)
e1_lts (sk_dxf e1 48)
e1_lw (sk_dxf e1 370))
(setq elast1(entlast))
(command "_.break" e1 "_non" px1 "_non" px2)
(setq elast2(entlast))
(command "_.break" e1 "_non" px3 "_non" px4)
(if (/= (sk_dxf elast1 5)(sk_dxf elast2 5))
(command "_.break" elast2 "_non" px3 "_non" px4))
(setq pl1(sk_mkpl02 lst1 e1_lay e1_col e1_lt e1_lts e1_lw)
pl2(sk_mkpl02 lst2 e1_lay e1_col e1_lt e1_lts e1_lw))
(if(zerop b_hd)
(princ)
(progn
(setq pl3(sk_mkpl02 lst3 e1_lay e1_col e1_lt e1_lts e1_lw)
pl4(sk_mkpl02 lst4 e1_lay e1_col e1_lt e1_lts e1_lw))
(command "_.move" pl3 pl4 "" "_non" "0,0" "_non" cmpt)
(command "_.rotate" pl3 pl4 "" "_non" cmpt "r" "_non" cmpt "_non" (polar cmpt (* 0.5 pi) 1)"_non" c_pt1)
(command "_.scale" pl3 pl4 "" "_non" cmpt ds1)
(command "_.scale" pl3"" (polar cmpt (+ ang1(* 1.5 pi)) (* 0.175 ds1)) "r" "_non" ds1 "_non" (- ds1 (* b_hd 2)))
(command "_.scale" pl4 "" (polar cmpt (+ ang1(* 0.5 pi)) (* 0.175 ds1)) "r" "_non" ds1 "_non" (- ds1 (* b_hd 2)))
)
)
(command "_.move" pl1 pl2 "" "_non" "0,0" "_non" cmpt)
(command "_.rotate" pl1 pl2 "" "_non" cmpt "r" "_non" cmpt "_non" (polar cmpt (* 0.5 pi) 1)"_non" c_pt1)
(command "_.scale" pl1 pl2"" "_non" cmpt ds1)
(setvar 'cmdecho 1)
)
(princ "\n截面距离不够,无法生成.")
)
)
)
)
(t (princ"\n选择无效,无法生成,请选择平行直线或同一条多段线上的平行线。"))
);cond
)
)
(progn
(and en1(redraw (car en1) 4))
(and en2(redraw (car en2) 4))
)
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(if *error*_jdx0(setq *error* *error*_jdx0))
(princ)
)
学习了谢谢！ 感谢Ｅ大的源码 感谢分享源码~
有时候还是会用到~ 感谢分享好的程序 很实用的程序啊 轴截断面,管道截断面图要的就是这个效果，感谢楼主的无私奉献！ 学习，谢谢！ 非常棒，感谢楼主！ 感谢 edata 分享程序! 感谢楼主分享。。。。