[LISP程序]：带有特征遗传的结构改字程序

chlh_jd

;;===================================================================;
;;;将所选择的多个文字改为另外同一个文字                              ;
;;;==================================================================;
(defun c:gz (/ enttt e1 e2 stext strlen1 e2_strlen es str_div e2_str)
  (setvar "cmdecho" 0)
  (setq enttt (car (nentsel "\n选择源文字:")))
  (setq e1 (entget enttt))
  (redraw enttt 3)
  (setq stext (cdr (assoc 1 e1)))
  (if (= (cdr (assoc 0 e1)) "TEXT")
    (progn
      (setq strlen1 (strlen stext))
      (setq str_div
             (cond
               ((wcmatch stext "*[`@-]*###") "*[`@-]*###")
               ((wcmatch stext "*[`@-]*###(#)") "*[`@-]*###(#)")
               ((wcmatch stext "*[GN]*%%13*") "[GN]*%%13")
               ((wcmatch stext "#%%13###*") "#%%13###")
               ((wcmatch stext "##%%13###*") "##%%13###")
               ((wcmatch stext "H=*") "H=")               
               ((wcmatch stext "*L*") "*L")
               ((wcmatch stext "*Z*") "*Z")
               ((wcmatch stext "*[xX`*]*") "*[xX`*]")
               ((szpd stext) "num")
               ((>= strlen1 20) "longstr")
               (nil)
             )
      )
      (if str_div
        (progn
          (prompt "\n选择要替换的目标文字:")
          (setq ss (ssget '((0 . "TEXT"))))
          (setq i -1)
          (while (setq es (ssname ss (setq i (1+ i))))
            (setq e2 (entget es))
            (setq e2_str (cdr (assoc 1 e2)))
            (setq e2_strlen (strlen e2_str))
            (cond ((and        (= (wcmatch e2_str (strcat str_div "*")) T)
                        (< e2_strlen 20)
                   )
                   (progn
                     (setq e2 (subst (cons 1 stext)
                                     (assoc 1 e2)
                                     e2
                              )
                     )
                     (entmod e2)
                   )
                  )
                  ((and (= str_div "num") (= (szpd e2_str) T))
                   (progn
                     (setq e2 (subst (cons 1 stext)
                                     (assoc 1 e2)
                                     e2
                              )
                     )
                     (entmod e2)
                   )
                  )
                  ((and (= str_div "longstr") (>= e2_strlen 20))
                   (progn
                     (setq e2 (subst (cons 1 stext)
                                     (assoc 1 e2)
                                     e2
                              )
                     )
                     (entmod e2)
                   )
                  )
            )                                ;end cond
          )                                ;end while
        )                                ;end progn
        nil
      )                                        ;end if
    )                                        ;end progn
    nil
  )                                        ;end if
  (redraw enttt 4)
  (setvar "cmdecho" 1)
  (princ "\n将所选择的多个文字改为另外同一个文字,命令为GZ")
  (princ)
)
(defun szpd (str /)
  (setq
    str        (vl-string-right-trim
          "."
          (vl-string-left-trim " " (vl-string-right-trim "0" str))
        )
  )
  (if
    (=
      (vl-string-right-trim
        "0"
        (rtos
          (atof str)
          2
          (if (vl-string-search "." str)
            (strlen (substr str (+ (vl-string-search "." str) 2)))
            0
          )

        )
      )
      str
    )
     T
     nil
  )
)