附着点
我一直在摆弄李的中长代码，试图学习一些新东西。我已经能够将多行文字沿着柱脚移动到不同的点，并改变对齐方式。我遇到的问题是将多行文字插入点与柱脚上的附件点偏移。有什么简单的改变吗？感谢您的帮助！;;----------------------=={ 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 ;;
;;----------------------------------------------------------------------;;
;;Version 1.0 - 2013-11-12 ;;
;; ;;
;;- First release. ;;
;;----------------------------------------------------------------------;;
;;Version 1.1 - 2016-01-16 ;;
;; ;;
;;- Modified LM:objectid function to account for 64-bit AutoCAD 2008. ;;
;;----------------------------------------------------------------------;;
_$
(defun c:Test ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )
(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 0.1) 0 1 t)
uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
)
(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 "\">%"
)
)
)
(vla-put-backgroundfilltxt :vlax-false)
(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)))
)
(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 (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(LM:ename->objectid (vlax-vla-object->ename obj))
)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:objectid obj)
)
;; Entity Name to ObjectID-Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name
(defun LM:ename->objectid ( ent )
(LM:hex->decstr
(setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
ent (substr ent (+ (vl-string-position 58 ent) 3))
)
)
)
;; Hex to Decimal String-Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string
(defun LM:hex->decstr ( hex / foo bar )
(defun foo ( lst rtn )
(if lst
(foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
(apply 'strcat (mapcar 'itoa (reverse rtn)))
)
)
(defun bar ( int lst )
(if lst
(if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
(cons (rem int 10) (bar (/ int 10) (cdr lst)))
)
(bar int '(0))
)
)
(foo (vl-string->list (strcase hex)) nil)
)
;; 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.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"midlen\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;; 利用vlax曲线getFirstDeriv和极性函数，
还要检查他的“将文本对齐到曲线”程序。 好的，谢谢。我会调查的。谢谢你的帮助
页:
[1]