挂台命令
本帖最后由 Gu_xl 于 2014-6-13 10:42 编辑如图所示,请问那位大师有这样的挂台命令呀.谢谢了
xyp1964 发表于 2014-6-14 13:27
;; 也玩挂台
你好，此挂台外挂可以发给我吗？谢谢 描述的 不是很清楚有点没看懂 你想干什么呢？说清楚点吧…… 模具行业的我能看懂。。。就是不会写 本帖最后由 edata 于 2014-6-13 17:21 编辑
(defun c:tt(/ ang1 ang2 ang3 ds1 e e1 e2 e3 e4 e5 e6 e7 e8 e9 elist en en2 en4 en5 en6 en7 en8 en9 enindex k l mpt newp3 newp4 newp5 newp6 obj obj2 p0 p1 p1index p2 p2index p3 p4 p42 p5 p52 p6 pp ppcx y)
(if(and(setq en(entsel "\n 选择切线位置: "))
(or(= (cdr(assoc 0 (entget(car en)))) "LINE")
(= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")
)
(car(list t(redraw (car en) 3)))
(setq l(getdist "\n 长度: "))
(setq k(getdist "\n 宽度: ")))
(progn
(setq p0(cadr en)
e(car en)
elist (entget e))
(if (not(tblobjname "ltype" "hidden"))
(entmake '((0 . "LTYPE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLinetypeTableRecord")
(2 . "HIDDEN") (70 . 0)
(3 . "Hidden __ __ __ __ __ __ __ __ __ __ __ __ __ _")
(72 . 65) (73 . 2) (40 . 9.525) (49 . 6.35) (74 . 0)
(49 . -3.175) (74 . 0)))
)
(cond
((= (cdr(assoc 0 (entget e))) "LINE")
(setq p1(cdr(assoc 10 elist))
p2(cdr(assoc 11 elist))
ds1(distance p1 p2)
mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)
)
(if (and (> l 0)(> k 0)(< l ds1))
(progn
(setq ang1(angle p1 p2)
ang2(+ ang1 (* pi 0.5))
ang3(+ ang1 (* pi 1.5))
p3 (polar mpt ang1 (* (* l 0.5) -1))
p4 (polar p3 ang2 k)
p6 (polar mpt ang1 (* l 0.5))
p5 (polar p6 ang2 k)
p42 (polar p3 ang3 k)
p52 (polar p6 ang3 k)
)
(setq e1 elist
e2 elist
e3 elist
e4 elist
e5 elist
e6 elist
e7 elist
e8 elist
e9 elist
e3(subst(cons 10 p6)(assoc 10 e3)e3)
e3(subst(cons 11 p3)(assoc 11 e3)e3)
e3(if(assoc 6 e3)
(subst(cons 6 "HIDDEN")(assoc 6 e3)e3)
(reverse(cons(cons 6 "HIDDEN")(reverse e3))))
e3(if(assoc 62 e3)
(subst(cons 62 1)(assoc 62 e3)e3)
(reverse(cons(cons 62 1)(reverse e3))))
e4(subst(cons 10 p3)(assoc 10 e4)e4)
e4(subst(cons 11 p4)(assoc 11 e4)e4)
e5(subst(cons 10 p4)(assoc 10 e5)e5)
e5(subst(cons 11 p5)(assoc 11 e5)e5)
e6(subst(cons 10 p5)(assoc 10 e6)e6)
e6(subst(cons 11 p6)(assoc 11 e6)e6)
e7(subst(cons 10 p3)(assoc 10 e7)e7)
e7(subst(cons 11 p42)(assoc 11 e7)e7)
e8(subst(cons 10 p42)(assoc 10 e8)e8)
e8(subst(cons 11 p52)(assoc 11 e8)e8)
e9(subst(cons 10 p52)(assoc 10 e9)e9)
e9(subst(cons 11 p6)(assoc 11 e9)e9)
)
(entmod(subst(cons 11 p3)(assoc 11 e1)e1))
(entmake (subst(cons 10 p6)(assoc 10 e2)e2))
(entmake e3)
(setq en4(entmakex e4)
en5(entmakex e5)
en6(entmakex e6)
en7(entmakex e7)
en8(entmakex e8)
en9(entmakex e9)
)
(if(setq pp(getpoint "\n选择保留的一边:"))
(if(< (distance pp p4)(distance pp p42))
(progn
(entdel en7) (entdel en8 )(entdel en9)
)
(progn
(entdel en4) (entdel en5 )(entdel en6)
)
)
(progn
(entdel en7) (entdel en8 )(entdel en9)
)
)
)
(alert "!!长度超出原线长度!!")
)
)
((= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")
(if (setq pp(getpoint "\n选择方向:"))
(progn
(setq obj(vlax-ename->vla-object (car en))
p0(vlax-curve-getClosestPointTo obj (cadr en))
p1index(fix(vlax-curve-getParamAtPoint obj p0))
enindex(fix(vlax-curve-getEndParam obj))
enindex(if (vlax-curve-isClosed obj)
(1- enindex) enindex)
p2index(if (= p1index enindex) 0 (1+ p1index))
p1(vlax-curve-getPointAtParam obj p1index)
p2(vlax-curve-getPointAtParam obj p2index)
mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)
ds1 (distance p1 p2)
)
(if (and (> l 0)(> k 0)(< l ds1))
(progn
(setq ppc(PerToLine pp p1 p2)
ang1(angle p1 p2)
ang2(angle ppc pp)
p3 (polar mpt ang1 (* (* l 0.5) -1))
p4 (polar p3 ang2 k)
p6 (polar mpt ang1 (* l 0.5))
p5 (polar p6 ang2 k)
p3 (list (car p3) (cadr p3))
p4 (list (car p4) (cadr p4))
p5 (list (car p5) (cadr p5))
p6 (list (car p6) (cadr p6))
newp3 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p3)
newp4 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p4)
newp5 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p5)
newp6 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p6)
)
(vla-addvertex OBJ (+ p1index 1) newp3)
(vla-addvertex OBJ (+ p1index 2) newp4)
(vla-addvertex OBJ (+ p1index 3) newp5)
(vla-addvertex OBJ (+ p1index 4) newp6)
(setq en2(entmakex (list '(0 . "line") (cons 6 "HIDDEN") (cons 62 1)(cons 10 p3)(cons 11 p6))))
(if en2
(progn
(setq obj2(vlax-ename->vla-object en2))
(vla-put-layer obj2(vla-get-layer obj))
;(vla-put-color obj2(vla-get-color obj))
)
)
)
)
)
(and en(redraw (car en) 4))
)
)
)
)
(and en(redraw (car en) 4))
)
(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)
)
edata 发表于 2014-6-13 12:05 static/image/common/back.gif
非常感谢！不知道为什么我用的时候，中间虚线没有画出来。还有两边挂台时，老是只能保留一边。 截图
如图所示。 edata 发表于 2014-6-13 13:03 static/image/common/back.gif
截图
如图所示。
用上传不了图片，可能是追踪没有搞好！ 虚线不出来是因为没有加载，楼上已改。
因为你的图以及你的文字说的不是很清楚，按照顶楼图示，是最终结果。 谢谢你的回答,现在还是用不了.到方向时就没有反应了.就是零件一直亮着.
页:
[1]
2