做了一个切换窗口的程序，求大神完善

yu960312

如下程序，求完善双击列表直接切换窗口功能

2. (defun C:sw (/ dc)
   
3. (defun mystrcat1 (i);;文本框1
   
4. (if (= fn 0)
   
5. (set_tile "edit_box1" (setq dc(cadr (nth (atoi i) myList))))
   
6. (set_tile "edit_box1" (setq dc(car(nth (atoi i) findlist))))
   
7. )
   
8. ;(if (= $reason 4);;双击
   
9. ;(progn
   
10. ;(my_qh)
    
11. ;)
    
12. ;)
    
13. )
    
14. 
    
15. (defun my_qh();;切换按钮
    
16. (setq m 0
    
17. dwg nil
    
18. n (length myList)
    
19. dwgn 0
    
20. )
    
21. (if dc
    
22. (progn
    
23. (setq dwgn 1)
    
24. (while (< m n)
    
25. (setq str(nth m myList))
    
26. (setq str1(cadr str))
    
27. (if  (wcmatch str1 dc)
    
28. (progn
    
29. (setq str2(caddr str))
    
30. (setq dwg(list str2))
    
31. (setq m (+ n 1))
    
32. )
    
33. )
    
34. (setq m (+ m 1))
    
35. )
    
36. )
    
37. )
    
38. (princ)
    
39. )
    
40. 
    
41. (defun my_cz();;查找按钮
    
42. (setq dcc(get_tile "edit_box1"))
    
43. (if (/= dcc "")
    
44. (progn
    
45. (setq fn 1)
    
46. (setq findlist '())
    
47. (setq findlist1 '())
    
48. (setq finds(strcat "*" dcc "*"))
    
49. (setq m 0 n (length myList))
    
50. (while (< m n)
    
51. (setq str(nth m myList))
    
52. (setq str1(cadr str))
    
53. (setq str2(caddr str))
    
54. (if  (wcmatch str1 finds)
    
55. (progn
    
56. (setq findlist(append findlist (list (list str1 str2))))
    
57. )
    
58. )
    
59. (setq m (+ m 1))
    
60. )
    
61. )
    
62. )
    
63. 
    
64. (if (> (length findlist) 0)
    
65. (progn
    
66. (start_list "mylist" 3)
    
67. (foreach x findlist
    
68. (add_list (car x))
    
69. )
    
70. (end_list)
    
71. (alert "\n查找完成 ! ! !")
    
72. )
    
73. (alert "\n未找到 ! ! !")
    
74. )
    
75. 
    
76. (princ)
    
77. )
    
78. 
    
79. (defun my_sx();;刷新按钮
    
80. (setq i 0)
    
81. (setq fn 0)
    
82. (start_list "mylist" 3)
    
83. (foreach x myList
    
84. (add_list (cadr x))
    
85. )
    
86. (end_list)
    
87. (alert "\n刷新成功 ! ! !")
    
88. )
    
89. 
    
90. (setq acdocs (vla-get-Documents (vlax-get-acad-object)))
    
91. (setq i 0)
    
92. (setq fn 0)
    
93. (setq myList '())
    
94. ;;myList(不带路径列表 带路径列表 object列表)
    
95. (vlax-for item acdocs
    
96. ;(vlax-dump-object item)
    
97. (setq i(+ i 1))
    
98. (setq name1 (vlax-get-property item 'Name))
    
99. (setq name2 (vlax-get-property item 'WindowTitle))
    
100. (setq myList(append myList (list (list name1 name2 item))));;带路径列表&object列表
     
101. )
     
102. 
     
103. (setq dcl_id (load_dialog "DCL.dcl"))
     
104. (new_dialog "DCL_4" dcl_id)
     
105. (action_tile "mylist" "(setq list1_value $value)(mystrcat1 list1_value)")
     
106. (action_tile "button1" "(done_dialog 2)(my_qh)")
     
107. (action_tile "button2" "(my_cz)")
     
108. (action_tile "button3" "(my_sx)")
     
109. 
     
110. (setq m 0 n (length myList))
     
111. (while (< m n)
     
112. (setq str(nth m myList))
     
113. (setq str1(car str))
     
114. (if  (wcmatch str1 (getvar "dwgname"))
     
115. (progn
     
116. (setq str2(cadr str))
     
117. (set_tile "edit_box1" str2)
     
118. (setq m (+ n 1))
     
119. )
     
120. )
     
121. (setq m (+ m 1))
     
122. )
     
123. 
     
124. (start_list "mylist" 3)
     
125. (foreach x myList
     
126. (add_list (cadr x))
     
127. )
     
128. (end_list)
     
129. (setq code(start_dialog))
     
130. (unload_dialog dcl_id)
     
131. 
     
132. (cond
     
133. ((= code 2)
     
134. (progn
     
135. (if (= dwgn 1)
     
136. (progn
     
137. (vl-catch-all-apply 'vla-Activate dwg)
     
138. )
     
139. (progn
     
140. (princ (strcat "\n错误: 请选择切换窗口文件的路径 ! ! !"))
     
141. (alert (strcat "\n错误: 请选择切换窗口文件的路径 ! ! !"))
     
142. )
     
143. )
     
144. )
     
145. )
     
146. )
     
147. (princ)
     
148. )
     
149. 
     

(defun C:sw (/ dc)<br /> (defun mystrcat1 (i);;文本框1<br /> (if (= fn 0)<br /> (set_tile "edit_box1" (setq dc(cadr (nth (atoi i) myList))))<br /> (set_tile "edit_box1" (setq dc(car(nth (atoi i) findlist))))<br /> )<br /> ;(if (= $reason 4);;双击<br /> ;(progn<br /> ;(my_qh)<br /> ;)<br /> ;)<br /> )<br /> <br /> (defun my_qh();;切换按钮<br /> (setq m 0<br /> dwg nil<br /> n (length myList)<br /> dwgn 0<br /> )<br /> (if dc<br /> (progn<br /> (setq dwgn 1)<br /> (while (< m n)<br /> (setq str(nth m myList))<br /> (setq str1(cadr str))<br /> (if  (wcmatch str1 dc)<br /> (progn<br /> (setq str2(caddr str))<br /> (setq dwg(list str2))<br /> (setq m (+ n 1))<br /> )<br /> )<br /> (setq m (+ m 1))<br /> )<br /> )<br /> )<br /> (princ)<br /> )<br /> <br /> (defun my_cz();;查找按钮<br /> (setq dcc(get_tile "edit_box1"))<br /> (if (/= dcc "")<br /> (progn<br /> (setq fn 1)<br /> (setq findlist '())<br /> (setq findlist1 '())<br /> (setq finds(strcat "*" dcc "*"))<br /> (setq m 0 n (length myList))<br /> (while (< m n)<br /> (setq str(nth m myList))<br /> (setq str1(cadr str))<br /> (setq str2(caddr str))<br /> (if  (wcmatch str1 finds)<br /> (progn<br /> (setq findlist(append findlist (list (list str1 str2))))<br /> )<br /> )<br /> (setq m (+ m 1))<br /> )<br /> )<br /> )<br /> <br /> (if (> (length findlist) 0)<br /> (progn<br /> (start_list "mylist" 3)<br /> (foreach x findlist<br /> (add_list (car x))<br /> )<br /> (end_list)<br /> (alert "\n查找完成 ! ! !")<br /> )<br /> (alert "\n未找到 ! ! !")<br /> )<br /> <br /> (princ)<br /> )<br /> <br /> (defun my_sx();;刷新按钮<br /> (setq i 0)<br /> (setq fn 0)<br /> (start_list "mylist" 3)<br /> (foreach x myList<br /> (add_list (cadr x))<br /> )<br /> (end_list)<br /> (alert "\n刷新成功 ! ! !")<br /> )<br /> <br /> (setq acdocs (vla-get-Documents (vlax-get-acad-object)))<br /> (setq i 0)<br /> (setq fn 0)<br /> (setq myList '())<br /> ;;myList(不带路径列表 带路径列表 object列表)<br /> (vlax-for item acdocs<br /> ;(vlax-dump-object item)<br /> (setq i(+ i 1))<br /> (setq name1 (vlax-get-property item 'Name))<br /> (setq name2 (vlax-get-property item 'WindowTitle))<br /> (setq myList(append myList (list (list name1 name2 item))));;带路径列表&object列表<br /> )<br /> <br /> (setq dcl_id (load_dialog "DCL.dcl"))<br /> (new_dialog "DCL_4" dcl_id)<br /> (action_tile "mylist" "(setq list1_value $value)(mystrcat1 list1_value)")<br /> (action_tile "button1" "(done_dialog 2)(my_qh)")<br /> (action_tile "button2" "(my_cz)")<br /> (action_tile "button3" "(my_sx)")<br /> <br /> (setq m 0 n (length myList))<br /> (while (< m n)<br /> (setq str(nth m myList))<br /> (setq str1(car str))<br /> (if  (wcmatch str1 (getvar "dwgname"))<br /> (progn<br /> (setq str2(cadr str))<br /> (set_tile "edit_box1" str2)<br /> (setq m (+ n 1))<br /> )<br /> )<br /> (setq m (+ m 1))<br /> )<br /> <br /> (start_list "mylist" 3)<br /> (foreach x myList<br /> (add_list (cadr x))<br /> )<br /> (end_list)<br /> (setq code(start_dialog))<br /> (unload_dialog dcl_id)<br /> <br /> (cond <br /> ((= code 2)<br /> (progn<br /> (if (= dwgn 1)<br /> (progn<br /> (vl-catch-all-apply 'vla-Activate dwg)<br /> )<br /> (progn<br /> (princ (strcat "\n错误: 请选择切换窗口文件的路径 ! ! !"))<br /> (alert (strcat "\n错误: 请选择切换窗口文件的路径 ! ! !"))<br /> )<br /> )<br /> )<br /> )<br /> )<br /> (princ)<br /> )<br /> <br />

yu960312

guankuiwu 发表于 2023-9-8 09:25
(action_tile "mylist" "(setq list1_value $value)(mystrcat1 list1_value)(if (= $reason 4)(done_dialog ...

等下试试看，感谢大佬

yu960312

guankuiwu 发表于 2023-9-8 09:25
(action_tile "mylist" "(setq list1_value $value)(mystrcat1 list1_value)(if (= $reason 4)(done_dialog ...

完美解决，感谢

yu960312

Bao_lai 发表于 2023-9-7 18:16
虽然cad自带有图纸标签功能，你这个用不上，但还是为你钻研的精神点赞。

平时打开图档太多，找图比较麻烦，才搞了个这个程序

664571221

兄弟你也太厉害了。

Bao_lai

虽然cad自带有图纸标签功能，你这个用不上，但还是为你钻研的精神点赞。

664571221

yu960312 发表于 2023-9-7 18:19
平时打开图档太多，找图比较麻烦，才搞了个这个程序

你的技术让人眼前一亮

mashanjie

这个是需要DCL支持吗？还是可以直接在CAD加载LSP？

magicheno

感谢大佬分享

panliang9

谢谢楼主分享

acoff

看着不错，多谢分享

nyistjz

出现这个弹窗，无法正常使用。