求助修改文字动态对齐线支持多行文字
本帖最后由 iszc 于 2021-5-26 08:47 编辑动态对齐线支持多行文字 本帖最后由 print1985 于 2021-5-25 23:36 编辑
试试国际大神李麦克的：
将对象对齐到曲线 http://www.lee-mac.com/objectalign.html
http://www.lee-mac.com/lisp/gifs/ObjectAlignV1-1.gif
适用所有图元
命令oa，几个简单的英文提示，应该都能看懂吧
(defun c:oa
(
/
*error*
bb1 bb2 blk bnm bpt
def dis
ent
fac
gr1 gr2
idx inc
llp lst
mat msg
obj ocs oss
pi2 pt1 pt2 pt3 pt4
sel
tma tmp trm
urp uxa
vec
)
(defun *error* ( msg )
(if (and (= 'list (type trm)) (= 'ename (type ent)) (entget ent))
(entdel ent)
)
(if (and (= 'vla-object (type blk)) (not (vlax-erased-p blk)))
(vl-catch-all-apply 'vla-delete (list blk))
)
(if (and (= 'vla-object (type def)) (not (vlax-erased-p def)))
(vl-catch-all-apply 'vla-delete (list def))
)
(foreach obj lst
(if (not (vlax-erased-p obj))
(vl-catch-all-apply 'vla-delete (list obj))
)
)
(oa:endundo (oa:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(oa:startundo (oa:acdoc))
(if (null oa|rot) (setq oa|rot 0.0))
(if (null oa|off) (setq oa|off 0.0))
(cond
( (or (oa:layerlocked (getvar 'clayer))
(oa:layerlocked "0")
)
(princ "\nThe current layer or layer \"0\" is locked - please unlock these layers before using this program.")
)
( (null (setq oss (oa:ssget "\nSelect objects to align: " '("_:L" ((0 . "~VIEWPORT"))))))
(princ "\n*Cancel*")
)
( (progn
(setq bpt (getpoint "\nSpecify basepoint <center>: "))
(while
(progn
(setvar 'errno 0)
(setq sel (nentselp "\nSelect curve to align objects <exit>: "))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type (car sel)))
(if
(not
(or (= "VERTEX" (cdr (assoc 0 (entget (car sel)))))
(not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list (car sel)))))
)
)
(princ "\nInvalid object selected.")
)
)
)
)
)
(while (/= 5 (car (setq pt1 (grread t 13 1)))))
(null sel)
)
)
( (not
(or
(and
(setq trm (caddr sel))
(setq ent (oa:copynested (car sel) trm))
)
(and
(= "VERTEX" (cdr (assoc 0 (entget (car sel)))))
(setq ent (cdr (assoc 330 (entget (car sel)))))
)
(setq ent (car sel))
)
)
(princ "\nUnable to recreate nested entity.")
)
( (progn
(setq ocs (trans '(0 0 1) 1 0 t)
uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
mat (mxm
(list
(list (cos uxa) (sin uxa) 0.0)
(list (- (sin uxa)) (cos uxa) 0.0)
'(0.0 0.0 1.0)
)
(mapcar '(lambda ( a ) (trans a ocs 0 t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
)
vec (mapcar '- (mxv mat (trans '(0.0 0.0 0.0) ocs 0)))
tma (vlax-tmatrix (append (mapcar 'append mat (mapcar 'list vec)) '((0.0 0.0 0.0 1.0))))
)
(repeat (setq idx (sslength oss))
(setq idx (1- idx)
obj (vla-copy (vlax-ename->vla-object (ssname oss idx)))
lst (cons obj lst)
)
(vla-transformby obj tma)
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq bb1 (cons (vlax-safearray->list llp) bb1)
bb2 (cons (vlax-safearray->list urp) bb2)
)
)
(vla-put-visible obj :vlax-false)
)
(not (and bb1 bb2))
)
(*error* nil)
(princ "\nUnable to calculate bounding box for the selection.")
)
( t
(setq bb1 (apply 'mapcar (cons 'min bb1))
bb2 (apply 'mapcar (cons 'max bb2))
bpt (cond ( bpt (mapcar '+ (mxv mat (trans bpt 1 0)) vec)) ((mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) bb1 bb2)))
fac (/ (- (cadr bb2) (cadr bb1)) 2.0)
pi2 (/ pi -2.0)
inc 0
)
(if (equal 0.0 fac 1e-8)
(if (equal bb1 bb2 1e-8)
(setq fac 1.0)
(setq fac (/ (- (car bb2) (car bb1)) 2.0))
)
)
(while (tblsearch "block" (setq bnm (strcat "$tmp" (itoa (setq inc (1+ inc)))))))
(foreach obj lst (vla-put-visible obj :vlax-true))
(vla-copyobjects (oa:acdoc)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
(setq def (vla-add (vla-get-blocks (oa:acdoc)) (vlax-3D-point bpt) bnm))
)
(foreach obj lst (vla-delete obj))
(setq lst nil
blk
(vla-insertblock
(vlax-get-property (oa:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cadr pt1) 1 0))
bnm 1.0 1.0 1.0 0.0
)
)
(vla-put-layerblk "0")
(vla-put-normal blk (vlax-3D-point ocs))
(setq msg (princ "\n[+/-] for ffset | [</>] for otation | ultiple | <xit>: "))
(while
(progn
(setq gr1 (grread t 15 0)
gr2 (cadr gr1)
gr1 (cargr1)
)
(cond
( (member gr1 '(3 5))
(setq pt2 (trans gr2 1 0)
pt1 (vlax-curve-getclosestpointtoprojection ent pt2 ocs)
pt3 (oa:2d (trans pt1 0 ocs))
pt4 (oa:2d (trans pt2 0 ocs))
)
(if (not (equal pt3 pt4 1e-8))
(progn
(setq dis (/ (* fac oa|off) (distance pt3 pt4)))
(vla-put-insertionpoint blk
(vlax-3D-point
(trans
(append
(mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt3 pt4)
(list (caddr (trans pt1 0 ocs)))
)
ocs 0
)
)
)
(vla-put-rotation blk (+ (angle (trans pt1 0 ocs) (trans gr2 1 ocs)) oa|rot pi2))
)
)
(cond
( (= 5 gr1))
( (progn (vla-explode blk) oa|mtp))
)
)
( (= 2 gr1)
(cond
( (member gr2 '(043 061))
(setq oa|off (+ oa|off 0.1))
)
( (member gr2 '(045 095))
(setq oa|off (- oa|off 0.1))
)
( (member gr2 '(044 060))
(setq oa|rot (+ oa|rot (/ pi 4.0)))
)
( (member gr2 '(046 062))
(setq oa|rot (- oa|rot (/ pi 4.0)))
)
( (member gr2 '(013 032 069 101))
nil
)
( (member gr2 '(082 114))
(if (setq tmp (getangle (strcat "\nSpecify Rotation <" (angtos oa|rot) ">: ")))
(setq oa|rot tmp)
)
(princ msg)
)
( (member gr2 '(079 111))
(if (setq tmp (getdist (strcat "\nSpecify Offset <" (rtos (* fac oa|off)) ">: ")))
(setq oa|off (/ tmp fac))
)
(princ msg)
)
( (member gr2 '(077 109))
(if (setq oa|mtp (not oa|mtp))
(princ "\n<Multiple mode on>")
(princ "\n<Multiple mode off>")
)
(princ msg)
)
( t )
)
)
( (member gr1 '(011 025))
nil
)
( t )
)
)
)
(if trm (entdel ent))
(vla-deleteblk)
(vla-deletedef)
(oa:endundo (oa:acdoc))
)
)
(princ)
)
;;----------------------------------------------------------------------;;
(defun oa:2d ( x ) (list (car x) (cadr x)))
;;----------------------------------------------------------------------;;
(defun oa:layerlocked ( lay / def )
(and
(setq def (tblsearch "layer" lay))
(= 4 (logand 4 (cdr (assoc 70 def))))
)
)
;;----------------------------------------------------------------------;;
(defun oa:copynested ( ent mat / enx tmp )
(if (= 1 (cdr (assoc 66 (setq enx (entget ent)))))
(progn
(oa:entmakex enx)
(setq ent (entnext ent)
enx (entgetent)
)
(while (/= "SEQEND" (cdr (assoc 0 enx)))
(oa:entmakex enx)
(setq ent (entnext ent)
enx (entgetent)
)
)
(setq tmp (cdr (assoc 330 (entget (oa:entmakex enx)))))
)
(setq tmp (oa:entmakex enx))
)
(if tmp (vla-transformby (vlax-ename->vla-object tmp) (vlax-tmatrix mat)))
tmp
)
;;----------------------------------------------------------------------;;
(defun oa:entmakex ( enx )
(entmakex
(append
(vl-remove-if
(function
(lambda ( x )
(or (member (car x) '(005 006 008 039 048 062 102 370))
(= 'ename (type (cdr x)))
)
)
)
enx
)
'(
(006 . "CONTINUOUS")
(008 . "0")
(039 . 0.0)
(048 . 1.0)
(062 . 7)
(370 . 0)
)
)
)
)
;;----------------------------------------------------------------------;;
(defun oa:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;;----------------------------------------------------------------------;;
(defun oa:startundo ( doc )
(oa:endundo doc)
(vla-startundomark doc)
)
;;----------------------------------------------------------------------;;
(defun oa:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;;----------------------------------------------------------------------;;
(defun oa:acdoc nil
(eval (list 'defun 'oa:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(oa:acdoc)
)
;;----------------------------------------------------------------------;;
;; Matrix Transpose-Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix-Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector-Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: ObjectAlign.lsp | Version 1.7 | \\U+00A9 Lee Mac "
((lambda ( y ) (if (= y (menucmd "m=$(edtime,0,yyyy)")) y (strcat y "-" (menucmd "m=$(edtime,0,yyyy)")))) "2010")
" www.lee-mac.com ::"
"\n:: Type \"oa\" to Invoke ::"
)
)
(princ)
本帖最后由 print1985 于 2021-5-25 23:55 编辑
该程序将使用户能够通过直观的放置控件将选择的对象动态地对齐到选定的曲线。
1、使用OA命令后将提示用户选择要对齐的对象。
2、进行有效选择后，将提示用户指定要在对齐过程中使用的基点。在此提示下，程序将默认使用所选对象边界框的中心。
3、然后提示用户选择要与对象选择对齐的曲线对象（可以是直线，折线，弧，圆，椭圆，XLine，样条线等）。所选曲线可以是主要对象，也可以是嵌套在任何级别的嵌套有“块”或“外部参照”的对象。
4、选择之后，该程序提供了几个控件来帮助在命令行上显示对象的放置：
可以使用小键盘+/-键将对象相对于曲线的偏移量按对象高度的十分之一进行增量控制，也可以按O键输入特定的偏移量。
通过分别按下 < 键 或 > 键，可以将对象组相对于曲线逆时针或顺时针旋转45度；用户可以通过按下R键来输入特定的旋转。
用户可以通过按键M切换“多种模式” 。启用此模式后，用户可以将所选对象的多个副本连续对齐到所选曲线（就是连续复制对齐）。
最后，用户可以通过左键单击鼠标来放置对象，或者可以通过右键单击鼠标，按Enter或Space或通过E按键来调用“退出”选项来退出程序。
该程序应在所有UCS和视图以及具有可用Visual LISP功能的所有AutoCAD版本中成功执行（自AutoCAD 2000起）。 很实用，非常感谢 print1985 发表于 2021-5-25 23:51
该程序将使用户能够通过直观的放置控件将选择的对象动态地对齐到选定的曲线。
1、使用OA命令后将提示用户 ...
有没有批量框选文字 对齐到线的 求一个选择文字并复制文字，多次点击PL线使文字旋转并依次齐PL线直至空回车退出的lisp
页:
[1]