[其他]：coolzhb 接

aeo

好在没删掉:)

2. 
   
3. (defun c:ttt( / ang get-points dis dis0 e0 e1 e2 e2n j li-po line->every
   
4.                 os p1 p2 p3 p4 p5 p6 pt sca ss isclose _isinside)
   
5. (defun _isinside(pt pt0 li-po / j pt1 px py)
   
6.   (setq px(car li-po)li-po(cdr li-po) j 0)
   
7.   (while li-po
   
8.      (setq py(car li-po) li-po(cdr li-po))
   
9.      (if(setq pt1(inters pt pt0 px py))
   
10.         (if(or(equal(distance pt1 px)1e-3)(equal(distance pt1 py)1e-3))
    
11.           (setq j(+ j 0.5))
    
12.           (setq j(1+ j))
    
13.         )
    
14.      )
    
15.      (setq px py)
    
16.    )
    
17.   (cond ((=(rem j 2)0) t)
    
18.         ((=(rem j 2)1) nil)
    
19.    )
    
20. )
    
21. (defun line->every (pts  / pt1 ss1 )
    
22.     (setq ss1(ssadd)pt1(car pts)pts(cdr pts))
    
23.     (foreach pt2 pts
    
24.       (entmake
    
25.        (list '(0 . "LINE")'(100 . "AcDbEntity")'(100 . "AcDbLine")(cons 10 pt1)(cons 11 pt2)))
    
26.       (ssadd (entlast) ss1)
    
27.       (setq pt1 pt2)
    
28.     ) ss1
    
29. )
    
30. (defun get-points(pl / j obj pt pts)
    
31.   (setq  obj    (vlax-ename->vla-object pl)
    
32.          j       0
    
33.          isclose(vlax-curve-isClosed  obj))
    
34.   (while(setq pt(vlax-curve-getPointAtParam obj j))(setq pts(cons pt pts)j(1+ j)))
    
35.   (if isclose(reverse pts)
    
36.              (reverse(cons(last pts)pts))
    
37.   )
    
38. )
    
39. (if (not MYscale)(or(setq MYscale(getint "\n比例1:(100) "))(setq MYscale 100)))
    
40. (setq  j     0
    
41.         os   (getvar"osmode")
    
42.         pt   t
    
43.         e0   (entlast)
    
44. )
    
45. (command"undo""begin")
    
46. (while (and(progn (initget "s")t)
    
47.             (setq pt(getpoint"\n在里面点一下[S比例]:"))
    
48.          )
    
49.   (cond((= pt "S")
    
50.         (if(setq sca(getint(strcat"\n比例1:("(atoi myscale)"): ")))(setq MYscale sca))
    
51.        )
    
52.        ((listp pt)
    
53.    (if(and
    
54.      (progn(command"-boundary""a""o""p"""pt"")
    
55.            (setq e1(entlast))
    
56.            (not(equal e0 e1))
    
57.       )
    
58.      (progn(setq dis(getdist"\n输入出头距离(200):"))
    
59.          (if(not dis)(setq dis 200) t)
    
60.      )
    
61.      (setvar "offsetdist"(* 1.2 myscale))
    
62.      (progn(command".offset""" e1 pt "") t)
    
63.      (setq li-po(get-points (entlast)))
    
64.      (entdel e1)(entdel(entlast))
    
65.      (setq ss (line->every li-po))
    
66.     )
    
67. (repeat(sslength ss)
    
68.    (setq e2   (ssname ss j)
    
69.          e2n  (entget e2)
    
70.          p1   (cdr(assoc 10 e2n))
    
71.          p2   (cdr(assoc 11 e2n))
    
72.          ang  (angle p1 p2)
    
73.          dis0 (distance p1 p2)
    
74.    )
    
75.    (setq p3(polar p2 ang dis))
    
76.    (if(_isinside p3 pt li-po )
    
77.       (progn(entmod(subst(cons 11 p3)(assoc 11 e2n)e2n))(setq p2 p3))
    
78.    )
    
79.    (setq p3(polar p1 (+ pi ang) dis))
    
80.    (if(_isinside p3 pt li-po)  
    
81.       (progn (entmod(subst(cons 10 p3)(assoc 10 e2n)e2n))(setq p1 p3))
    
82.    )
    
83.    (setq p3(mapcar '(lambda(x y)(/(+ x y)2.)) p1 p2)
    
84.          p4(polar p3(+ ang(/ pi 2.))(* myscale 0.9))
    
85.          p5(polar p3(- ang(/ pi 2.))(* myscale 0.9))
    
86.          p6(if(_isinside p4 pt li-po)p4 p5)
    
87.      )
    
88.    (if(> dis0 (* 2 dis))
    
89.     (progn
    
90.      (setvar "osmode" 0)
    
91.      (command"donut""0"(* myscale 0.6) p6(polar p6 ang dis)(polar p6(+ ang pi)dis)"")
    
92.      (setvar "osmode" os)
    
93.    ))
    
94.    (command"pedit" e2 "y""w"(* 0.45 myscale)"")
    
95.    (setq j(1+ j))
    
96.   )
    
97. ))))
    
98. (command"undo""end")
    
99. (princ)
    
100. )
     

<br /> (defun c:ttt( / ang get-points dis dis0 e0 e1 e2 e2n j li-po line->every<br />                 os p1 p2 p3 p4 p5 p6 pt sca ss isclose _isinside)<br /> (defun _isinside(pt pt0 li-po / j pt1 px py) <br />   (setq px(car li-po)li-po(cdr li-po) j 0)<br />   (while li-po<br />      (setq py(car li-po) li-po(cdr li-po))<br />      (if(setq pt1(inters pt pt0 px py))<br />         (if(or(equal(distance pt1 px)1e-3)(equal(distance pt1 py)1e-3))<br />           (setq j(+ j 0.5))<br />           (setq j(1+ j))<br />         )<br />      )<br />      (setq px py)<br />    ) <br />   (cond ((=(rem j 2)0) t)<br />         ((=(rem j 2)1) nil)<br />    )<br /> )<br /> (defun line->every (pts  / pt1 ss1 )<br />     (setq ss1(ssadd)pt1(car pts)pts(cdr pts))<br />     (foreach pt2 pts<br />       (entmake <br />        (list '(0 . "LINE")'(100 . "AcDbEntity")'(100 . "AcDbLine")(cons 10 pt1)(cons 11 pt2)))<br />       (ssadd (entlast) ss1)<br />       (setq pt1 pt2)<br />     ) ss1<br /> )<br /> (defun get-points(pl / j obj pt pts)<br />   (setq  obj    (vlax-ename->vla-object pl)<br />          j       0 <br />          isclose(vlax-curve-isClosed  obj))<br />   (while(setq pt(vlax-curve-getPointAtParam obj j))(setq pts(cons pt pts)j(1+ j)))<br />   (if isclose(reverse pts) <br />              (reverse(cons(last pts)pts))<br />   )<br /> )<br /> (if (not MYscale)(or(setq MYscale(getint "\n比例1:(100) "))(setq MYscale 100)))<br /> (setq  j     0 <br />         os   (getvar"osmode") <br />         pt   t<br />         e0   (entlast)<br /> )<br /> (command"undo""begin")<br /> (while (and(progn (initget "s")t)<br />             (setq pt(getpoint"\n在里面点一下[S比例]:"))<br />          )<br />   (cond((= pt "S")<br />         (if(setq sca(getint(strcat"\n比例1:("(atoi myscale)"): ")))(setq MYscale sca))<br />        )<br />        ((listp pt)<br />    (if(and<br />      (progn(command"-boundary""a""o""p"""pt"")<br />            (setq e1(entlast))<br />            (not(equal e0 e1))<br />       )<br />      (progn(setq dis(getdist"\n输入出头距离(200):"))<br />          (if(not dis)(setq dis 200) t)<br />      )<br />      (setvar "offsetdist"(* 1.2 myscale))<br />      (progn(command".offset""" e1 pt "") t) <br />      (setq li-po(get-points (entlast)))<br />      (entdel e1)(entdel(entlast))<br />      (setq ss (line->every li-po))<br />     ) <br /> (repeat(sslength ss)<br />    (setq e2   (ssname ss j)<br />          e2n  (entget e2)<br />          p1   (cdr(assoc 10 e2n))<br />          p2   (cdr(assoc 11 e2n))<br />          ang  (angle p1 p2)<br />          dis0 (distance p1 p2)<br />    )<br />    (setq p3(polar p2 ang dis))<br />    (if(_isinside p3 pt li-po ) <br />       (progn(entmod(subst(cons 11 p3)(assoc 11 e2n)e2n))(setq p2 p3))<br />    )<br />    (setq p3(polar p1 (+ pi ang) dis))<br />    (if(_isinside p3 pt li-po)  <br />       (progn (entmod(subst(cons 10 p3)(assoc 10 e2n)e2n))(setq p1 p3))<br />    )<br />    (setq p3(mapcar '(lambda(x y)(/(+ x y)2.)) p1 p2)<br />          p4(polar p3(+ ang(/ pi 2.))(* myscale 0.9))<br />          p5(polar p3(- ang(/ pi 2.))(* myscale 0.9))<br />          p6(if(_isinside p4 pt li-po)p4 p5)<br />      )<br />    (if(> dis0 (* 2 dis))<br />     (progn<br />      (setvar "osmode" 0)<br />      (command"donut""0"(* myscale 0.6) p6(polar p6 ang dis)(polar p6(+ ang pi)dis)"")<br />      (setvar "osmode" os)<br />    ))<br />    (command"pedit" e2 "y""w"(* 0.45 myscale)"")<br />    (setq j(1+ j))<br />   )<br /> ))))<br /> (command"undo""end")<br /> (princ)<br /> )<br />

