;; 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