挂台命令

edata

不知道你有没有测量过你这条直线多长，理论上是你的开口大于原线长度。
对于开口=原线不考虑。

1. (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 ppc  x y)
   
2.   (if(and(setq en(entsel "\n 选择切线位置: "))
   
3.          (or(= (cdr(assoc 0 (entget(car en)))) "LINE")
   
4.             (= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")
   
5.             )
   
6.          (car(list t(redraw (car en) 3)))
   
7.          (setq l(getdist "\n 长度: "))
   
8.          (setq k(getdist "\n 宽度: ")))
   
9.     (progn
   
10.       (setq p0(cadr en)
    
11.             e(car en)
    
12.             elist (entget e))
    
13.       (if (not(tblobjname "ltype" "hidden"))
    
14.         (entmake '((0 . "LTYPE")
    
15.                    (100 . "AcDbSymbolTableRecord")
    
16.                    (100 . "AcDbLinetypeTableRecord")
    
17.                    (2 . "HIDDEN") (70 . 0)
    
18.                    (3 . "Hidden __ __ __ __ __ __ __ __ __ __ __ __ __ _")
    
19.                    (72 . 65) (73 . 2) (40 . 9.525) (49 . 6.35) (74 . 0)
    
20.                    (49 . -3.175) (74 . 0)))
    
21.         )
    
22.       (cond
    
23.         ((= (cdr(assoc 0 (entget e))) "LINE")
    
24.          (setq p1(cdr(assoc 10 elist))
    
25.                p2(cdr(assoc 11 elist))
    
26.                ds1(distance p1 p2)
    
27.                mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)
    
28.                )
    
29.          (if (and (> l 0)(> k 0)(< l ds1))
    
30.            (progn
    
31.              (setq ang1(angle p1 p2)
    
32.                    ang2(+ ang1 (* pi 0.5))
    
33.                    ang3(+ ang1 (* pi 1.5))                  
    
34.                    p3 (polar mpt ang1 (* (* l 0.5) -1))
    
35.                    p4 (polar p3 ang2 k)
    
36.                    p6 (polar mpt ang1 (* l 0.5))
    
37.                    p5 (polar p6 ang2 k)
    
38.                    p42 (polar p3 ang3 k)
    
39.                    p52 (polar p6 ang3 k)
    
40.                    )
    
41.              (setq e1 elist
    
42.                    e2 elist
    
43.                    e3 elist
    
44.                    e4 elist
    
45.                    e5 elist
    
46.                    e6 elist
    
47.                    e7 elist
    
48.                    e8 elist
    
49.                    e9 elist
    
50.                    e3(subst(cons 10 p6)(assoc 10 e3)e3)
    
51.                    e3(subst(cons 11 p3)(assoc 11 e3)e3)
    
52.                    e3(if(assoc 6 e3)
    
53.                        (subst(cons 6 "HIDDEN")(assoc 6 e3)e3)
    
54.                        (reverse(cons(cons 6 "HIDDEN")(reverse e3))))
    
55.                    e3(if(assoc 62 e3)
    
56.                        (subst(cons 62 1)(assoc 62 e3)e3)
    
57.                        (reverse(cons(cons 62 1)(reverse e3))))
    
58.                    e4(subst(cons 10 p3)(assoc 10 e4)e4)
    
59.                    e4(subst(cons 11 p4)(assoc 11 e4)e4)
    
60.                    e5(subst(cons 10 p4)(assoc 10 e5)e5)
    
61.                    e5(subst(cons 11 p5)(assoc 11 e5)e5)
    
62.                    e6(subst(cons 10 p5)(assoc 10 e6)e6)
    
63.                    e6(subst(cons 11 p6)(assoc 11 e6)e6)
    
64.                    e7(subst(cons 10 p3)(assoc 10 e7)e7)
    
65.                    e7(subst(cons 11 p42)(assoc 11 e7)e7)
    
66.                    e8(subst(cons 10 p42)(assoc 10 e8)e8)
    
67.                    e8(subst(cons 11 p52)(assoc 11 e8)e8)
    
68.                    e9(subst(cons 10 p52)(assoc 10 e9)e9)
    
69.                    e9(subst(cons 11 p6)(assoc 11 e9)e9)
    
70.                    )            
    
71.              (entmod(subst(cons 11 p3)(assoc 11 e1)e1))
    
72.              (entmake (subst(cons 10 p6)(assoc 10 e2)e2))
    
73.              (entmake e3)
    
74.              (setq en4(entmakex e4)
    
75.                    en5(entmakex e5)
    
76.                    en6(entmakex e6)
    
77.                    en7(entmakex e7)
    
78.                    en8(entmakex e8)
    
79.                    en9(entmakex e9)
    
80.                    )
    
81.              (if(setq pp(getpoint "\n选择保留的一边:"))
    
82.                (if(< (distance pp p4)(distance pp p42))
    
83.                  (progn
    
84.                    (entdel en7) (entdel en8 )(entdel en9)
    
85.                    )
    
86.                  (progn
    
87.                    (entdel en4) (entdel en5 )(entdel en6)
    
88.                    )
    
89.                  )
    
90.                (progn
    
91.                    (entdel en7) (entdel en8 )(entdel en9)
    
92.                    )
    
93.                )            
    
94.              )
    
95.            (progn(alert "!!长度超出原线长度!!")(and en(redraw (car en) 4)))
    
96.            )
    
97.          )
    
98.         ((= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")
    
99.          (if (setq pp(getpoint "\n选择方向:"))
    
100.            (progn
     
101.              (setq obj(vlax-ename->vla-object (car en))
     
102.                    p0(vlax-curve-getClosestPointTo obj (cadr en))
     
103.                    p1index(fix(vlax-curve-getParamAtPoint obj p0))
     
104.                    enindex(fix(vlax-curve-getEndParam obj))
     
105.                    enindex(if (vlax-curve-isClosed obj)
     
106.                             (1- enindex) enindex)
     
107.                    p2index(if (= p1index enindex) 0 (1+ p1index))
     
108.                    p1(vlax-curve-getPointAtParam obj p1index)
     
109.                    p2(vlax-curve-getPointAtParam obj p2index)
     
110.                    mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)
     
111.                    ds1 (distance p1 p2)
     
112.                    )
     
113.              (if (and (> l 0)(> k 0)(< l ds1))
     
114.                (progn
     
115.                  (setq ppc(PerToLine pp p1 p2)
     
116.                        ang1(angle p1 p2)
     
117.                        ang2(angle ppc pp)
     
118.                        p3 (polar mpt ang1 (* (* l 0.5) -1))
     
119.                        p4 (polar p3 ang2 k)
     
120.                        p6 (polar mpt ang1 (* l 0.5))
     
121.                        p5 (polar p6 ang2 k)
     
122.                        p3 (list (car p3) (cadr p3))
     
123.                        p4 (list (car p4) (cadr p4))
     
124.                        p5 (list (car p5) (cadr p5))
     
125.                        p6 (list (car p6) (cadr p6))
     
126.                        newp3 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p3)
     
127.                        newp4 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p4)
     
128.                        newp5 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p5)
     
129.                        newp6 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p6)
     
130.                        )
     
131.                  (vla-addvertex OBJ (+ p1index 1) newp3)
     
132.                  (vla-addvertex OBJ (+ p1index 2) newp4)
     
133.                  (vla-addvertex OBJ (+ p1index 3) newp5)
     
134.                  (vla-addvertex OBJ (+ p1index 4) newp6)
     
135.                  (setq en2(entmakex (list '(0 . "line") (cons 6 "HIDDEN") (cons 62 1)(cons 10 p3)(cons 11 p6))))
     
136.                  (if en2
     
137.                    (progn
     
138.                      (setq obj2(vlax-ename->vla-object en2))
     
139.                      (vla-put-layer obj2(vla-get-layer obj))
     
140.                      ;(vla-put-color obj2(vla-get-color obj))                     
     
141.                      )
     
142.                    )
     
143.                           
     
144.                  )
     
145.                (progn(alert "!!长度超出原线长度!!")(and en(redraw (car en) 4)))
     
146.                )            
     
147.              )
     
148.            (and en(redraw (car en) 4))
     
149.            )
     
150.          )
     
151.         )
     
