像这样改变当前标注文字高度

lucas3

Free-Lancer 发表于 2014-11-20 16:46
(mapcar    '(lambda (x)
       (xd::doc:createSubDimstyle
         "GB孔"

感谢大师的耐心解答！此样例是需要将“GB孔” 换成  (strcat "FY-" str) 的吧？ 我将上面那个完整的程序改成如下运行，怎么没有建立子样式？

2.    (mapcar    '(lambda (x)
   
3.        (xd::doc:createSubDimstyle
   
4.          (strcat "FY-" str)
   
5.          (car x)
   
6.          (cadr x)
   
7.        )
   
8.        '(("$2" nil)
   
9.          ("$3" nil)
   
10.          ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))
    
11.          ("$6" nil)
    
12.         )
    
13.       )
    
14.     )
    
15.       (_changescale (* height (car scl)) (strcat "FY-" str))
    
16.     )
    
17.   )
    
18.   (fy:end)
    
19.   (princ)
    
20. )

   (mapcar    '(lambda (x)<br />        (xd::doc:createSubDimstyle<br />          (strcat "FY-" str)<br />          (car x)<br />          (cadr x)<br />        )<br />        '(("$2" nil)<br />          ("$3" nil)<br />          ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))<br />          ("$6" nil)<br />         )<br />       )<br />     )<br />       (_changescale (* height (car scl)) (strcat "FY-" str))<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

显示参数太少！


令: TT
第一点:
对角点:
打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: 4
Plot Scale = 1.41414
是否接受[是(Y)/否(N)]<Y>: Y
文字高度: 3
Error: 参数太少

lucas3

