[反应器 回调函数]今天发一个文字避让的回调函数源码！求交流思路

蔡__洛

此反应器回调函数实现目的是：如果一个附着该反应器的文字移动或者修改内容后压到别的文字，则移开那个被压到的文字。
思路：通过ssget选择以文字四角所围成的区域的文字，若返回选择集为空nil则没有碰撞，否则计算被压倒的文字新坐标并移开文字到新坐标。
反应器使用ssget这样的交互函数是禁止的，但是我想不到更好的搜索算法来检查是否碰撞，所以里面的ssget函数参数都是预定义好的而不是用户交互输入的。
希望高手指点下改进方法，有个问题请教就是在反应器（第一次）触发后 while循环没法完全执行就退出了并又触发（第二次）反应器的执行，所以文字移动不到想要的位置，求教大神是什么原因......

2. (defun RCBF:obj-delete-text(owner_obj reactor_obj  arg_list / m_ename pt_10 ang_50 ucs_dir pt1 pt2 pt3 pt4 b h pt_list ss tmp)
   
3.   (princ "\n.\n反应器开始执行...")  
   
4.   (setq m_ename (vlax-vla-object->ename  owner_obj))  
   
5.   ;;碰撞检查start
   
6.   (setq pt_10 (getitern m_ename 10) ang_50 (getitern m_ename 50) ucs_dir (append pt_10 (list ang_50)))
   
7.   (setq pt1 (textbox (entget m_ename)) pt3 (cadr pt1)  pt1 (car pt1) b (car pt3) h (cadr pt3))
   
8.   (setq pt2 (polar pt1 0.0 b) pt4 (polar pt1 (/ pi 2.0) h) pt_list (list pt1 pt2 pt3 pt4))
   
9.   (setq pt_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_dir) 0 1))) pt_list))
   
10.   (if (setq ss (ssget "_CP" pt_list '((0 . "TEXT"))))
    
11.     (if (setq tmp (ssdel m_ename ss)) (setq ss tmp))
    
12.     )  
    
13.   ;;碰撞检查end
    
14.   
    
15.   (if ss  (princ (strcat "\n文字碰撞：" (getitern (ssname ss 0) 1)))(princ "\n没有碰撞到文字..."))
    
16.   (if ss (progn
    
17.   (setq m_text (ssname ss 0)
    
18.   m_text_10 (getitern m_text 10)
    
19.   m_text_50 (getitern m_text 50)
    
20.   m_text_40 (getitern m_text 40)
    
21.   pt_text_1 (textbox (entget m_text))
    
22.   pt_text_3 (cadr pt_text_1)  pt_text_1 (car pt_text_1)
    
23.   pt_text_2 (polar pt_text_1 0.0 (car pt_text_3))
    
24.   pt_text_4 (polar pt_text_1 (/ pi 2.0) (cadr pt_text_3))
    
25.   pt_text_list (list pt_text_1 pt_text_2 pt_text_3 pt_text_4)
    
26.   pt_end1 m_text_10 pt_end2 m_text_10 right_times 0 left_times 0)
    
27.   (while  ;;计算在碰撞后向右移动多少次可以不再碰撞
    
28.    (setq pt_start pt_end1 pt_end1 (polar pt_start m_text_50 m_text_40)
    
29.   right_times (1+ right_times)
    
30.   ucs_text_dir (append pt_end1 (list m_text_50))
    
31.   pt_text_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_text_dir) 0 1))) pt_text_list)
    
32.   ss_1 (ssget "_CP" pt_text_list '((0 . "TEXT")))
    
33.   )
    
34.    (princ "\nR移动次数：")(princ right_times)
    
35.    (princ "\nss_1=")(princ ss_1)
    
36.    (princ "\n图原名=")(princ (getitern (ssname ss_1 0) -1))
    
37.    )
    
38.   (while
    
39. ;;计算在碰撞后向左移动多少次可以不再碰撞
    
40.    (setq pt_start pt_end2 pt_end2 (polar pt_start (+ m_text_50 pi) m_text_40)
    
41.   left_times (1+ left_times)
    
42.   ucs_text_dir (append pt_end2 (list m_text_50))
    
43.   pt_text_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_text_dir) 0 1))) pt_text_list)
    
44.   ss_2 (ssget "_CP" pt_text_list '((0 . "TEXT")))
    
45.   )
    
46.    (princ "\nL移动次数：")(princ left_times)
    
47.    (princ "\nss_2=")(princ ss_2)
    
48.    (princ "\n图原名=")(princ (getitern (ssname ss_2 0) -1))
    
49.    )
    
50.   (if (<= right_times left_times)(upobj m_text 10 pt_end1)(upobj m_text 10 pt_end2))    ;;根据向左或是向右移动次数判断向左还是右移动
    
51.   (princ)
    
52.   ))
    
