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

st788796 · 发表于 2014-11-24 10:56:39

lucas3 发表于 2014-11-24 10:26
ST大师既然发现了就帮忙改改吧，另外提到的这两点
3. 全局比例的小数位只保留一位能行么？

1 (distof (rtos scl 2 1))
2 (fix (+ height 0.5))不要小于0.5的高度

lucas3 · 发表于 2014-11-24 11:27:56

st788796 发表于 2014-11-24 10:56
1 (distof (rtos scl 2 1))
2 (fix (+ height 0.5))不要小于0.5的高度

ST大师，这两句分别放入到哪儿呢？

lucas3 · 发表于 2014-11-24 14:00:13

Free-Lancer 发表于 2014-11-24 11:46

大师，谢谢！
选择图框报错的问题还没有解决吧
别外加载此代码就报错：命令: ; 错误: 语法错误
错误: SETQ 中变量名称错误: (DISTOF (RTOS SCL 2 1))

st788796 · 发表于 2014-11-24 14:53:50

lucas3 发表于 2014-11-24 14:00
大师，谢谢！
选择图框报错的问题还没有解决吧
别外加载此代码就报错：命令: ; 错误: 语法错误

那就用 (setq scl (cons …

st788796 · 发表于 2014-11-27 10:46:44

lucas3 发表于 2014-11-24 10:26
ST大师既然发现了就帮忙改改吧，另外提到的这两点
3. 全局比例的小数位只保留一位能行么？

这样试试

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

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

lucas3 · 发表于 2014-11-27 14:11:06

st788796 发表于 2014-11-27 10:46
这样试试

不是这样哟，大师，您这个选择图框后为什么还要输入比例？而且还报错：

选择对象:
比例: 1.4
请输入1:1的标注文字高度: 3
Error: 错误的点参数

首先选择打印范围，之前只有一种方法，就是两个角点确定了范围，然后选择图框大小，就确定了比例：

选择图框一个角点:
选择对角点:
打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]: 4
打印比例 = 1.41414

我的意思是将多了一种选择，不仅仅靠两个角点确定范围，还可以直接通过选择块来确定范围
选择块了之后，还要选择打印图框大小[A0(0)/A1(1)/A2(2)/A3(3)/A4(4)]:
跟选择两角点一样，自动算出打印比例

st788796 · 发表于 2014-11-27 16:03:46

lucas3 发表于 2014-11-27 14:11
不是这样哟，大师，您这个选择图框后为什么还要输入比例？而且还报错：

如果是标准图框，选择后应该可以计算出是A几及比例的

lucas3 · 发表于 2014-11-27 16:18:23

st788796 发表于 2014-11-27 16:03
如果是标准图框，选择后应该可以计算出是A几及比例的

图框不一定是标准的，有可能缩放过的，我的意思是，选择两角点确定与选择块确定的一个尺寸，

选择两角点操作较麻烦，只针对图框非块的情况，如果图框是块，那就直接选择块，仅此而已

st788796 · 发表于 2014-11-28 08:36:01

lucas3 发表于 2014-11-27 16:18
图框不一定是标准的，有可能缩放过的，我的意思是，选择两角点确定与选择块确定的一个尺寸，

再试试

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

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

lucas3 · 发表于 2014-11-28 09:21:26

st788796 发表于 2014-11-28 08:36
再试试

ST大师，还是不行了
选择图框显示：Error: 参数太少，另外选择角点也用不成了。

st788796 · 发表于 2014-11-28 09:39:38

lucas3 发表于 2014-11-28 09:21
ST大师，还是不行了
选择图框显示：Error: 参数太少，另外选择角点也用不成了。

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

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

lucas3 · 发表于 2014-11-28 10:36:03

st788796 发表于 2014-11-28 09:39

谢谢ST大师
选择图框块现在是可行了，计算出来的比例跟选择角点计算出来的比例是相同的了，但又有其它问题了，如下：
1. 原来选择角点，接受比例，输入字高后，范围内的标注样式同文字高度会更新，但是现在选择角点会更新，而选择块的方式不会更新。
2. 原来选择角点的方式，生成的标注样式的全局比例及文字高度是只保留一位小数的，但是现在无论是选择角点还是选择块生成的小数位又有很多了

st788796 · 发表于 2014-11-28 10:47:35

lucas3 发表于 2014-11-28 10:36
谢谢ST大师
选择图框块现在是可行了，计算出来的比例跟选择角点计算出来的比例是相同的了，但又有其它问 ...

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

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

lucas3 · 发表于 2014-11-28 11:17:14

st788796 发表于 2014-11-28 10:47

谢谢ST大师，第二点问题解决了，第一个问题还没有呀

1. 选择角点，接受比例，输入字高后，范围内的标注样式同文字高度会更新，但是现在选择角点会更新，而选择块的方式不会更新。

st788796 · 发表于 2014-11-28 11:33:12

lucas3 发表于 2014-11-28 11:17
谢谢ST大师，第二点问题解决了，第一个问题还没有呀

1. 选择角点，接受比例，输入字高后，范围内的标 ...

选点能用，点图框的也能用啊，你要保证图框都显示，不然 ssget 选不到

账号		自动登录	找回密码
密码			立即注册

[已解决] 像这样改变当前标注文字高度

点评

点评

点评

点评

点评