求完善LISP提取每个圆圈或者方框内的文字然后把文字合并起来

qqask

如图所示，要把每个圆圈或者方框内的上下文字合并起来。

比如说中间的文字要提取出PDG-832A和SF-3606。
网上AI找了些代码，但都写得不全或者运行错误。

1. (defun c:MergeTextsInCircles ()  
   
2.     ;; 询问用户是否要选择特定的圆  
   
3.     (princ "\nDo you want to select specific circles (Y/N)? [N]: ")  
   
4.     (setq userChoice (getkword))  
   
5.   
   
6.     ;; 如果用户没有输入或输入了'N'或'n'，则自动选择所有圆  
   
7.     (if (or (not userChoice) (equal userChoice "N" "n"))  
   
8.         (setq circles (ssget '((0 . "CIRCLE"))))  
   
9.         (setq circles (ssget '((0 . "CIRCLE")) '_ "Select circles: "))  
   
10.     )  
    
11.   
    
12.     ;; 选择所有文本或MTEXT对象  
    
13.     (setq texts (ssget "X" '((0 . "TEXT,MTEXT"))))  
    
14.   
    
15.     ;; 检查是否选择了圆和文本  
    
16.     (if (or (not circles) (not texts))  
    
17.         (progn  
    
18.             (princ "\nNo circles or text objects found.")  
    
19.             (exit)  
    
20.         )  
    
21.     )  
    
22.   
    
23.     ;; 遍历每个圆  
    
24.     (setq i 0)  
    
25.     (repeat (sslength circles)  
    
26.         (setq circleEnt (ssname circles i))  
    
27.         (setq circleData (entget circleEnt))  
    
28.         (setq circleCenter (cdr (assoc 10 circleData)))  
    
29.         (setq circleRadius (cdr (assoc 40 circleData)))  
    
30.   
    
31.         ;; 检查圆内的文本  
    
32.         (setq textsInCircle nil)  
    
33.         (setq j 0)  
    
34.         (repeat (sslength texts)  
    
35.             (setq textEnt (ssname texts j))  
    
36.             (setq textData (entget textEnt))  
    
37.             (setq textPos (cdr (assoc 10 textData)))  
    
38.             (setq textContent (cdr (assoc 1 textData)))  
    
39.   
    
40.             ;; 如果文本在圆内  
    
41.             (if (point-in-circle textPos circleCenter circleRadius)  
    
42.                 (setq textsInCircle (cons (list textEnt textContent textPos) textsInCircle))  
    
43.             )  
    
44.             (setq j (1+ j))  
    
45.         )  
    
46.   
    
47.         ;; 如果圆内有文本，则合并文本  
    
48.         (if textsInCircle  
    
49.             (progn  
    
50.                 (setq firstText (car textsInCircle))  
    
51.                 (setq firstTextEnt (car firstText))  
    
52.                 (setq firstTextContent (cadr firstText))  
    
53.   
    
54.                 ;; 合并文本内容  
    
55.                 (foreach text (cdr textsInCircle)  
    
56.                     (setq textEnt (car text))  
    
57.                     (setq textContent (cadr text))  
    
58.                     (if (not (wcmatch (strcase firstTextContent) (strcase textContent)))  
    
59.                         (setq firstTextContent (strcat firstTextContent "\n" textContent))  
    
60.                     )  
    
61.                     (entdel textEnt) ; 删除合并后的文本对象  
    
62.                 )  
    
63.   
    
64.                 ;; 更新第一个文本对象的内容  
    
65.                 (setq firstTextData (entget firstTextEnt))  
    
66.                 (setq firstTextData (subst (cons 1 firstTextContent) (assoc 1 firstTextData) firstTextData))  
    
67.                 (entmod firstTextData)  
    
68.   
    
69.                 (princ (strcat "\nUpdated circle with merged text: "))  
    
70.                 (princ firstTextContent)  
    
71.             )  
    
72.         )  
    
73.         (setq i (1+ i))  
    
74.     )  
    
75.   
    
76.     (princ "\nText merge complete.")  
    
77.     (princ)  
    
78. )  
    
79.   
    
80. (defun point-in-circle (pt center radius)  
    
81.     (setq dx (- (car pt) (car center)))  
    
82.     (setq dy (- (cadr pt) (cadr center)))  
    
83.     (<= (+ (* dx dx) (* dy dy)) (* radius radius))  
    
84. )  
    
85.   
    
86. (princ "\nType 'MergeTextsInCircles' to run the script.")  
    
87. (princ)

(defun c:MergeTextsInCircles ()  <br />     ;; 询问用户是否要选择特定的圆  <br />     (princ "\nDo you want to select specific circles (Y/N)? [N]: ")  <br />     (setq userChoice (getkword))  <br />   <br />     ;; 如果用户没有输入或输入了'N'或'n'，则自动选择所有圆  <br />     (if (or (not userChoice) (equal userChoice "N" "n"))  <br />         (setq circles (ssget '((0 . "CIRCLE"))))  <br />         (setq circles (ssget '((0 . "CIRCLE")) '_ "Select circles: "))  <br />     )  <br />   <br />     ;; 选择所有文本或MTEXT对象  <br />     (setq texts (ssget "X" '((0 . "TEXT,MTEXT"))))  <br />   <br />     ;; 检查是否选择了圆和文本  <br />     (if (or (not circles) (not texts))  <br />         (progn  <br />             (princ "\nNo circles or text objects found.")  <br />             (exit)  <br />         )  <br />     )  <br />   <br />     ;; 遍历每个圆  <br />     (setq i 0)  <br />     (repeat (sslength circles)  <br />         (setq circleEnt (ssname circles i))  <br />         (setq circleData (entget circleEnt))  <br />         (setq circleCenter (cdr (assoc 10 circleData)))  <br />         (setq circleRadius (cdr (assoc 40 circleData)))  <br />   <br />         ;; 检查圆内的文本  <br />         (setq textsInCircle nil)  <br />         (setq j 0)  <br />         (repeat (sslength texts)  <br />             (setq textEnt (ssname texts j))  <br />             (setq textData (entget textEnt))  <br />             (setq textPos (cdr (assoc 10 textData)))  <br />             (setq textContent (cdr (assoc 1 textData)))  <br />   <br />             ;; 如果文本在圆内  <br />             (if (point-in-circle textPos circleCenter circleRadius)  <br />                 (setq textsInCircle (cons (list textEnt textContent textPos) textsInCircle))  <br />             )  <br />             (setq j (1+ j))  <br />         )  <br />   <br />         ;; 如果圆内有文本，则合并文本  <br />         (if textsInCircle  <br />             (progn  <br />                 (setq firstText (car textsInCircle))  <br />                 (setq firstTextEnt (car firstText))  <br />                 (setq firstTextContent (cadr firstText))  <br />   <br />                 ;; 合并文本内容  <br />                 (foreach text (cdr textsInCircle)  <br />                     (setq textEnt (car text))  <br />                     (setq textContent (cadr text))  <br />                     (if (not (wcmatch (strcase firstTextContent) (strcase textContent)))  <br />                         (setq firstTextContent (strcat firstTextContent "\n" textContent))  <br />                     )  <br />                     (entdel textEnt) ; 删除合并后的文本对象  <br />                 )  <br />   <br />                 ;; 更新第一个文本对象的内容  <br />                 (setq firstTextData (entget firstTextEnt))  <br />                 (setq firstTextData (subst (cons 1 firstTextContent) (assoc 1 firstTextData) firstTextData))  <br />                 (entmod firstTextData)  <br />   <br />                 (princ (strcat "\nUpdated circle with merged text: "))  <br />                 (princ firstTextContent)  <br />             )  <br />         )  <br />         (setq i (1+ i))  <br />     )  <br />   <br />     (princ "\nText merge complete.")  <br />     (princ)  <br /> )  <br />   <br /> (defun point-in-circle (pt center radius)  <br />     (setq dx (- (car pt) (car center)))  <br />     (setq dy (- (cadr pt) (cadr center)))  <br />     (<= (+ (* dx dx) (* dy dy)) (* radius radius))  <br /> )  <br />   <br /> (princ "\nType 'MergeTextsInCircles' to run the script.")  <br /> (princ)