自动修改图框属性块中的比例

langjs

;;; 自动修改图框属性块中的比例  by:langjs
(defun c:qq (/ elist ename ent i loop scl scll ss)
  (setvar "DIMZIN" 8)
  (if (setq ss (ssget (list '(0 . "INSERT") (cons 2 "A3图框,a4,A4,a3,A3,a2,A2,a1,A1,a0,A0"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))  scl (cdr (assoc 41 (entget ent)))
            scll (cond ((>= scl 1.0)(strcat "1:" (rtos scl 2 2)))
                       ((< scl 1.0)(strcat (rtos (/ 1 scl) 2 2) ":1"))
                 )
            ename (entnext ent) loop t
      )
      (while (and ename loop )
        (setq elist (entget ename))
        (if (= (cdr (assoc 0 elist)) "ATTRIB")
          (if (= (cdr (assoc 2 elist)) "比例")
            (progn (entmod (subst(cons 1 scll)(assoc 1 elist) elist ))(entupd ename))
          )
          (setq loop nil)
        )
        (setq ename (entnext ename))
   )))
  (princ)
)

pzweng

(defun c:vvvv (/ ss sl i obj scl)
  (if (setq ss (ssget (list '(0 . "INSERT") (cons 2 "A3图框,A3竖框,A4竖框"))))
    (progn
      (setq sl (sslength ss)
            i  -1
      )
      (repeat sl
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i))))
              scl (vla-get-xscalefactor obj)
        )
        (foreach x (vlax-invoke obj 'getattributes)
          (if (wcmatch (vla-get-tagstring x) "比例")
            (cond
              ((= scl 1.0)
               (vla-put-textstring x "1:1")
              )
              ((> scl 1.0)
               (vla-put-textstring x (strcat "1:" (rtos scl)))
              )
              ((< scl 1.0)
               (vla-put-textstring x (strcat (rtos (/ 1 scl)) ":1"))
              )
            )
          )
        )
        (vla-update obj)
      )
    )
  )
  (princ)
)
李老师优化

zhangcan0515

看看大佬大作

429014673

                        学习

xiaoquansb

                       学习了

lrd1861

路过支持一下

jxjaxa

                      学习了

zyhandw

来看看高手大作！

fdb2007

回复学习，看看

chpmould

支持一下......

樊影

看看，来学习学习

namezg

支持一下，呵呵