所有建筑标注样式缩小1000倍
应朋友要求解决建筑图纸以毫米表示，但朋友在使用建筑图纸都需要缩小1000倍后来做图，一但炸开缩小1000的建筑块，就是满屏标注的问题。写得不好，效应能用。
(defun c:rDimMeter ( / dimstlst)
(setvar 'cmdecho 0)
(setq dimstlst (get-dimstyles)) ;标注样式名集
(while dimstlst
(rDimstl (car dimstlst))
(setq dimstlst (cdr dimstlst))
)
(princ "\n 已将所有文字高度大于100的标注样式缩小了1000倍")
(princ)
)
(defun get-dimstyles ( / dimsts dimst1 dimstname)
(if (null vlax-dump-object) (vl-load-com) )
(setq dimsts (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object))))
(setq dimst1 '())
(vlax-for dimstname dimsts
(setq dimst1 (cons (vla-get-name dimstname) dimst1))
)
(reverse dimst1)
)
(defun rDimstl (dimstyleName / )
(SetDimStyle dimstyleName)
(if (> (getvar 'dimtxt) 100)
(progn
(setvar 'dimasz (/ (getvar 'dimasz) 1000)) ;箭头大小=2.5
(setvar 'dimexe (/ (getvar 'dimexe) 1000)) ; 超出尺寸线=1.25
(setvar 'dimexo (/ (getvar 'dimexo) 1000)) ;起点偏移量
(setvar 'dimgap (/ (getvar 'dimgap) 1000)) ;从尺寸线偏移=0.625
(setvar 'dimtxt (/ (getvar 'dimtxt) 1000)) ;;;;文字高度
(if (> (getvar 'dimdl1) 1.0)
(setvar 'dimdl1 (/ (getvar 'dimdl1) 1000)) ;;基线间距
)
(if (> (getvar 'dimcen) 1.0)
(setvar 'dimcen (/ (getvar 'dimcen) 1000)) ;;圆心标记大小
)
(vl-cmdf "dimstyle" "S" dimstyleName "y")
))
)
(defun SetDimStyle (dimstlname / AcadObject AcadDocument mSpace dimStyleSel newDimStyle)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(setq dimStyleSel (vla-get-DimStyles AcadDocument))
(setq newDimStyle (vla-add dimStyleSel dimstlname))
(vla-put-ActiveDimStyle AcadDocument newDimStyle)
)
页:
[1]