求【自动选取角点画出直线工具】!`~

daidong013

求这样的工具！~~引线长度可以随自己拉！~

zhynt

2. 
   
3. ;;判断点是否在方框内
   
4. (defun point_inm (pt pt1 pt2 pt3 pt4 / dist1 dist2 dist3 dist4 pt pt1
   
5.                   pt2 pr3 pt4)
   
6.   (setq        dist1 (point_line pt pt1 pt2)
   
7.         dist2 (point_line pt pt2 pt3)
   
8.         dist3 (point_line pt pt1 pt4)
   
9.         dist4 (point_line pt pt3 pt4)
   
10.   )
    
11.   (if (equal (+ dist1 dist2 dist3 dist4)
    
12.              (+ (distance pt1 pt2) (distance pt2 pt3))
    
13.              1e-10
    
14.       )
    
15.     t
    
16.     nil
    
17.   )
    
18. )
    
19. ;;点到直线的垂直距离
    
20. (defun point_line (pt pt1 pt2 / ptangle ptn pt pt1 pt2 dist jptx)
    
21.   (setq        ptangle        (angle pt1 pt2)
    
22.         ptn        (polar pt (+ (* 0.5 pi) ptangle) 0.01)
    
23.         jptx        (inters pt ptn pt1 pt2 nil)
    
24.         dist        (distance pt jptx)
    
25.   )
    
26.   dist
    
27. )
    
28. ;;将点表中在方框内的点组成新表
    
29. (defun pt_inm (oldlst PT1 PT2 PT3 PT4 /        oldlist        n pt1 pt2 pt3 pt4
    
30.                templst newlst)
    
31.   (setq templst '())
    
32.   (foreach n oldlst
    
33.     (if        (/= (point_inm n pt1 pt2 pt3 pt4) nil)
    
34.       (setq templst (cons n templst))
    
35.     )
    
36.   )
    
37.   (setq newlst (reverse templst))
    
38. )
    
39. ;;多段线顶点表
    
40. (defun pt_list (ent)
    
41.   (mapcar 'cdr
    
42.           (vl-remove-if '(lambda (x) (/= 10 (car x))) ent)
    
43.   )
    
44. )
    
45. ;;;去除 y 坐标相同的，并从上到下排序
    
46. (defun y_lst (lst rc / it lst2)
    
47.   (setq lst2 '())
    
48.   (setq lst (vl-sort lst (function (lambda (e1 e2) (> (car e1)  (car e2))))))
    
49.   (while (setq lst2 (cons (setq it (car lst)) lst2)
    
50.                lst  (vl-remove-if
    
51.                       '(lambda (x) (equal (cadr it) (cadr x) rc))
    
52.                       lst
    
53.                     )
    
54.          )
    
55.   )
    
56.   lst2
    
57. )
    
58. (defun c:yl (/ pta ptb ptax ptay ptbx ptby ptaxby pybxay se pt_lst n m pta pt )
    
59.   (setq pta (getpoint "\n框选第一点:"))
    
60.   (setq ptb (getcorner pta "\n框选第二点:"))
    
61.   (if (/= ptb nil)
    
62.     (progn (setq ptax (car pta)
    
63.                  ptay (cadr pta)
    
64.                  ptbx (car ptb)
    
65.                  ptby (cadr ptb)
    
66.            )
    
67.            (setq ptaxby        (list ptax ptby)
    
68.                  ptbxay        (list ptbx ptay)
    
69.            )           
    
70.            (setq se (ssget "c" pta ptb '((0 . "LWPOLYLINE"))))
    
71.     )
    
72.   )
    
73.   (setq pt_lst (pt_list (entget (ssname se 0))))
    
74.   (setq pt_lst (pt_inm pt_lst pta ptaxby ptb ptbxay))
    
75. 
    
76.   (setq pt_lst (y_lst pt_lst 1e-5))
    
77.   (setq        n (length pt_lst)
    
78.         m 0
    
79.   )
    
80.   (setq pta (getpoint "\n位置:"))
    
81.   (while (/= m n)
    
82.     (setq pt (nth m pt_lst))
    
83.     (command "_.line" "NON" pt "NON"(polar pt 0 (- (car pta)(car pt))) "")
    
84.     (setq m (1+ m))
    
85.   )
    
86. )
    

<br /> ;;判断点是否在方框内<br /> (defun point_inm (pt pt1 pt2 pt3 pt4 / dist1 dist2 dist3 dist4 pt pt1<br />                   pt2 pr3 pt4)<br />   (setq        dist1 (point_line pt pt1 pt2)<br />         dist2 (point_line pt pt2 pt3)<br />         dist3 (point_line pt pt1 pt4)<br />         dist4 (point_line pt pt3 pt4)<br />   )<br />   (if (equal (+ dist1 dist2 dist3 dist4)<br />              (+ (distance pt1 pt2) (distance pt2 pt3))<br />              1e-10<br />       )<br />     t<br />     nil<br />   )<br /> )<br /> ;;点到直线的垂直距离<br /> (defun point_line (pt pt1 pt2 / ptangle ptn pt pt1 pt2 dist jptx)<br />   (setq        ptangle        (angle pt1 pt2)<br />         ptn        (polar pt (+ (* 0.5 pi) ptangle) 0.01)<br />         jptx        (inters pt ptn pt1 pt2 nil)<br />         dist        (distance pt jptx)<br />   )<br />   dist<br /> )<br /> ;;将点表中在方框内的点组成新表<br /> (defun pt_inm (oldlst PT1 PT2 PT3 PT4 /        oldlist        n pt1 pt2 pt3 pt4<br />                templst newlst)<br />   (setq templst '())<br />   (foreach n oldlst<br />     (if        (/= (point_inm n pt1 pt2 pt3 pt4) nil)<br />       (setq templst (cons n templst))<br />     )<br />   )<br />   (setq newlst (reverse templst))<br /> )<br /> ;;多段线顶点表<br /> (defun pt_list (ent)<br />   (mapcar 'cdr<br />           (vl-remove-if '(lambda (x) (/= 10 (car x))) ent)<br />   )<br /> )<br /> ;;;去除 y 坐标相同的，并从上到下排序<br /> (defun y_lst (lst rc / it lst2)<br />   (setq lst2 '())<br />   (setq lst (vl-sort lst (function (lambda (e1 e2) (> (car e1)  (car e2))))))<br />   (while (setq lst2 (cons (setq it (car lst)) lst2)<br />                lst  (vl-remove-if<br />                       '(lambda (x) (equal (cadr it) (cadr x) rc))<br />                       lst<br />                     )<br />          )<br />   )<br />   lst2<br /> )<br /> (defun c:yl (/ pta ptb ptax ptay ptbx ptby ptaxby pybxay se pt_lst n m pta pt )<br />   (setq pta (getpoint "\n框选第一点:"))<br />   (setq ptb (getcorner pta "\n框选第二点:"))<br />   (if (/= ptb nil)<br />     (progn (setq ptax (car pta)<br />                  ptay (cadr pta)<br />                  ptbx (car ptb)<br />                  ptby (cadr ptb)<br />            )<br />            (setq ptaxby        (list ptax ptby)<br />                  ptbxay        (list ptbx ptay)<br />            )           <br />            (setq se (ssget "c" pta ptb '((0 . "LWPOLYLINE"))))<br />     )<br />   )<br />   (setq pt_lst (pt_list (entget (ssname se 0))))<br />   (setq pt_lst (pt_inm pt_lst pta ptaxby ptb ptbxay))<br /> <br />   (setq pt_lst (y_lst pt_lst 1e-5))<br />   (setq        n (length pt_lst)<br />         m 0<br />   )<br />   (setq pta (getpoint "\n位置:"))<br />   (while (/= m n)<br />     (setq pt (nth m pt_lst))<br />     (command "_.line" "NON" pt "NON"(polar pt 0 (- (car pta)(car pt))) "")<br />     (setq m (1+ m))<br />   )<br /> )<br />

daidong013

坐个沙发！~~这个功能有点类似QDIM的效果！~~~

mgame168

用來當輔助線工具, 應該很方便

raimo

回复 zhynt 的帖子

我载入测试的时候提示语法错误...

carrot1983

板凳

是雷锋吧~~~

daidong013

回复 zhynt 的帖子

zhynt大侠：好像提示语法错误！~~加载上了没用！~~

zhynt

回复 daidong013 的帖子

已经改好了。

daidong013

回复 zhynt 的帖子

可以了！~~就是这样的效果！~~~

zwqgdhl

daidong013的思路很好，这种快速布置辅助线的思路对我也有用，另外zhynt是传说中的高手，佩服