求完善LISP提取每个圆圈或者方框内的文字然后把文字合并起来
如图所示，要把每个圆圈或者方框内的上下文字合并起来。比如说中间的文字要提取出PDG-832A和SF-3606。
网上AI找了些代码，但都写得不全或者运行错误。
(defun c:MergeTextsInCircles ()
;; 询问用户是否要选择特定的圆
(princ "\nDo you want to select specific circles (Y/N)? : ")
(setq userChoice (getkword))
;; 如果用户没有输入或输入了'N'或'n'，则自动选择所有圆
(if (or (not userChoice) (equal userChoice "N" "n"))
(setq circles (ssget '((0 . "CIRCLE"))))
(setq circles (ssget '((0 . "CIRCLE")) '_ "Select circles: "))
)
;; 选择所有文本或MTEXT对象
(setq texts (ssget "X" '((0 . "TEXT,MTEXT"))))
;; 检查是否选择了圆和文本
(if (or (not circles) (not texts))
(progn
(princ "\nNo circles or text objects found.")
(exit)
)
)
;; 遍历每个圆
(setq i 0)
(repeat (sslength circles)
(setq circleEnt (ssname circles i))
(setq circleData (entget circleEnt))
(setq circleCenter (cdr (assoc 10 circleData)))
(setq circleRadius (cdr (assoc 40 circleData)))
;; 检查圆内的文本
(setq textsInCircle nil)
(setq j 0)
(repeat (sslength texts)
(setq textEnt (ssname texts j))
(setq textData (entget textEnt))
(setq textPos (cdr (assoc 10 textData)))
(setq textContent (cdr (assoc 1 textData)))
;; 如果文本在圆内
(if (point-in-circle textPos circleCenter circleRadius)
(setq textsInCircle (cons (list textEnt textContent textPos) textsInCircle))
)
(setq j (1+ j))
)
;; 如果圆内有文本，则合并文本
(if textsInCircle
(progn
(setq firstText (car textsInCircle))
(setq firstTextEnt (car firstText))
(setq firstTextContent (cadr firstText))
;; 合并文本内容
(foreach text (cdr textsInCircle)
(setq textEnt (car text))
(setq textContent (cadr text))
(if (not (wcmatch (strcase firstTextContent) (strcase textContent)))
(setq firstTextContent (strcat firstTextContent "\n" textContent))
)
(entdel textEnt) ; 删除合并后的文本对象
)
;; 更新第一个文本对象的内容
(setq firstTextData (entget firstTextEnt))
(setq firstTextData (subst (cons 1 firstTextContent) (assoc 1 firstTextData) firstTextData))
(entmod firstTextData)
(princ (strcat "\nUpdated circle with merged text: "))
(princ firstTextContent)
)
)
(setq i (1+ i))
)
(princ "\nText merge complete.")
(princ)
)
(defun point-in-circle (pt center radius)
(setq dx (- (car pt) (car center)))
(setq dy (- (cadr pt) (cadr center)))
(<= (+ (* dx dx) (* dy dy)) (* radius radius))
)
(princ "\nType 'MergeTextsInCircles' to run the script.")
(princ)
页:
[1]