选择的问题

xgr

用OPENDCL 制作了个面板控件，从面板切换到CAD选择是总是提示
无法重复进入 LISP。
*无效选择*
需要单个对象。
不知道问题出在哪里？
程序如下：

2. (defun C:Point_Repair ()
   
3.   ;;确保加载ObjectDcl动态连接库
   
4.   (if (not (member "OpenDCL.16.arx" (arx)))
   
5.     (arxload "C:\\Program Files\\徐光工具\\system\\OpenDCL.16.arx")
   
6.     ("加载OpenDCL.16.arx 失败.")
   
7.   )
   
8.   ;;加载对话框odc文件
   
9. (dcl_Project_Load "PointRepair.odcl")
   
10.   ;;显示DclForm1对话框
    
11.   (dcl_Form_Show PointRepair_Form1)
    
12.   (princ)
    
13. )
    
14. 
    
15. 
    
16. (defun c:PointRepair_Form1_TextButton1_OnClicked (/)
    
17.   (setq ent (ssget "x" '((0 . "INSERT")(2 . "Point_mk"))))
    
18.   (setq n 0)
    
19.   (repeat (sslength ent)
    
20.     (setq ent1(entget (ssname ent n)))
    
21.     (setq ss (entget (ssname ent n) (list "US_XGGJ"))) ;取实体数据表US_XGGJ
    
22.     ;;点号
    
23.     (if  (/= (assoc -3 ss) nil)
    
24.       (progn (setq dm (cdr (nth 2 (cadr (assoc -3 ss)))))
    
25.        (if (= dm nil)
    
26.          (setq dm " ")
    
27.        )
    
28.       )
    
29.       (setq dm " ")
    
30.     )
    
31.     ;;X坐标
    
32.     (setq coordinates_x(rtos (nth 0 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))
    
33.     ;;y坐标
    
34.     (setq coordinates_y(rtos (nth 1 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))
    
35.      ;;y坐标
    
36.     (setq coordinates_z(rtos (nth 2 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))
    
37.     (setq n (1+ n))
    
38.     (setq str (strcat (itoa n) "\t" dm "\t" coordinates_x "\t" coordinates_y "\t" coordinates_z))
    
39.     (dcl_Grid_AddString PointRepair_Form1_格1 str)
    
40.   )
    
41.   (alert (strcat "共读入测量点数据" (itoa n) "个"))
    
42. )
    
43. 
    
44. ;;双击将选择的点名称文字加入到扩展数据
    
45. (defun PointRepair_Form1_格1_OnDblClicked (Row Column /)
    
46.   (setq mm (dcl_Grid_GetCurCell PointRepair_Form1_格1))
    
47.   (setq l (getvar "ltscale"))
    
48.   (if (= (cadr mm) -1)
    
49.     (progn (dcl_Control_SetKeepFocus PointRepair_Form1 False)
    
50.      (setq x (dcl_Grid_GetCellText PointRepair_Form1_格1 (car mm) 2))
    
51.      (setq y (dcl_Grid_GetCellText PointRepair_Form1_格1 (car mm) 3))
    
52.      (setq coord (list (atof x) (atof y)))
    
53.      (command "zoom" "c" coord (* 20 l))
    
54.      (setq p1 (polar (polar coord (UcsRotationAngle) (* l 0.5))
    
55.          (+ (/ pi 2) (UcsRotationAngle))
    
56.          (* l 0.5)
    
57.         )
    
58.      )
    
59.      (setq p2 (polar p1 (+ pi (UcsRotationAngle)) (* l 1)))
    
60.      (setq p3 (polar p2 (+ (/ (* pi 3) 2) (UcsRotationAngle)) (* l 1)))
    
61.      (setq p4 (polar p3 (UcsRotationAngle) (* l 1)))
    
62.      (grdraw p1 p2 1)
    
63.      (grdraw p2 p3 1)
    
64.      (grdraw p3 p4 1)
    
65.      (grdraw p4 p1 1)
    
66.      ;;在ENT选择集里查找对象
    
67.      (setq coordinates_x ""
    
68.      coordinates_y ""
    
69.      n 0
    
70.      )
    
71.      (while (and (/= x coordinates_x) (/= y coordinates_y) (< n (sslength ent)))
    
72.        (setq ent1 (entget (ssname ent n)))
    
73.        (setq ent1_name (cdr (assoc -1 ent1)))
    
74.        (setq coordinates_x (rtos (nth 1 (assoc 10 ent1)) 2 3))
    
75.        (setq coordinates_y (rtos (nth 2 (assoc 10 ent1)) 2 3))
    
76.        (setq n (1+ n))
    
77.      )
    
78.      (setq ss (ssadd ent1_name))
    
79.      (sssetfirst ss ss)
    
80.      (setq en (nentselp "\n请选择为该点名称的文字或多行文字:"))
    
81.      (setq stbmx (itoa 510001))
    
82.      (setq pb (entget ent1_name))
    
83.      (setq xb
    
84.       (append
    
85.         pb
    
86.         (list
    
87.           (list '-3
    
88.           (list "US_XGGJ" (cons 1000 stbmx) (cons 1000 (cdr (assoc 1 (entget (car en))))))
    
89.           )
    
90.         )
    
91.       )
    
92.      )
    
93.      (entmod xb)
    
94.      (dcl_Grid_SetCellText PointRepair_Form1_格1 (car mm) 1 (cdr (assoc 1 (entget (car en)))))
    
95.      (prompt "\n 已经把点名加入了扩展数据！")
    
96.      (dcl_Control_SetKeepFocus PointRepair_Form1 true)
    
97.     )
    
98.   )
    
99.   (princ)
    
100. )
     
101. 
     
102. ;;关闭窗口
     
103. (defun c:PointRepair_Form1_TextButton3_OnClicked (/)
     
104.   (dcl_Form_Close PointRepair_Form1)
     
105. )
     
106. 
     
107. (defun c:PointRepair_Form1_格1_OnMouseUp (Button Flags X Y /)
     
108.   (dcl_Control_SetText PointRepair_Form1_TextBox1 "双击序号列可以进入点编辑状态")
     
109. )
     

(defun C:Point_Repair ()<br />   ;;确保加载ObjectDcl动态连接库<br />   (if (not (member "OpenDCL.16.arx" (arx)))<br />     (arxload "C:\\Program Files\\徐光<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>\\system\\OpenDCL.16.arx")<br />     ("加载OpenDCL.16.arx 失败.")<br />   )<br />   ;;加载对话框odc文件 <br /> (dcl_Project_Load "PointRepair.odcl")<br />   ;;显示DclForm1对话框 <br />   (dcl_Form_Show PointRepair_Form1)<br />   (princ)<br /> )<br /> <br /> <br /> (defun c:PointRepair_Form1_TextButton1_OnClicked (/)<br />   (setq ent (ssget "x" '((0 . "INSERT")(2 . "Point_mk"))))<br />   (setq n 0)<br />   (repeat (sslength ent)<br />     (setq ent1(entget (ssname ent n)))<br />     (setq ss (entget (ssname ent n) (list "US_XGGJ"))) ;取实体数据表US_XGGJ<br />     ;;点号<br />     (if  (/= (assoc -3 ss) nil)<br />       (progn (setq dm (cdr (nth 2 (cadr (assoc -3 ss)))))<br />        (if (= dm nil)<br />          (setq dm " ")<br />        )<br />       )<br />       (setq dm " ")<br />     )<br />     ;;X坐标<br />     (setq coordinates_x(rtos (nth 0 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))<br />     ;;y坐标<br />     (setq coordinates_y(rtos (nth 1 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))<br />      ;;y坐标<br />     (setq coordinates_z(rtos (nth 2 (trans (cdr(assoc 10 ent1)) 0 1)) 2 3))<br />     (setq n (1+ n))<br />     (setq str (strcat (itoa n) "\t" dm "\t" coordinates_x "\t" coordinates_y "\t" coordinates_z))<br />     (dcl_Grid_AddString PointRepair_Form1_格1 str)<br />   )<br />   (alert (strcat "共读入测量点数据" (itoa n) "个"))<br /> )<br /> <br /> ;;双击将选择的点名称文字加入到扩展数据<br /> (defun PointRepair_Form1_格1_OnDblClicked (Row Column /)<br />   (setq mm (dcl_Grid_GetCurCell PointRepair_Form1_格1))<br />   (setq l (getvar "ltscale"))<br />   (if (= (cadr mm) -1)<br />     (progn (dcl_Control_SetKeepFocus PointRepair_Form1 False)<br />      (setq x (dcl_Grid_GetCellText PointRepair_Form1_格1 (car mm) 2))<br />      (setq y (dcl_Grid_GetCellText PointRepair_Form1_格1 (car mm) 3))<br />      (setq coord (list (atof x) (atof y)))<br />      (command "zoom" "c" coord (* 20 l))<br />      (setq p1 (polar (polar coord (UcsRotationAngle) (* l 0.5))<br />          (+ (/ pi 2) (UcsRotationAngle))<br />          (* l 0.5)<br />         )<br />      )<br />      (setq p2 (polar p1 (+ pi (UcsRotationAngle)) (* l 1)))<br />      (setq p3 (polar p2 (+ (/ (* pi 3) 2) (UcsRotationAngle)) (* l 1)))<br />      (setq p4 (polar p3 (UcsRotationAngle) (* l 1)))<br />      (grdraw p1 p2 1)<br />      (grdraw p2 p3 1)<br />      (grdraw p3 p4 1)<br />      (grdraw p4 p1 1)<br />      ;;在ENT选择集里查找对象<br />      (setq coordinates_x ""<br />      coordinates_y ""<br />      n 0<br />      )<br />      (while (and (/= x coordinates_x) (/= y coordinates_y) (< n (sslength ent)))<br />        (setq ent1 (entget (ssname ent n)))<br />        (setq ent1_name (cdr (assoc -1 ent1)))<br />        (setq coordinates_x (rtos (nth 1 (assoc 10 ent1)) 2 3))<br />        (setq coordinates_y (rtos (nth 2 (assoc 10 ent1)) 2 3))<br />        (setq n (1+ n))<br />      )<br />      (setq ss (ssadd ent1_name))<br />      (sssetfirst ss ss)<br />      (setq en (nentselp "\n请选择为该点名称的文字或多行文字:"))<br />      (setq stbmx (itoa 510001))<br />      (setq pb (entget ent1_name))<br />      (setq xb<br />       (append<br />         pb<br />         (list<br />           (list '-3<br />           (list "US_XGGJ" (cons 1000 stbmx) (cons 1000 (cdr (assoc 1 (entget (car en))))))<br />           )<br />         )<br />       )<br />      )<br />      (entmod xb)<br />      (dcl_Grid_SetCellText PointRepair_Form1_格1 (car mm) 1 (cdr (assoc 1 (entget (car en)))))<br />      (prompt "\n 已经把点名加入了扩展数据！")<br />      (dcl_Control_SetKeepFocus PointRepair_Form1 true)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;关闭窗口<br /> (defun c:PointRepair_Form1_TextButton3_OnClicked (/)<br />   (dcl_Form_Close PointRepair_Form1)<br /> )<br /> <br /> (defun c:PointRepair_Form1_格1_OnMouseUp (Button Flags X Y /)<br />   (dcl_Control_SetText PointRepair_Form1_TextBox1 "双击序号列可以进入点编辑状态")<br /> )<br />

ODCL文件



请看动画里命令行提示，不知道错误到底出在那儿。

xgr

谁见过这样的文字

bluelisp

我见过
我的问题原因是：LISP提请等待用户输入过程中，无法执行其他任何LISP函数，直到用户输入完毕。
例如：点击ODCL后，执行getpoint函数，当鼠标从ODCL移到绘图区时，该动作会触发MouseMovedOff事件，事件响应函数OnMouseMovedOff中肯定需要用AutoLISP定义一些动作，如(princ)，此时会出现“无法重复进入 LISP”错误。解决办法：去除ODCL中MouseMovedOff事件
希望对你是否有帮助

xgr

谢谢，我知道了什么原因，程序没有问题，是鼠标的左键有点问题。单击左键有时候会出现双击的现象。

一克拉沙

遇到了类似问题载入程序后，单击按钮调用外部LISP文件，提示“无法重复进入 LISP”。