控制文本大小
大家好！我正在使用李·麦克先生的优秀代码。
我需要帮助对代码进行一些修改。
我想控制文本大小。该代码没有任何选项。
有人能帮我吗？
提前感谢
;;-------------------=={ Areas 2 Field }==--------------------;;
;; ;;
;;Creates an MText object containing a Field Expression ;;
;;referencing the area, or sum of areas, of one or more ;;
;;selected objects. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Version 1.2 - 26-05-2013 ;;
;;------------------------------------------------------------;;
(defun c:a2f ( / *error* fmt inc ins lst sel str )
(setq fmt "%lu6%qf1%ds44%th46") ;; Field Formatting
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if
(and
(setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))))
(setq ins (getpoint "\nPick Point for Field: "))
)
(progn
(if (= 1 (sslength sel))
(setq str
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
">%).Area \\f \"" fmt "\">%"
)
)
(progn
(repeat (setq inc (sslength sel))
(setq lst
(vl-list*
"%<\\AcObjProp Object(%<\\_ObjId "
(LM:ObjectID (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))))
">%).Area>%" " + "
lst
)
)
)
(setq str
(strcat
"%<\\AcExpr "
(apply 'strcat (reverse (cdr (reverse lst))))
" \\f \"" fmt "\">%"
)
)
)
)
(LM:startundo (LM:acdoc))
(vla-addmtext
(vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans ins 1 0))
0.0
str
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; ObjectID-Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:ObjectID ( obj )
(eval
(list 'defun 'LM:ObjectID '( obj )
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:ObjectID obj)
)
;; Start Undo-Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo-Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document-Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;; 你好
如果你读李的页面
http://www.lee-mac.com/fieldformat.html
您将看到如何更改文本大小。 你好
请阅读Lee的说明页了解此LISP。
而且
（setq fmt“%lu6%qf1%ds44%th46”）；；字段格式
如果我记得th指的是文字高度。我相信李会证实的。 你好，Spaj，
谢谢你的快速回放
我在考虑是否可能为文本大小创建一个输入，而不是在代码内部修改。 嗨，Madruga，
由于程序正在创建多行文字字段，因此文字高度将由运行程序时TEXTSIZE系统变量的值确定。
然而，这里有一个快速修改，包括一个额外的高度提示：
;;-------------------=={ Areas 2 Field }==--------------------;;
;; ;;
;;Creates an MText object containing a Field Expression ;;
;;referencing the area, or sum of areas, of one or more ;;
;;selected objects. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Version 1.2 - 26-05-2013 ;;
;;------------------------------------------------------------;;
;; Modified to prompt for text height-Lee Mac 2013-12-18
(defun c:a2f ( / *error* fmt hgt inc ins lst sel str )
(setq fmt "%lu6%qf1%ds44%th46") ;; Field Formatting
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
;; <Modified>
(initget 6)
(if (setq hgt (getdist (strcat "\nSpecify text height <" (rtos (getvar 'textsize)) ">: ")))
(setvar 'textsize hgt)
(setq hgt (getvar 'textsize))
)
;; </Modified>
(if
(and
(setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))))
(setq ins (getpoint "\nPick Point for Field: "))
)
(progn
(if (= 1 (sslength sel))
(setq str
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
">%).Area \\f \"" fmt "\">%"
)
)
(progn
(repeat (setq inc (sslength sel))
(setq lst
(vl-list*
"%<\\AcObjProp Object(%<\\_ObjId "
(LM:ObjectID (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))))
">%).Area>%" " + "
lst
)
)
)
(setq str
(strcat
"%<\\AcExpr "
(apply 'strcat (reverse (cdr (reverse lst))))
" \\f \"" fmt "\">%"
)
)
)
)
(LM:startundo (LM:acdoc))
(vla-put-height ;; mod
(vla-addmtext
(vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans ins 1 0))
0.0
str
)
hgt ;; mod
) ;; mod
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; ObjectID-Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:ObjectID ( obj )
(eval
(list 'defun 'LM:ObjectID '( obj )
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:ObjectID obj)
)
;; Start Undo-Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo-Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document-Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
@Spaj，感谢您的回复和建议，非常感谢。 哇！
非常感谢李先生，
修改改进了代码。让它变得更好！
当做 太好了-不客气，Madruga，很乐意帮忙 大家好，
我怎么能把文本区域只设为2个十进制单位？
我想了解代码的哪一部分可以做到这一点。
有人能教我吗？
顺致敬意，
将LUPREC系统变量更改为所需的变量 感谢Tharwat的快速回放，
我想把它放在代码中。我的意思是一直是2个十进制单位
因为我知道如何通过LUPREC进行更改，但今天我忘记了更改，我绘制了错误的文本。
页:
[1]
2