CAD根据图框更改图框内标注的全局比例

admin

(defun ax:getboundingbox (entname / entpl entpr ptlist)
  (vla-getboundingbox (vlax-ename->vla-object entname) 'entpl 'entpr)
  (setq ptlist (mapcar 'vlax-safearray->list (list entpl entpr)))
  (mapcar '(lambda (x) (trans x 0 1)) ptlist)
)
(defun getentdxf (ent dxf)
  (cond
    ((= (type ent) 'ename)
      (cdr (assoc dxf (entget ent '("*"))))
    )
    ((= (type ent) 'vla-object)
      (cdr (assoc dxf (entget (vlax-vla-object->ename ent) '("*"))))
    )
  )
)
(setq *en2obj* vlax-ename->vla-object)
(defun c:ds (/ entdata entgrp entname n ptlist scale)
  (prompt "根据图框比例自动改变图框内所有标注全局比例")
  (if (setq entname (entsel "\n请选择图框"))
    (if (= "INSERT" (getentdxf (car entname) 0))
      (progn
        (command "zoom" "o" (car entname) "")
        (setq ptlist (ax:getboundingbox (car entname)))
        (setq entgrp (ssget "W" (car ptlist) (cadr ptlist) '((0 . "DIMENSION,*TEXT,*LINE,HATCH"))))
        (setq scale (vla-get-XScaleFactor (*en2obj* (car entname))))
        (repeat (setq n (sslength entgrp))
          (setq entname (ssname entgrp (setq n (1- n))))
          (cond
            ((= "HATCH" (getentdxf entname 0))
              (vla-put-PatternScale (*en2obj* entname) scale)
            )
            ((= "DIMENSION" (getentdxf entname 0))
              (vla-put-ScaleFactor (*en2obj* entname) scale)
            )
            ((wcmatch (getentdxf entname 0) "*TEXT")
              (vla-put-Height (*en2obj* entname) (* (getvar "textsize") scale))
            )
            ((wcmatch (getentdxf entname 0) "*LINE")
              (vla-put-LinetypeScale (*en2obj* entname) scale)
            )
          )
        )
      )
    )
  )


  (princ)
)