152.       )
     
153.     (and en(redraw (car en) 4))
     
154.     )
     
155.   (princ)
     
156.   )
     
157. ;;;计算cp到p1 p2的垂足点
     
158. (defun PerToLine  (cp p1 p2 / norm)
     
159.   (setq        norm (mapcar '- p2 p1)
     
160.         p1   (trans p1 0 norm)
     
161.         cp   (trans cp 0 norm)
     
162.         )
     
163.   (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
     
164.   )

(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 ppc  x y)<br />   (if(and(setq en(entsel "\n 选择切线位置: "))<br />          (or(= (cdr(assoc 0 (entget(car en)))) "LINE")<br />             (= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")<br />             )<br />          (car(list t(redraw (car en) 3)))<br />          (setq l(getdist "\n 长度: "))<br />          (setq k(getdist "\n 宽度: ")))<br />     (progn<br />       (setq p0(cadr en)<br />             e(car en)<br />             elist (entget e))<br />       (if (not(tblobjname "ltype" "hidden"))<br />         (entmake '((0 . "LTYPE")<br />                    (100 . "AcDbSymbolTableRecord")<br />                    (100 . "AcDbLinetypeTableRecord")<br />                    (2 . "HIDDEN") (70 . 0)<br />                    (3 . "Hidden __ __ __ __ __ __ __ __ __ __ __ __ __ _")<br />                    (72 . 65) (73 . 2) (40 . 9.525) (49 . 6.35) (74 . 0)<br />                    (49 . -3.175) (74 . 0)))<br />         )<br />       (cond<br />         ((= (cdr(assoc 0 (entget e))) "LINE")<br />          (setq p1(cdr(assoc 10 elist))<br />                p2(cdr(assoc 11 elist))<br />                ds1(distance p1 p2)<br />                mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)<br />                )<br />          (if (and (> l 0)(> k 0)(< l ds1))<br />            (progn<br />              (setq ang1(angle p1 p2)<br />                    ang2(+ ang1 (* pi 0.5))<br />                    ang3(+ ang1 (* pi 1.5))                   <br />                    p3 (polar mpt ang1 (* (* l 0.5) -1))<br />                    p4 (polar p3 ang2 k)<br />                    p6 (polar mpt ang1 (* l 0.5))<br />                    p5 (polar p6 ang2 k)<br />                    p42 (polar p3 ang3 k)<br />                    p52 (polar p6 ang3 k)<br />                    )<br />              (setq e1 elist<br />                    e2 elist<br />                    e3 elist<br />                    e4 elist<br />                    e5 elist<br />                    e6 elist<br />                    e7 elist<br />                    e8 elist<br />                    e9 elist<br />                    e3(subst(cons 10 p6)(assoc 10 e3)e3)<br />                    e3(subst(cons 11 p3)(assoc 11 e3)e3)<br />                    e3(if(assoc 6 e3)<br />                        (subst(cons 6 "HIDDEN")(assoc 6 e3)e3)<br />                        (reverse(cons(cons 6 "HIDDEN")(reverse e3))))<br />                    e3(if(assoc 62 e3)<br />                        (subst(cons 62 1)(assoc 62 e3)e3)<br />                        (reverse(cons(cons 62 1)(reverse e3))))<br />                    e4(subst(cons 10 p3)(assoc 10 e4)e4)<br />                    e4(subst(cons 11 p4)(assoc 11 e4)e4)<br />                    e5(subst(cons 10 p4)(assoc 10 e5)e5)<br />                    e5(subst(cons 11 p5)(assoc 11 e5)e5)<br />                    e6(subst(cons 10 p5)(assoc 10 e6)e6)<br />                    e6(subst(cons 11 p6)(assoc 11 e6)e6)<br />                    e7(subst(cons 10 p3)(assoc 10 e7)e7)<br />                    e7(subst(cons 11 p42)(assoc 11 e7)e7)<br />                    e8(subst(cons 10 p42)(assoc 10 e8)e8)<br />                    e8(subst(cons 11 p52)(assoc 11 e8)e8)<br />                    e9(subst(cons 10 p52)(assoc 10 e9)e9)<br />                    e9(subst(cons 11 p6)(assoc 11 e9)e9)<br />                    )             <br />              (entmod(subst(cons 11 p3)(assoc 11 e1)e1))<br />              (entmake (subst(cons 10 p6)(assoc 10 e2)e2))<br />              (entmake e3)<br />              (setq en4(entmakex e4)<br />                    en5(entmakex e5)<br />                    en6(entmakex e6)<br />                    en7(entmakex e7)<br />                    en8(entmakex e8)<br />                    en9(entmakex e9)<br />                    )<br />              (if(setq pp(getpoint "\n选择保留的一边:"))<br />                (if(< (distance pp p4)(distance pp p42))<br />                  (progn<br />                    (entdel en7) (entdel en8 )(entdel en9)<br />                    )<br />                  (progn<br />                    (entdel en4) (entdel en5 )(entdel en6)<br />                    )<br />                  )<br />                (progn<br />                    (entdel en7) (entdel en8 )(entdel en9)<br />                    )<br />                )             <br />              )<br />            (progn(alert "!!长度超出原线长度!!")(and en(redraw (car en) 4)))<br />            )<br />          )<br />         ((= (cdr(assoc 0 (entget(car en)))) "LWPOLYLINE")<br />          (if (setq pp(getpoint "\n选择方向:"))<br />            (progn<br />              (setq obj(vlax-ename->vla-object (car en))<br />                    p0(vlax-curve-getClosestPointTo obj (cadr en))<br />                    p1index(fix(vlax-curve-getParamAtPoint obj p0))<br />                    enindex(fix(vlax-curve-getEndParam obj))<br />                    enindex(if (vlax-curve-isClosed obj)<br />                             (1- enindex) enindex)<br />                    p2index(if (= p1index enindex) 0 (1+ p1index))<br />                    p1(vlax-curve-getPointAtParam obj p1index)<br />                    p2(vlax-curve-getPointAtParam obj p2index)<br />                    mpt(mapcar '(lambda(x y) (* (+ x y) 0.5)) p1 p2)<br />                    ds1 (distance p1 p2)<br />                    )<br />              (if (and (> l 0)(> k 0)(< l ds1))<br />                (progn<br />                  (setq ppc(PerToLine pp p1 p2)<br />                        ang1(angle p1 p2)<br />                        ang2(angle ppc pp)<br />                        p3 (polar mpt ang1 (* (* l 0.5) -1))<br />                        p4 (polar p3 ang2 k)<br />                        p6 (polar mpt ang1 (* l 0.5))<br />                        p5 (polar p6 ang2 k)<br />                        p3 (list (car p3) (cadr p3))<br />                        p4 (list (car p4) (cadr p4))<br />                        p5 (list (car p5) (cadr p5))<br />                        p6 (list (car p6) (cadr p6))<br />                        newp3 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p3)<br />                        newp4 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p4)<br />                        newp5 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p5)<br />                        newp6 (vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) p6)<br />                        )<br />                  (vla-addvertex OBJ (+ p1index 1) newp3)<br />                  (vla-addvertex OBJ (+ p1index 2) newp4)<br />                  (vla-addvertex OBJ (+ p1index 3) newp5)<br />                  (vla-addvertex OBJ (+ p1index 4) newp6)<br />                  (setq en2(entmakex (list '(0 . "line") (cons 6 "HIDDEN") (cons 62 1)(cons 10 p3)(cons 11 p6))))<br />                  (if en2<br />                    (progn<br />                      (setq obj2(vlax-ename->vla-object en2))<br />                      (vla-put-layer obj2(vla-get-layer obj))<br />                      ;(vla-put-color obj2(vla-get-color obj))                     <br />                      )<br />                    )<br />                           <br />                  )<br />                (progn(alert "!!长度超出原线长度!!")(and en(redraw (car en) 4)))<br />                )             <br />              )<br />            (and en(redraw (car en) 4))<br />            )<br />          )<br />         )<br />       )<br />     (and en(redraw (car en) 4))<br />     )<br />   (princ)<br />   )<br /> ;;;计算cp到p1 p2的垂足点<br /> (defun PerToLine  (cp p1 p2 / norm)<br />   (setq        norm (mapcar '- p2 p1)<br />         p1   (trans p1 0 norm)<br />         cp   (trans cp 0 norm)<br />         )<br />   (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)<br />   )

sanji14

可以了，感谢edata 的帮忙！！

xyp1964

;; 也玩挂台

sanji14

xyp1964 发表于 2014-6-14 13:27
;; 也玩挂台

发个原码看看。

sdls

感谢分享！！！

sanji14

xyp1964 发表于 2014-6-14 13:27
;; 也玩挂台

你好，此挂台外挂可以发给我吗？谢谢