所有建筑标注样式缩小1000倍

stoyer

应朋友要求解决建筑图纸以毫米表示，但朋友在使用建筑图纸都需要缩小1000倍后来做图，一但炸开缩小1000的建筑块，就是满屏标注的问题。

写得不好，效应能用。

2. (defun c:rDimMeter ( / dimstlst)
   
3.   (setvar 'cmdecho 0)
   
4.   (setq dimstlst (get-dimstyles)) ;标注样式名集
   
5.   (while dimstlst
   
6.     (rDimstl (car dimstlst))
   
7.     (setq dimstlst (cdr dimstlst))
   
8.   )
   
9.   (princ "\n 已将所有文字高度大于100的标注样式缩小了1000倍")
   
10.   (princ)
    
11. )
    
12. (defun get-dimstyles ( / dimsts dimst1 dimstname)
    
13.   (if (null vlax-dump-object) (vl-load-com) )
    
14.   (setq dimsts (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object))))
    
15.   (setq dimst1 '())
    
16.   (vlax-for dimstname dimsts
    
17.     (setq dimst1 (cons (vla-get-name dimstname) dimst1))
    
18.   )
    
19.   (reverse dimst1)
    
20. )
    
21. (defun rDimstl (dimstyleName / )
    
22.   (SetDimStyle dimstyleName)
    
23.   (if (> (getvar 'dimtxt) 100)
    
24.     (progn
    
25.       (setvar 'dimasz (/ (getvar 'dimasz) 1000)) ;箭头大小=2.5
    
26.       (setvar 'dimexe (/ (getvar 'dimexe) 1000)) ; 超出尺寸线=1.25
    
27.       (setvar 'dimexo (/ (getvar 'dimexo) 1000)) ;起点偏移量
    
28.       (setvar 'dimgap (/ (getvar 'dimgap) 1000)) ;从尺寸线偏移=0.625
    
29.       (setvar 'dimtxt (/ (getvar 'dimtxt) 1000)) ;;;;文字高度
    
30.       (if (> (getvar 'dimdl1) 1.0)
    
31.         (setvar 'dimdl1 (/ (getvar 'dimdl1) 1000)) ;;基线间距
    
32.       )
    
33.       (if (> (getvar 'dimcen) 1.0)
    
34.         (setvar 'dimcen (/ (getvar 'dimcen) 1000)) ;;圆心标记大小
    
35.       )
    
36.       (vl-cmdf "dimstyle" "S" dimstyleName "y")
    
37.   ))
    
38. )
    
39. (defun SetDimStyle (dimstlname / AcadObject AcadDocument mSpace dimStyleSel newDimStyle)
    
40.   (setq AcadObject (vlax-get-acad-object)  
    
41.       AcadDocument (vla-get-ActiveDocument AcadObject)  
    
42.       mSpace (vla-get-ModelSpace AcadDocument)  
    
43.   )
    
44.   (setq dimStyleSel (vla-get-DimStyles AcadDocument))
    
45.   (setq newDimStyle (vla-add dimStyleSel dimstlname))
    
46.   (vla-put-ActiveDimStyle AcadDocument newDimStyle)
    
47. )

(defun c:rDimMeter ( / dimstlst)<br />   (setvar 'cmdecho 0)<br />   (setq dimstlst (get-dimstyles)) ;标注样式名集<br />   (while dimstlst <br />     (rDimstl (car dimstlst))<br />     (setq dimstlst (cdr dimstlst))<br />   )<br />   (princ "\n 已将所有文字高度大于100的标注样式缩小了1000倍")<br />   (princ)<br /> )<br /> (defun get-dimstyles ( / dimsts dimst1 dimstname)<br />   (if (null vlax-dump-object) (vl-load-com) )<br />   (setq dimsts (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object))))<br />   (setq dimst1 '())<br />   (vlax-for dimstname dimsts<br />     (setq dimst1 (cons (vla-get-name dimstname) dimst1))<br />   )<br />   (reverse dimst1)<br /> )<br /> (defun rDimstl (dimstyleName / )<br />   (SetDimStyle dimstyleName)<br />   (if (> (getvar 'dimtxt) 100)<br />     (progn<br />       (setvar 'dimasz (/ (getvar 'dimasz) 1000)) ;箭头大小=2.5<br />       (setvar 'dimexe (/ (getvar 'dimexe) 1000)) ; 超出尺寸线=1.25<br />       (setvar 'dimexo (/ (getvar 'dimexo) 1000)) ;起点偏移量<br />       (setvar 'dimgap (/ (getvar 'dimgap) 1000)) ;从尺寸线偏移=0.625<br />       (setvar 'dimtxt (/ (getvar 'dimtxt) 1000)) ;;;;文字高度<br />       (if (> (getvar 'dimdl1) 1.0)<br />         (setvar 'dimdl1 (/ (getvar 'dimdl1) 1000)) ;;基线间距<br />       )<br />       (if (> (getvar 'dimcen) 1.0)<br />         (setvar 'dimcen (/ (getvar 'dimcen) 1000)) ;;圆心标记大小<br />       )<br />       (vl-cmdf "dimstyle" "S" dimstyleName "y") <br />   ))<br /> )<br /> (defun SetDimStyle (dimstlname / AcadObject AcadDocument mSpace dimStyleSel newDimStyle)<br />   (setq AcadObject (vlax-get-acad-object)  <br />       AcadDocument (vla-get-ActiveDocument AcadObject)  <br />       mSpace (vla-get-ModelSpace AcadDocument)  <br />   )<br />   (setq dimStyleSel (vla-get-DimStyles AcadDocument))<br />   (setq newDimStyle (vla-add dimStyleSel dimstlname))<br />   (vla-put-ActiveDimStyle AcadDocument newDimStyle)<br /> )