Monday, July 27, 2009

Find duplicate text and mtext on a drawing.

;; This AutoLISP routine examines all the user-selected TEXT and MTEXT items,
;; and draws a line on the current layer between any two that have identical
;; string values.
;; Leading and trailing blanks spaces are ignored.
;; %% modifiers, like %%u, are not ignored.
;; Upper- and lower-case differences are not ignored.

(defun c:fdt () ;;Find Duplicate Text

(prompt "Select text items to examine: ")
(setq ss (ssget '((-4 . ""))))

(setq n 0)

(while
(< n (sslength ss))
(setq string1 (cdr (assoc 1 (entget (ssname ss n)))))
(setq string1 (vl-string-right-trim " " (vl-string-left-trim " " string1)))
(setq m (1+ n))

(while
(< m (sslength ss))
(progn
(setq string2 (cdr (assoc 1 (entget (ssname ss m)))))
(setq string2 (vl-string-right-trim " " (vl-string-left-trim " " string2)))
(if (= string1 string2)
(progn
(setq p1 (cdr (assoc 10 (entget (ssname ss n)))))
(setq p2 (cdr (assoc 10 (entget (ssname ss m)))))
(command "line" p1 p2 "")
);progn
);if
);progn
(setq m (1+ m))
);while m

(setq n (1+ n))
);while n

);defun

(princ "Type FDT to run the Find_Dup_Text routine.")
(princ)

No comments:

Post a Comment