coolzhb

接到了，谢谢Aeo版主！

雨箭风刀

是什么功能，用来解决什么问题，也应该介绍一下啊。。。。

eachy

呵呵，原来是用 xdapi  写的一个程序

http://www.xdcad.net/forum/showt ... d=741508#post741508

snoopychen

实战了一下，还在想这个凹角处自动钢筋延伸是怎么回事
调试了，发现aeo版主采用判别延伸点p3是否在多边形内的方法还真奇妙，也很有容错功能，好好学习了一把：）

coolzhb

最初由 snoopychen 发布
[B]实战了一下，还在想这个凹角处自动钢筋延伸是怎么回事
调试了，发现aeo版主采用判别延伸点p3是否在多边形内的方法还真奇妙，也很有容错功能，好好学习了一把：） [/B]

是的，当时有时候也会出错，在简单的修改判断就可以了！
在边界有向内的小缺口时候会出错，但是这种情况很少碰到！

aeo

我是临时写的(只适用本例),可以用更好的替换之.

用我自己的函数写,应该可以很短.
问我要条鱼,不可能把鱼船也送人,但是肯定送个鱼钩.
乐趣其实是捕鱼的过程.

eachy

最初由 aeo 发布
[B]我是临时写的(只适用本例),可以用更好的替换之.

用我自己的函数写,应该可以很短.
问我要条鱼,不可能把鱼船也送人,但是肯定送个鱼钩.
乐趣其实是捕鱼的过程. [/B]

的确如此，授人以鱼不如授人以渔，如果只得鱼而不学渔是不能提高的

coolzhb

最初由 aeo 发布
[B]我是临时写的(只适用本例),可以用更好的替换之.

用我自己的函数写,应该可以很短.
问我要条鱼,不可能把鱼船也送人,但是肯定送个鱼钩.
乐趣其实是捕鱼的过程. [/B]

是的，aeo有CEO的风范！！！