Free-Lancer 发表于 2014-11-20 16:46
(mapcar    '(lambda (x)
       (xd::doc:createSubDimstyle
         "GB孔"

大师，刚刚新建文档重新测试，连标注样式都不创建了， 原始就一个ISO-25 ，运行完还是一样，也没报错

Free-Lancer

lucas3 发表于 2014-11-20 17:01
感谢大师的耐心解答！此样例是需要将“GB孔” 换成  (strcat "FY-" str) 的吧？ 我将上面那个完整的程序 ...

mapcar 中括号不对，完整代码

1. (defun c:tt (/                  _string:decimal            _changescale
   
2.              _rectang:scale               scl            height
   
3.              str          ds               nscl            kw
   
4.             )
   
5.   (defun _string:decimal (val / str)
   
6.     (setvar "dimzin" 0)
   
7.     (setq str (rtos val 2 2)
   
8.           str (vl-string-right-trim "0" str)
   
9.           str (vl-string-right-trim "." str)
   
10.     )
    
11.   )
    
12.   (defun _changescale (h str)
    
13.     (vlax-for obj (fy:cset)
    
14.       (if (wcmatch (vla-get-objectname obj) "*Text")
    
15.         (vlax-put obj 'height h)
    
16.         (vlax-put obj 'stylename str)
    
17.       )
    
18.     )
    
19.   )
    
20.   (defun _rectang:scale        (/ p1 p2 str lst v scl kw)
    
21.     (if
    
22.       (and
    
23.         (setq p1 (getpoint "\n第一点: "))
    
24.         (setq p2 (getcorner p1 "\n对角点: "))
    
25.         (progn (initget "0 1 2 3 4")
    
26.                (setq kw        (getkword
    
27.                           "\n打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: "
    
28.                         )
    
29.                )
    
30.         )
    
31.         (setq lst (assoc kw
    
32.                          '(("0" 1089 841)
    
33.                            ("1" 841 594)
    
34.                            ("2" 594 420)
    
35.                            ("3" 420 297)
    
36.                            ("4" 297 210)
    
37.                           )
    
38.                   )
    
39.         )
    
40.       )
    
41.        (progn (setq v        (apply 'max (mapcar 'abs (mapcar '- p2 p1)))
    
42.                     scl        (/ v (apply 'max (cdr lst)))
    
43.               )
    
44.               (list scl p1 p2)
    
45.        )
    
46.     )
    
47.   )
    
48.   (fy:begin)
    
49.   (if (and (setq scl (_rectang:scale))
    
50.            (progn (princ "\nPlot Scale = ")
    
51.                   (princ (car scl))
    
52.                   (initget 128 "Y N")
    
53.                   (setq kw (getkword "\n是否接受[是(Y)/否(N)]<Y>: "))
    
54.                   (if (or (= kw "Y") (= kw ""))
    
55.                     t
    
56.                     (if        (setq nscl (getreal "\n输入新比例: "))
    
57.                       (setq scl (cons nscl (cdr scl)))
    
58.                     )
    
59.                   )
    
60.            )
    
61.            (setq height (getdist "\n文字高度: "))
    
62.            (ssget "_C"
    
63.                   (cadr scl)
    
64.                   (caddr scl)
    
65.                   '((0 . "dimension,text"))
    
66.            )
    
67.       )
    
68.     (progn
    
69.       (setq
    
70.         str (vl-string-translate "." "-" (_string:decimal (car scl)))
    
71.       )
    
72.       (xd::doc:createDimstyleFrom
    
73.         nil
    
74.         (strcat "FY-" str)
    
75.         (cons (list "dimtxt" height)
    
76.               (cons (list "dimscale" (car scl))
    
77.                     '(("dimdli" 1.0)
    
78.                       ("dimexe" 1.5)
    
79.                       ("dimexo" 1.0)
    
80.                       ("dimasz" 1.5)
    
81.                       ("dimtad" 1)
    
82.                       ("dimtix" 1)
    
83.                       ("dimtofl" 1)
    
84.                       ("dimgap" 1.0)
    
85.                       ("dimtih" 0)
    
86.                       ("dimdsep" ".")
    
87.                       ("dimlunit" 2) ;_单位
    
88.                       ("dimdec" 2) ;_精度
    
89.                      )
    
90.               )
    
91.         )
    
92.       )
    
93.       (mapcar '(lambda (x)
    
94.                  (xd::doc:createSubDimstyle
    
95.                    (strcat "FY-" str)
    
96.                    (car x)
    
97.                    (cadr x)
    
98.                  )
    
99.                )
    
100.               '(("$2" nil)
     
101.                 ("$3" nil)
     
102.                 ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))
     
103.                 ("$6" nil)
     
104.                )
     
105.       )
     
106.       (_changescale (* height (car scl)) (strcat "FY-" str))
     
107.     )
     
108.   )
     
109.   (fy:end)
     
110.   (princ)
     
111. )
     
112. 
     
113. ;;功能: 由已有标注样式建立新标注样式并设为当前
     
114. ;;参数: OldName --- 源标注样式名，nil 为当前样式
     
115. ;;         NewName --- 新标注样式名
     
116. ;;         lst     --- 新标注样式中需要修改的变量表
     
117. ;;返回值: 新样式名
     
118. (defun XD::Doc:createDimStyleFrom (oldName newName lst / dims ndim)
     
119.   (setq dims (vla-get-dimstyles **XD::Doc**))
     
120.   (if (null oldName)
     
121.     (setq oldName (getvar "dimstyle"))
     
122.   )
     
123.   (if (tblsearch "dimstyle" Newname)
     
124.     (if        lst
     
125.       (progn (setq ndim (vla-item dims newName))
     
126.              (mapcar '(lambda (x) (apply 'setvar x)) lst)
     
127.              (vla-copyfrom ndim **XD::Doc**)
     
128.              (vla-put-activedimstyle **XD::Doc** ndim)
     
129.              newName
     
130.       )
     
131.       (if (/= (strcase (getvar "dimstyle") (strcase newName)))
     
132.         (vla-put-activedimstyle **XD::DOC** (vla-item dims newName))
     
133.       )
     
134.     )
     
135.     (progn (setq ndim (vla-add dims newName))
     
136.            (vla-copyfrom (vla-item dims oldname) ndim)
     
137.            (if lst
     
138.              (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)
     
139.                     (vla-copyfrom ndim **XD::Doc**)
     
140.              )
     
141.            )
     
142.            (vla-put-activedimstyle **XD::Doc** ndim)
     
143.            newName
     
144.     )
     
145.   )
     
146. )
     
147. ;;功能: 由已有标注样式建立新子标注样式
     
148. ;;参数: name ---- 父标注样式名称，nil 为当前样式
     
