【求助】请大侠门来编一个这样的程序！

yzr2002626

你编的这个也好用，但是不是我想要的。谢谢了。

yzr2002626

框选对角线，画那4个方向的交叉线，那交叉点在中点。按A切换画的那对角的方向

zhynt

回复 yzr2002626 的帖子

命令：win

yzr2002626

用了下，爽

ljpnb

zhynt 发表于 2011-6-26 18:22
回复 yzr2002626 的帖子

命令：win

程序试一下,基本上可以,有个BUG,就是捕捉点没处理过,zhynt真是有心人.

zhynt

43楼已更新

raimo

回复 zhynt 的帖子

呵呵,zhynt真是个有心人,你的程序帮助了不少人啊..我是支持你的

前面的建议只是从我个人理解来提的..别见怪..毕竟个人有个人的用途,出发点不同..
我也感谢正是有Z版,zhynt,还有...挺多热心人..有了你们的帮助我也慢慢学习到不少.
在你们的无私分享的代码中找到适合自己的实用工具..多谢啦

yzr2002626

问下，那交叉线画完后怎样把自动那画的矩形删除

ljpnb

yzr2002626 发表于 2011-6-26 19:49
问下，那交叉线画完后怎样把自动那画的矩形删除

2. 
   
3. 
   
4. ;;矩形框中加辅助“V”形线----by ljpnb
   
5. (defun c:test ()
   
6.   (setq errtmp *error*)
   
7.   (setq *error* err)
   
8.   (setq k T)
   
9.   (setvar "cmdecho" 0)
   
10.   (command "undo" "be")
    
11.   (setq os (getvar "osmode"))
    
12.   (if (setq pta (getpoint "\n指定矩形的一个角点<回车直接选择矩形>:"))
    
13.     (progn
    
14.       (if (setq ptb (getcorner pta "\n指定第二角点<回车直接退出>:"))
    
15. (progn
    
16.    (command "_.rectang" pta ptb)
    
17.    (setq ent (entlast))
    
18.    (setvar "osmode" 0)
    
19.    (if (setq pt (getpoint "\n选定方向<回车直接退出>:"))
    
20.      (progn
    
21.        (setq obj (vlax-ename->vla-object ent))
    
22.        (setq pt (vlax-curve-getclosestpointto obj pt))
    
23.      )
    
24.      (progn
    
25.        (setq k nil)
    
26.        (vla-delete (vlax-ename->vla-object ent))
    
27.      ;如果保留矩形框，直接删除这一句
    
28.      )
    
29.    )
    
30. )
    
31. (setq k nil)
    
32.       )
    
33.     )
    
34.     (progn
    
35.       (if (setq en (entsel "\n请选择一矩形<回车直接退出>:"))
    
36. (setq ent (car en)
    
37.        pt  (osnap (cadr en) "nea")
    
38. )
    
39. (setq k nil)
    
40.       )
    
41.     )
    
42.   )
    
43.   (if k
    
44.     (progn
    
45.       (setq pt_lst
    
46.       (mapcar
    
47.         'cdr
    
48.         (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
    
49.       )
    
50.       )
    
51.       (setq obj (vlax-ename->vla-object ent))
    
52.       (setq n (fix (vlax-curve-getparamatpoint obj pt)))
    
53.       (setq p1 (nth n pt_lst))
    
54.       (if (= n 3)
    
55. (setq p2 (nth 0 pt_lst))
    
56. (setq p2 (nth (1+ n) pt_lst))
    
57.       )
    
58.       (setq p-mid (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2))
    
59.       (setq pt_lst1 (vl-remove p1 pt_lst))
    
60.       (setq pt_lst1 (vl-remove p2 pt_lst1))
    
61.       (setq p3 (car pt_lst1)
    
62.      p4 (cadr pt_lst1)
    
63.       )
    
64.       (command "line" "non" p3 "non" p-mid "non" p4 "")
    
65.       (vla-delete obj)   ;如果保留矩形框，直接删除这一句
    
66.     )
    
67.   )
    
68.   (setvar "osmode" OS)
    
69.   (command "undo" "e")
    
70.   (setvar "cmdecho" 1)
    
71.   (setq *error* errtmp)
    
72.   (princ)
    
73. )
    
74. ;;;取消恢复处理
    
75. (defun err (msg)
    
76.   (setvar "osmode" os)
    
77.   (if ent
    
78.     (vla-delete (vlax-ename->vla-object ent)))   
    
79.   (setq *error* errtmp)   
    
80. )
    
81. 
    
82. 
    

<br /> <br /> ;;矩形框中加辅助“V”形线----by ljpnb<br /> (defun c:test ()<br />   (setq errtmp *error*)<br />   (setq *error* err)<br />   (setq k T)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "be")<br />   (setq os (getvar "osmode"))<br />   (if (setq pta (getpoint "\n指定矩形的一个角点<回车直接选择矩形>:"))<br />     (progn<br />       (if (setq ptb (getcorner pta "\n指定第二角点<回车直接退出>:"))<br /> (progn<br />    (command "_.rectang" pta ptb)<br />    (setq ent (entlast))<br />    (setvar "osmode" 0)<br />    (if (setq pt (getpoint "\n选定方向<回车直接退出>:"))<br />      (progn<br />        (setq obj (vlax-ename->vla-object ent))<br />        (setq pt (vlax-curve-getclosestpointto obj pt))<br />      )<br />      (progn<br />        (setq k nil)<br />        (vla-delete (vlax-ename->vla-object ent))<br />      ;如果保留矩形框，直接删除这一句<br />      )<br />    )<br /> )<br /> (setq k nil)<br />       )<br />     )<br />     (progn<br />       (if (setq en (entsel "\n请选择一矩形<回车直接退出>:"))<br /> (setq ent (car en)<br />        pt  (osnap (cadr en) "nea")<br /> )<br /> (setq k nil)<br />       )<br />     )<br />   )<br />   (if k<br />     (progn<br />       (setq pt_lst<br />       (mapcar<br />         'cdr<br />         (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))<br />       )<br />       )<br />       (setq obj (vlax-ename->vla-object ent))<br />       (setq n (fix (vlax-curve-getparamatpoint obj pt)))<br />       (setq p1 (nth n pt_lst))<br />       (if (= n 3)<br /> (setq p2 (nth 0 pt_lst))<br /> (setq p2 (nth (1+ n) pt_lst))<br />       )<br />       (setq p-mid (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2))<br />       (setq pt_lst1 (vl-remove p1 pt_lst))<br />       (setq pt_lst1 (vl-remove p2 pt_lst1))<br />       (setq p3 (car pt_lst1)<br />      p4 (cadr pt_lst1)<br />       )<br />       (command "line" "non" p3 "non" p-mid "non" p4 "")<br />       (vla-delete obj)   ;如果保留矩形框，直接删除这一句<br />     )<br />   )<br />   (setvar "osmode" OS)<br />   (command "undo" "e")<br />   (setvar "cmdecho" 1)<br />   (setq *error* errtmp) <br />   (princ)<br /> )<br /> ;;;取消恢复处理<br /> (defun err (msg)<br />   (setvar "osmode" os)<br />   (if ent<br />     (vla-delete (vlax-ename->vla-object ent)))    <br />   (setq *error* errtmp)   <br /> )<br /> <br /> <br />

zhynt

回复 ljpnb 的帖子

不错不错，看了你的程序，比我的简洁多了，受教了。