53.   ;(upobj m_text 10 pt_end)
    
54.   (princ "\n反应器执行结束...\n.")
    
55.   )

(defun RCBF:obj-delete-text(owner_obj reactor_obj  arg_list / m_ename pt_10 ang_50 ucs_dir pt1 pt2 pt3 pt4 b h pt_list ss tmp)<br />   (princ "\n.\n反应器开始执行...")  <br />   (setq m_ename (vlax-vla-object->ename  owner_obj))  <br />   ;;碰撞检查start<br />   (setq pt_10 (getitern m_ename 10) ang_50 (getitern m_ename 50) ucs_dir (append pt_10 (list ang_50)))<br />   (setq pt1 (textbox (entget m_ename)) pt3 (cadr pt1)  pt1 (car pt1) b (car pt3) h (cadr pt3))<br />   (setq pt2 (polar pt1 0.0 b) pt4 (polar pt1 (/ pi 2.0) h) pt_list (list pt1 pt2 pt3 pt4))<br />   (setq pt_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_dir) 0 1))) pt_list))<br />   (if (setq ss (ssget "_CP" pt_list '((0 . "TEXT"))))<br />     (if (setq tmp (ssdel m_ename ss)) (setq ss tmp))<br />     )  <br />   ;;碰撞检查end<br />   <br />   (if ss  (princ (strcat "\n文字碰撞：" (getitern (ssname ss 0) 1)))(princ "\n没有碰撞到文字..."))<br />   (if ss (progn<br />   (setq m_text (ssname ss 0)<br />   m_text_10 (getitern m_text 10)<br />   m_text_50 (getitern m_text 50)<br />   m_text_40 (getitern m_text 40)<br />   pt_text_1 (textbox (entget m_text))<br />   pt_text_3 (cadr pt_text_1)  pt_text_1 (car pt_text_1)<br />   pt_text_2 (polar pt_text_1 0.0 (car pt_text_3))<br />   pt_text_4 (polar pt_text_1 (/ pi 2.0) (cadr pt_text_3))<br />   pt_text_list (list pt_text_1 pt_text_2 pt_text_3 pt_text_4)<br />   pt_end1 m_text_10 pt_end2 m_text_10 right_times 0 left_times 0)<br />   (while  ;;计算在碰撞后向右移动多少次可以不再碰撞<br />    (setq pt_start pt_end1 pt_end1 (polar pt_start m_text_50 m_text_40)<br />   right_times (1+ right_times)<br />   ucs_text_dir (append pt_end1 (list m_text_50))<br />   pt_text_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_text_dir) 0 1))) pt_text_list)<br />   ss_1 (ssget "_CP" pt_text_list '((0 . "TEXT")))<br />   )<br />    (princ "\nR移动次数：")(princ right_times)<br />    (princ "\nss_1=")(princ ss_1)<br />    (princ "\n图原名=")(princ (getitern (ssname ss_1 0) -1))<br />    )<br />   (while <br /> ;;计算在碰撞后向左移动多少次可以不再碰撞 <br />    (setq pt_start pt_end2 pt_end2 (polar pt_start (+ m_text_50 pi) m_text_40)<br />   left_times (1+ left_times)<br />   ucs_text_dir (append pt_end2 (list m_text_50))<br />   pt_text_list (mapcar (function(lambda(x)(trans (trans-ucs-obj->w x ucs_text_dir) 0 1))) pt_text_list)<br />   ss_2 (ssget "_CP" pt_text_list '((0 . "TEXT")))<br />   )<br />    (princ "\nL移动次数：")(princ left_times)<br />    (princ "\nss_2=")(princ ss_2)<br />    (princ "\n图原名=")(princ (getitern (ssname ss_2 0) -1))<br />    )<br />   (if (<= right_times left_times)(upobj m_text 10 pt_end1)(upobj m_text 10 pt_end2))    ;;根据向左或是向右移动次数判断向左还是右移动<br />   (princ)<br />   ))<br />   ;(upobj m_text 10 pt_end)<br />   (princ "\n反应器执行结束...\n.")<br />   )

yaokui25

这么好的东西为什么没人顶呢

蔡__洛

yaokui25 发表于 2013-5-8 10:40
这么好的东西为什么没人顶呢

哈哈  反应器 这个东西 说难不难 说简单又不简单 会用的人比较少呢...只有自己顶了...

xsso

还没会用反应器，留个脚印

dafeilang

留个爪印，想弄个跟qleader相似的东东，正好学习一下

vlisp2012

准备学习反应器了！

yaokui25

这么好的东西为什么没人顶呢，期待完善

xiabin68

好东西，，，要看一下，，，

danxingpen

在反应器上附加数据，在回调函数开始的时候检查反应器的附加数据，如果是反应器修改引起的修改则推出反应器程序，，，，，，，

yaokui25

楼主您好，不知道您的问题是否解决了？