149. ;;      mod  ---- 子标注类型, string
     
150. ;;                $2 角度标注，$3 直径标注，
     
151. ;;                $4 半径标注，$6 坐标标注
     
152. ;;                $0 线性标注, $7 引线和公差
     
153. ;;      lst  ---  子标注样式需要修改的系统变量表，或nil
     
154. (defun XD::Doc:createSubDimstyle (name mod lst / dims sname)
     
155.   (if (null name)
     
156.     (setq name (getvar "dimstyle"))
     
157.   )
     
158.   (setq        dims  (vla-get-dimstyles **XD::DOC**)
     
159.         sname (strcat name mod)
     
160.   )
     
161.   (if (not (tblsearch "dimstyle" sname))
     
162.     (vla-add dims sname)
     
163.   )
     
164.   (if lst
     
165.     (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)
     
166.            (vla-copyfrom (vla-item dims sname) **XD::DOC**)
     
167.     )
     
168.   )
     
169.   (vla-put-activedimstyle **XD::DOC** (vla-item dims name))
     
170.   t
     
171. )
     

(defun c:tt (/                  _string:decimal            _changescale<br />              _rectang:scale               scl            height<br />              str          ds               nscl            kw<br />             )<br />   (defun _string:decimal (val / str)<br />     (setvar "dimzin" 0)<br />     (setq str (rtos val 2 2)<br />           str (vl-string-right-trim "0" str)<br />           str (vl-string-right-trim "." str)<br />     )<br />   )<br />   (defun _changescale (h str)<br />     (vlax-for obj (fy:cset)<br />       (if (wcmatch (vla-get-objectname obj) "*Text")<br />         (vlax-put obj 'height h)<br />         (vlax-put obj 'stylename str)<br />       )<br />     )<br />   )<br />   (defun _rectang:scale        (/ p1 p2 str lst v scl kw)<br />     (if<br />       (and<br />         (setq p1 (getpoint "\n第一点: "))<br />         (setq p2 (getcorner p1 "\n对角点: "))<br />         (progn (initget "0 1 2 3 4")<br />                (setq kw        (getkword<br />                           "\n打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: "<br />                         )<br />                )<br />         )<br />         (setq lst (assoc kw<br />                          '(("0" 1089 841)<br />                            ("1" 841 594)<br />                            ("2" 594 420)<br />                            ("3" 420 297)<br />                            ("4" 297 210)<br />                           )<br />                   )<br />         )<br />       )<br />        (progn (setq v        (apply 'max (mapcar 'abs (mapcar '- p2 p1)))<br />                     scl        (/ v (apply 'max (cdr lst)))<br />               )<br />               (list scl p1 p2)<br />        )<br />     )<br />   )<br />   (fy:begin)<br />   (if (and (setq scl (_rectang:scale))<br />            (progn (princ "\nPlot Scale = ")<br />                   (princ (car scl))<br />                   (initget 128 "Y N")<br />                   (setq kw (getkword "\n是否接受[是(Y)/否(N)]<Y>: "))<br />                   (if (or (= kw "Y") (= kw ""))<br />                     t<br />                     (if        (setq nscl (getreal "\n输入新比例: "))<br />                       (setq scl (cons nscl (cdr scl)))<br />                     )<br />                   )<br />            )<br />            (setq height (getdist "\n文字高度: "))<br />            (ssget "_C"<br />                   (cadr scl)<br />                   (caddr scl)<br />                   '((0 . "dimension,text"))<br />            )<br />       )<br />     (progn<br />       (setq<br />         str (vl-string-translate "." "-" (_string:decimal (car scl)))<br />       )<br />       (xd::doc:createDimstyleFrom<br />         nil<br />         (strcat "FY-" str)<br />         (cons (list "dimtxt" height)<br />               (cons (list "dimscale" (car scl))<br />                     '(("dimdli" 1.0)<br />                       ("dimexe" 1.5)<br />                       ("dimexo" 1.0)<br />                       ("dimasz" 1.5)<br />                       ("dimtad" 1)<br />                       ("dimtix" 1)<br />                       ("dimtofl" 1)<br />                       ("dimgap" 1.0)<br />                       ("dimtih" 0)<br />                       ("dimdsep" ".")<br />                       ("dimlunit" 2) ;_单位<br />                       ("dimdec" 2) ;_精度<br />                      )<br />               )<br />         )<br />       )<br />       (mapcar '(lambda (x)<br />                  (xd::doc:createSubDimstyle<br />                    (strcat "FY-" str)<br />                    (car x)<br />                    (cadr x)<br />                  )<br />                )<br />               '(("$2" nil)<br />                 ("$3" nil)<br />                 ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))<br />                 ("$6" nil)<br />                )<br />       )<br />       (_changescale (* height (car scl)) (strcat "FY-" str))<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )<br /> <br /> ;;功能: 由已有标注样式建立新标注样式并设为当前<br /> ;;参数: OldName --- 源标注样式名，nil 为当前样式<br /> ;;         NewName --- 新标注样式名<br /> ;;         lst     --- 新标注样式中需要修改的变量表<br /> ;;返回值: 新样式名<br /> (defun XD::Doc:createDimStyleFrom (oldName newName lst / dims ndim)<br />   (setq dims (vla-get-dimstyles **XD::Doc**))<br />   (if (null oldName)<br />     (setq oldName (getvar "dimstyle"))<br />   )<br />   (if (tblsearch "dimstyle" Newname)<br />     (if        lst<br />       (progn (setq ndim (vla-item dims newName))<br />              (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />              (vla-copyfrom ndim **XD::Doc**)<br />              (vla-put-activedimstyle **XD::Doc** ndim)<br />              newName<br />       )<br />       (if (/= (strcase (getvar "dimstyle") (strcase newName)))<br />         (vla-put-activedimstyle **XD::DOC** (vla-item dims newName))<br />       )<br />     )<br />     (progn (setq ndim (vla-add dims newName))<br />            (vla-copyfrom (vla-item dims oldname) ndim)<br />            (if lst<br />              (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />                     (vla-copyfrom ndim **XD::Doc**)<br />              )<br />            )<br />            (vla-put-activedimstyle **XD::Doc** ndim)<br />            newName<br />     )<br />   )<br /> )<br /> ;;功能: 由已有标注样式建立新子标注样式<br /> ;;参数: name ---- 父标注样式名称，nil 为当前样式<br /> ;;      mod  ---- 子标注类型, string<br /> ;;                $2 角度标注，$3 直径标注，<br /> ;;                $4 半径标注，$6 坐标标注<br /> ;;                $0 线性标注, $7 引线和公差<br /> ;;      lst  ---  子标注样式需要修改的系统变量表，或nil<br /> (defun XD::Doc:createSubDimstyle (name mod lst / dims sname)<br />   (if (null name)<br />     (setq name (getvar "dimstyle"))<br />   )<br />   (setq        dims  (vla-get-dimstyles **XD::DOC**)<br />         sname (strcat name mod)<br />   )<br />   (if (not (tblsearch "dimstyle" sname))<br />     (vla-add dims sname)<br />   )<br />   (if lst<br />     (progn (mapcar '(lambda (x) (apply 'setvar x)) lst)<br />            (vla-copyfrom (vla-item dims sname) **XD::DOC**)<br />     )<br />   )<br />   (vla-put-activedimstyle **XD::DOC** (vla-item dims name))<br />   t<br /> )<br />

石榴裙下拜倒

完全不懂     outcad mechanical  不都全自动的么。。。 绘图比例1:1 缩放图框  字高不都一样了么   就是打印时麻烦0.0    想懂  两位大侠稍微指点下吧:loveliness:

lucas3

大师，对比了下，也就一个括号的差别，可以运行，还有一些问题。－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
1. 多行文字字高还是无法改变的，单行文本可以。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
2. 框选的范围内没有文字和标注的话，是不生成标注样式的，这样是不是有点遗憾，因为 我想画好图后，先确定标注样式，再进行标注。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
3. 全局比例的小数位只保留一位能行么？
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
4. 文字高度不要小数位能行么？只要整数。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
5. 选择区域时（两个角点），看看这样这是可行：运行命令后，提示选择图框（属性块），如果按下空格就切换到选择角点，我的图框一般都是属性块（选择块是否可以确定这个尺寸呢？），而有些同事是用的线条直接绘的图框，那么就必须要选择角点了。
如果选择块，这样就会快捷好多！

石榴裙下拜倒

模型空间  一个图里好多图纸   绘图比例1:1   打图比例不一样   能实现批量打印么？

iLisp

lucas3 发表于 2014-11-20 18:18
大师，对比了下，也就一个括号的差别，还有一些问题
1. 多行文字字高还是无法改变的，单行可以
2. 框选的 ...

mtext有格式符，不一定是统一高度

Lisphk

石榴裙下拜倒 发表于 2014-11-20 18:22
模型空间  一个图里好多图纸   绘图比例1:1   打图比例不一样   能实现批量打印么？

1:1画图，打印比例不一样，那么打出来文字，标注什么的不就变大或变小了吗？

石榴裙下拜倒

Lisphk 发表于 2014-11-20 18:35
1:1画图，打印比例不一样，那么打出来文字，标注什么的不就变大或变小了吗？

也对   说法有误    绘图1:1指视图上的线1:1   像文字啊图框标注等剖面线间距等都对应缩放    然后打印时选择打印比例    图纸上就又缩放回来了

石榴裙下拜倒

Lisphk 发表于 2014-11-20 18:35
1:1画图，打印比例不一样，那么打出来文字，标注什么的不就变大或变小了吗？

就是正好相反    一般是图框字高不变   图形缩放    我们是图形不变    其余的都缩放     别问我麻烦不....全自动的   只是打图时不方便   机械版不都是这样用的么？？？？？？？？

st788796

Free-Lancer 的程序就是改字高和 DIM  标注的吧

Free-Lancer

lucas3 发表于 2014-11-20 18:18
大师，对比了下，也就一个括号的差别，可以运行，还有一些问题。－－－－－－－－－－－－－－－－－－－－ ...

1. (defun c:tt (/                _string:decimal              _changescale
   
2.              _rectang:scale           scl              height         str
   
3.              ds                nscl           kw              bp         up
   
4.              blk
   
5.             )
   
6.   (defun _string:decimal (val / str)
   
7.     (setvar "dimzin" 0)
   
8.     (setq str (rtos val 2 2)
   
9.           str (vl-string-right-trim "0" str)
   
10.           str (vl-string-right-trim "." str)
    
11.     )
    
12.   )
    
13.   (defun _changescale (h str)
    
14.     (vlax-for obj (fy:cset)
    
15.       (if (wcmatch (vla-get-objectname obj) "*Text")
    
16.         (vlax-put obj 'height h)
    
17.         (vlax-put obj 'stylename str)
    
18.       )
    
19.     )
    
20.   )
    
21.   (defun _rectang:scale        (/ p1 p2 str lst v scl kw)
    
22.     (if
    
23.       (and
    
24.         (setq p1 (getpoint "\n第一点: "))
    
25.         (setq p2 (getcorner p1 "\n对角点: "))
    
26.         (progn (initget "0 1 2 3 4")
    
27.                (setq kw        (getkword
    
28.                           "\n打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: "
    
29.                         )
    
30.                )
    
31.         )
    
32.         (setq lst (assoc kw
    
33.                          '(("0" 1089 841)
    
34.                            ("1" 841 594)
    
35.                            ("2" 594 420)
    
36.                            ("3" 420 297)
    
37.                            ("4" 297 210)
    
38.                           )
    
39.                   )
    
40.         )
    
41.       )
    
42.        (progn (setq v        (apply 'max (mapcar 'abs (mapcar '- p2 p1)))
    
43.                     scl        (/ v (apply 'max (cdr lst)))
    
44.               )
    
45.               (list scl p1 p2)
    
46.        )
    
47.     )
    
48.   )
    
49.   (fy:begin)
    
50.   (if (and (if (progn
    
51.                  (princ "\n选择图框<回车选取范围>...")
    
52.                  (setq blk (car (ssget ":S" '((0 . "insert")))))
    
53.                )
    
54.              (progn
    
55.                (vla-getboundingbox
    
56.                  (vlax-ename->vla-object (ssname blk 0))
    
57.                  'bp
    
58.                  'up
    
59.                )
    
60.                (setq
    
61.                  scl (list (safearray-value bp) (safearray-value up))
    
62.                )
    
63.              )
    
64.              (setq scl (_rectang:scale))
    
65.            )
    
66.            (progn (princ "\n打印比例 = ")
    
67.                   (if (car scl)
    
68.                     (progn
    
69.                       (princ (car scl))
    
70.                       (initget 128 "Y N")
    
71.                       (setq
    
72.                         kw (getkword "\n是否接受[是(Y)/否(N)]<Y>: ")
    
73.                       )
    
74.                     )
    
75.                     (setq kw "N")
    
76.                   )
    
77.                   (if (or (= kw "Y") (= kw ""))
    
78.                     t
    
79.                     (if        (setq nscl (getreal "\n输入新比例: "))
    
80.                       (setq scl (cons nscl (cdr scl)))
    
81.                     )
    
82.                   )
    
83.            )
    
84.            (setq height (getdist "\n文字高度: "))
    
85.       )
    
86.     (progn
    
87.       (setq
    
88.         str (vl-string-translate "." "-" (_string:decimal (car scl)))
    
89.       )
    
90.       (xd::doc:createDimstyleFrom
    
91.         nil
    
92.         (strcat "FY-" str)
    
93.         (cons (list "dimtxt" height)
    
94.               (cons (list "dimscale" (car scl))
    
95.                     '(("dimdli" 1.0)
    
96.                       ("dimexe" 1.5)
    
97.                       ("dimexo" 1.0)
    
98.                       ("dimasz" 1.5)
    
99.                       ("dimtad" 1)
    
100.                       ("dimtix" 1)
     
101.                       ("dimtofl" 1)
     
102.                       ("dimgap" 1.0)
     
103.                       ("dimtih" 0)
     
104.                       ("dimdsep" ".")
     
105.                       ("dimlunit" 2) ;_单位
     
106.                       ("dimdec" 2) ;_精度
     
107.                      )
     
108.               )
     
109.         )
     
110.       )
     
111.       (mapcar '(lambda (x)
     
112.                  (xd::doc:createSubDimstyle
     
113.                    (strcat "FY-" str)
     
114.                    (car x)
     
115.                    (cadr x)
     
116.                  )
     
117.                )
     
118.               '(("$2" nil)
     
119.                 ("$3" nil)
     
120.                 ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))
     
121.                 ("$6" nil)
     
122.                )
     
123.       )
     
124.       (if (ssget "_C"
     
125.                  (cadr scl)
     
126.                  (caddr scl)
     
127.                  '((0 . "dimension,*text"))
     
128.           )
     
129.         (_changescale (* height (car scl)) (strcat "FY-" str))
     
130.       )
     
131.     )
     
132.   )
     
133.   (fy:end)
     
134.   (princ)
     
135. )
     

(defun c:tt (/                _string:decimal              _changescale<br />              _rectang:scale           scl              height         str<br />              ds                nscl           kw              bp         up<br />              blk<br />             )<br />   (defun _string:decimal (val / str)<br />     (setvar "dimzin" 0)<br />     (setq str (rtos val 2 2)<br />           str (vl-string-right-trim "0" str)<br />           str (vl-string-right-trim "." str)<br />     )<br />   )<br />   (defun _changescale (h str)<br />     (vlax-for obj (fy:cset)<br />       (if (wcmatch (vla-get-objectname obj) "*Text")<br />         (vlax-put obj 'height h)<br />         (vlax-put obj 'stylename str)<br />       )<br />     )<br />   )<br />   (defun _rectang:scale        (/ p1 p2 str lst v scl kw)<br />     (if<br />       (and<br />         (setq p1 (getpoint "\n第一点: "))<br />         (setq p2 (getcorner p1 "\n对角点: "))<br />         (progn (initget "0 1 2 3 4")<br />                (setq kw        (getkword<br />                           "\n打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: "<br />                         )<br />                )<br />         )<br />         (setq lst (assoc kw<br />                          '(("0" 1089 841)<br />                            ("1" 841 594)<br />                            ("2" 594 420)<br />                            ("3" 420 297)<br />                            ("4" 297 210)<br />                           )<br />                   )<br />         )<br />       )<br />        (progn (setq v        (apply 'max (mapcar 'abs (mapcar '- p2 p1)))<br />                     scl        (/ v (apply 'max (cdr lst)))<br />               )<br />               (list scl p1 p2)<br />        )<br />     )<br />   )<br />   (fy:begin)<br />   (if (and (if (progn<br />                  (princ "\n选择图框<回车选取范围>...")<br />                  (setq blk (car (ssget ":S" '((0 . "insert")))))<br />                )<br />              (progn<br />                (vla-getboundingbox<br />                  (vlax-ename->vla-object (ssname blk 0))<br />                  'bp<br />                  'up<br />                )<br />                (setq<br />                  scl (list (safearray-value bp) (safearray-value up))<br />                )<br />              )<br />              (setq scl (_rectang:scale))<br />            )<br />            (progn (princ "\n打印比例 = ")<br />                   (if (car scl)<br />                     (progn<br />                       (princ (car scl))<br />                       (initget 128 "Y N")<br />                       (setq<br />                         kw (getkword "\n是否接受[是(Y)/否(N)]<Y>: ")<br />                       )<br />                     )<br />                     (setq kw "N")<br />                   )<br />                   (if (or (= kw "Y") (= kw ""))<br />                     t<br />                     (if        (setq nscl (getreal "\n输入新比例: "))<br />                       (setq scl (cons nscl (cdr scl)))<br />                     )<br />                   )<br />            )<br />            (setq height (getdist "\n文字高度: "))<br />       )<br />     (progn<br />       (setq<br />         str (vl-string-translate "." "-" (_string:decimal (car scl)))<br />       )<br />       (xd::doc:createDimstyleFrom<br />         nil<br />         (strcat "FY-" str)<br />         (cons (list "dimtxt" height)<br />               (cons (list "dimscale" (car scl))<br />                     '(("dimdli" 1.0)<br />                       ("dimexe" 1.5)<br />                       ("dimexo" 1.0)<br />                       ("dimasz" 1.5)<br />                       ("dimtad" 1)<br />                       ("dimtix" 1)<br />                       ("dimtofl" 1)<br />                       ("dimgap" 1.0)<br />                       ("dimtih" 0)<br />                       ("dimdsep" ".")<br />                       ("dimlunit" 2) ;_单位<br />                       ("dimdec" 2) ;_精度<br />                      )<br />               )<br />         )<br />       )<br />       (mapcar '(lambda (x)<br />                  (xd::doc:createSubDimstyle<br />                    (strcat "FY-" str)<br />                    (car x)<br />                    (cadr x)<br />                  )<br />                )<br />               '(("$2" nil)<br />                 ("$3" nil)<br />                 ("$4" (("DIMTOH" 1) ("DIMTIH" 0)))<br />                 ("$6" nil)<br />                )<br />       )<br />       (if (ssget "_C"<br />                  (cadr scl)<br />                  (caddr scl)<br />                  '((0 . "dimension,*text"))<br />           )<br />         (_changescale (* height (car scl)) (strcat "FY-" str))<br />       )<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )<br />

lucas3

Free-Lancer 发表于 2014-11-24 07:48

谢谢大师的耐心帮助！{:soso_e179:} 大师的人品更是让我等佩服 ！{:soso_e100:}

大师，测试了，无论坛是选择块，还是属性块都不行了 报错：Error: 参数类型错误: consp <Selection set: 6a>

另外这两点可以改改吗？
3. 全局比例的小数位只保留一位能行么？

                               
登录/注册后可看大图

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
4. 文字高度不要小数位能行么？只要整数。

                               
登录/注册后可看大图

－－－－

st788796

ssget 怎么能用car！
大师也犯低级错误:)
可能想用entsel又不能过滤，后面换了前面没删

lucas3

st788796 发表于 2014-11-24 10:15
ssget 怎么能用car！
大师也犯低级错误
可能想用entsel又不能过滤，后面换了前面没删

ST大师既然发现了就帮忙改改吧，另外提到的这两点
3. 全局比例的小数位只保留一位能行么？

4. 文字高度不要小数位能行么？只要整数。

也帮忙处理一下吧，Free-Lancer大师可能比较忙，

感谢！