我认为这很容易做到，但现在开始胡闹已经太晚了。
如果在那之前没有人帮你解决问题，我明天就试试。
非常感谢Dadgad
尝试：
;;----------------------=={ Length at Midpoint }==----------------------;;
;; ;;
;;This program prompts the user for a selection of objects to be ;;
;;labelled and proceeds to generate an MText object located at ;;
;;the midpoint of each object displaying a Field Expression ;;
;;referencing the length of the object. ;;
;; ;;
;;The program is compatible for use with Arcs, Circles, Lines, ;;
;;LWPolylines, 2D & 3D Polylines, and under all UCS & View settings.;;
;; ;;
;;The program will generate MText objects positioned directly over ;;
;;the midpoint of each object, and aligned with the object whilst ;;
;;preserving text readability. The MText will have a background mask;;
;;enabled and will use the active Text Style and Text Height settings ;;
;;at the time of running the program. ;;
;;----------------------------------------------------------------------;;
;;Author:Lee Mac, Copyright © 2013-www.lee-mac.com ;;
;;Above/Below line added by Tom Beauford
;;----------------------------------------------------------------------;;
;;Version 1.1 - 12-11-2013 ;;
;; ;;
;;First release. ;;
;;----------------------------------------------------------------------;;
(defun c:midlen ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa ang pt str1)
(setq fmt "%lu6") ;; Field Formatting
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if
(setq sel
(ssget
(list
'(0 . "ARC,CIRCLE,LINE,*POLYLINE")
'(-4 . "<NOT")
'(-4 . "<AND")
'(0 . "POLYLINE")
'(-4 . "&")
'(70 . 80)
'(-4 . "AND>")
'(-4 . "NOT>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(progn
(setq spc
(vlax-get-property (LM:acdoc)
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
)
(initget "Yes No")
(or
(setq str1 (getkword "\nBelow Line? <Yes>: "))
(setq str1 "Yes")
)
(if (= str1 "Yes")
(setq up-dn (/ pi 2))
(setq up-dn (-(/ pi 2)))
)
(LM:startundo (LM:acdoc))
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
ins (vlax-curve-getpointatparam ent par)
typ (cdr (assoc 0 (entget ent)))
)
(setq txt
(vlax-invoke spc 'addmtext ins 0.0
(strcat
"%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
(cond
( (= "CIRCLE" typ) "Circumference")
( (= "ARC" typ) "ArcLength")
( "Length" )
)
" \\f \"" fmt "\">%"
)
)
)
(setq ins (polar ins(-(LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa))up-dn)(*(vla-get-Height txt)0.))
(vla-put-backgroundfilltxt :vlax-true)
(vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
(vla-put-insertionpointtxt (vlax-3D-point ins))
(vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
(setq elist (entget (vlax-vla-object->ename txt))
elist (subst (cons 45 1.15) (assoc 45 elist) elist) ;Set 'Border Offset Factor' to 1.15
elist (subst (cons 41 (* (cdr (assoc 42 elist))1.015))(assoc 41 elist) elist) ;Trim excess width
)
(entmod elist)
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; Readable-Lee Mac
;; Returns an angle corrected for text readability.
(defun LM:readable ( a )
( (lambda ( a )
(if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
(LM:readable (+ a pi))
a
)
)
(rem (+ a pi pi) (+ pi pi))
)
)
;; 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
(strcat
"\n:: MidLen.lsp | Version 1.0 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"midlen\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;作为与对象的距离-您可以更改0.8，或将此表达式替换为固定距离。
谢谢李。我把0.8换成另一个数字&它成功了。
但是你说的“用固定距离替换这个表达式”是什么意思？
此外，是否可以使“与线条的距离”与文本的大小成比例？
如何更改文本大小？
谢谢 只是猜测一下，因为我不太熟练，但我怀疑这将由运行lisp时当前文本样式的文本大小来定义。
值得做一个测试，看看这是否能控制它。
哦它确实奏效了。 嗨，李或任何能帮忙的人。
我有几个问题：
1） 如何以米而不是毫米列出文本？
我把单位改为米，但还是以毫米为单位
2） 如何根据文本大小按比例调整“与线条的距离”？
谢谢 将(*(getvar "TEXTSIZE")0.更改为
(setq fmt "%lu6")
我修改了上面的代码，并用
4
使用textsize对我很有效，因为我没有为文本样式指定高度。这在任何情况下都应该有效，并再次将0.8更改为您需要的任何值，以根据文本的大小按比例调整“与行的距离”。 Change (setq fmt "%lu6") to
(setq fmt "%lu6%ct8")
I modified the code above and replaced (getvar "textsize") with
(vla-get-Height txt)
Using the textsize worked for me because I don't assign heights to text styles.This should work in any case and again change the 0.8 to whatever you need to adjust the "distance from the line" proportionate to the size of the text.
页:
1
[2]