wyb36870 发表于 2016-4-26 00:54:23

求助：如何实现多选，且能同时修改单行文字和多行文字的字高


[*](defun C:Z2(/ a en1 ent len n newr nn oldr s ss test)
[*](setvar "CMDECHO" 0)
[*](setq test T nn 0)
[*](while test
[*]    (setq ss (ssadd))
[*]    (setq ss (ssget))
[*]    (if (= nil ss)
[*]      (setq test nil)
[*]      (progn
[*]      (setq len (sslength ss))
[*]      (setq n 1 s 1)
[*]      (while (<= n len)
[*]          (setq en1 (ssname ss (1- n)))
[*]          (setq a (entget en1))
[*]          (if(= "TEXT" (cdr (assoc 0 a)))
[*]            (progn
[*]            (if (= s 1)
[*]                (progn
[*]                  (setq oldr (cdr (assoc 40 a)))
[*]                  ;(setq newr (getreal (strcat "\nNew high <" (rtos oldr 2 1) ">:")))
[*]                  (setq newr(* 5 5 (getvar "celtscale")))
[*]                  (if (= newr nil) (setq newr oldr))
[*]                  (setq s nil)
[*]                )
[*]            )
[*]            (setq ent (subst (cons 40 newr) (assoc 40 a) a))
[*]            (entmod ent)
[*]            (setq nn (1+ nn))
[*]            )
[*]          )
[*]          (setq n (1+ n))
[*]      )
[*]      )
[*]    )
[*])
[*](princ)
[*])

wyb36870 发表于 2016-4-26 00:55:57

(defun C:Z2(/ a en1 ent len n newr nn oldr s ss test)
(setvar "CMDECHO" 0)
(setq test T nn 0)
(while test
    (setq ss (ssadd))
    (setq ss (ssget))
    (if (= nil ss)
      (setq test nil)
      (progn
                                (setq len (sslength ss))
                                (setq n 1 s 1)
                                (while (<= n len)
                                        (setq en1 (ssname ss (1- n)))
                                        (setq a (entget en1))
                                        (if(= "TEXT" (cdr (assoc 0 a)))
                                                (progn
                                                        (if (= s 1)
                                                                (progn
                                                                        (setq oldr (cdr (assoc 40 a)))
                                                                        ;(setq newr (getreal (strcat "\nNew high <" (rtos oldr 2 1) ">:")))
                                                                        (setq newr(* 5 5 (getvar "celtscale")))
                                                                        (if (= newr nil) (setq newr oldr))
                                                                        (setq s nil)
                                                                )
                                                        )
                                                        (setq ent (subst (cons 40 newr) (assoc 40 a) a))
                                                        (entmod ent)
            (setq nn (1+ nn))
                                                )
                                        )
                                        (setq n (1+ n))
                                )
      )
    )
)
(princ)
)

1993063 发表于 2016-4-26 08:24:36

(defun C:Z2 (/ a en1 ent len n newr nn oldr s ss test)
(setvar "CMDECHO" 0)
(setq        test T
        nn 0
)
(while test
    (setq ss (ssadd))
    (setq ss (ssget))
    (if        (= nil ss)
      (setq test nil)
      (progn
        (setq len (sslength ss))
        (setq n        1
              s        1
        )
        (while (<= n len)
          (setq en1 (ssname ss (1- n)))
          (setq a (entget en1))
          (if (wcmatch (cdr (assoc 0 a)) "*TEXT")
          (progn
              (if (= s 1)
                (progn
                  (setq oldr (cdr (assoc 40 a)))
                                        ;(setq newr (getreal (strcat "\nNew high <" (rtos oldr 2 1) ">:")))
                  (setq newr (* 5 5 (getvar "celtscale")))
                  (if (= newr nil)
                  (setq newr oldr)
                  )
                  (setq s nil)
                )
              )
              (setq ent (subst (cons 40 newr) (assoc 40 a) a))
              (entmod ent)
              (setq nn (1+ nn))
          )
          )
          (setq n (1+ n))
        )
      )
    )
)
(princ)
)
页: [1]
查看完整版本: 求助：如何实现多选，且能同时修改单行文字和多行文字的字高