CAD根据图框更改图框内标注的全局比例
(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)
)
页:
[1]