文字齐线，支持块内文字，UCS（源码分享，块坐标系转换）
本帖最后由 林霄云 于 2014-12-15 01:25 编辑文字齐线，支持块内文字和块内直线
1，问题的提出
文字齐线已有很多作品了。结构画图常需要文字与线距离固定，以示美观。或在线上或在线下。在早些时候我有意做了这么一个修改命令，对于单行文本，已成功奏效。参考线通过点选，可以是line也可以是块内的line。这里借助了G版的块内坐标系变换函数（不清楚是不是，反正先挂大神头上）。文字亦支持块内文字。
2，步骤
简述一下思路，选择参考线（直线或块内直线，并标记），获取该直线的端点，及其倾角
选择文字，分别判断，普通文字，或是块内文字。进行相应的运算修改。
难点有：在统一的坐标系下进行比对，文字方向的判断；角度也应转换。
感谢transnested函数，原作者信息丢失，十分抱歉。
3，代码
首先是引用的坐标变换函数; (defun c:test (/ LST ENT DXF TYP ES P0 P1 )
; (initget 1)
; (setq lst (nentsel "\n选择物体：")) ;nentsel嵌套选择
; (if (and
; (setq ent (car lst)) ;存在实体
; (setq dxf (entget ent)) ;DXF码
; (setq typ (cdr (assoc 0 dxf))) ;图元类型
; (setq p0(cdr (assoc 10 dxf))) ;中心点或者插入点
; )
; (progn
; (setq Es (last lst)) ;块参照列表(可能有嵌套)
; (setq P1 (TransNested P0 Es 2 0)) ;把点从块内坐标系统变换到世界坐标系
; (entmakeX (list '(0 . "POINT") (cons 10 p1))) ;画出变换后的点
; )
; (princ "\n你没点中或者此处物体没有中心点或者插入点!")
; )
; (princ)
; )
;;;-----------------------------------------------------------;;
;;; 两个2d向量的叉积的数值 ;;
;;; 输入: 两个点（或者两个向量） ;;
;;; 输出: 一个数值.如果为正则是逆时针,两向量形成的平面法线向量;;
;;; 向上，为负则是顺时针，为零则两向量共线或平行。 ;;
;;; 这个数值也为原点,P1,P2三点面积的两倍。 ;;
;;;-----------------------------------------------------------;;
(defun MAT:Det2V (v1 v2)
(- (* (car v1) (cadr v2)) (* (car v2) (cadr v1)))
)
;;;-----------------------------------------------------------;;
;;; 两向量相减subtraction ;;
;;; Input: v1,v2 -vectors in R^n ;;
;;; OutPut: A vector ;;
;;;-----------------------------------------------------------;;
(defun MAT:v-v (v1 v2)
(mapcar '- v1 v2)
)
;;; 矢量的点积
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;;; 矢量转置
;;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;;; 矢量的矩阵变换
;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
(mapcar (function (lambda (r) (vxv r v))) m)
)
;;; 点到矩阵的变换
(defun mxp (m p)
(reverse (cdr (reverse (mxv m (append p '(1.0))))))
)
;;; 矩阵相乘
;;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
(mapcar (function (lambda (r) (mxv (trp q) r))) m)
)
;; TransNested (gile)
;; Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
;; reference (xref or block) whatever its nested level-
;;
;; Arguments
;; pt : the point to translate
;; rlst : the parents entities list from the deepest nested to the one inserted in
;; current space -same as (last (nentsel)) or (last (nentselp))
;; from to : as with trans function: 0 for WCS, 1 for current UCS, 2 for RCS
(defun TransNested (pt rlst from to / geom)
(and (= 1 from) (setq pt (trans pt 1 0)))
(and (= 2 to) (setq rlst (reverse rlst)))
(and (or (= 2 from) (= 2 to))
(while rlst
(setq geom (if(= 2 to)
(RevRefGeom (car rlst))
(RefGeom (car rlst))
)
rlst (cdr rlst)
pt (mapcar '+ (mxv (car geom) pt) (cadr geom))
)
)
)
(if (= 1 to)
(trans pt 0 1)
pt
)
)
;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, bloc or space)
;;
;; Argument : an ename
(defun RefGeom (ename / elst ang norm mat u v w A B)
(setqelst (entget ename)
ang(cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(setq u (cdr (assoc 41 elst)))
(setq v (cdr (assoc 42 elst)))
(setq w (cdr (assoc 43 elst)))
(setq A (cos ang))
(setq B (sin ang))
(list
(setq mat
(mxm
(mapcar (function (lambda (v) (trans v 0 norm T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(list (list (* u A) (- (* v B)) 0.0)
(list (* u B) (* v A) 0.0)
(list 0.0 0.0 w)
)
)
)
(mapcar
'-
(trans (cdr (assoc 10 elst)) norm 0)
(mxv mat
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
)
)
)
)
;; RevRefGeom (gile)
;; RefGeom inverse function
(defun RevRefGeom (ename / entData ang norm mat)
(setqentData(entget ename)
ang(- (cdr (assoc 50 entData)))
norm(cdr (assoc 210 entData))
)
(list
(setq mat
(mxm
(list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v norm 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
)
(mapcar '-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
(mxv mat (trans (cdr (assoc 10 entData)) norm 0))
)
)
)
主函数(load "transnestedfun.lsp" "\n加载transnestedfun.lsp失败!")
(defun C:ATD ( / ref-line ref-lin pt1 pt2 ang ang1 obj-line text-e text-en len pt-temp pt-te1pt-tt pt-tt1 teh angflag flag s1 ss i bname ang-te ) ;Advanced TD
; 函数ATD Advanced TD 文字齐线。
; Desiged by 林霄云2014年5月19日
(if (null hnu:dimscale)
(setq hnu:dimscale 100)
);if
(setq linflag nil)
(if (and (setq ref-lin (nentsel "\n点选参考线"))
( = (get-dxf 0 (setq ref-line (car ref-lin))) "LINE" ))
(progn
(setq pt1 (get-dxf 10 ref-line)
pt2 (get-dxf 11 ref-line)
)
(if (> (length ref-lin) 2)
(setq linflag t)
);if
(and
linflag
(setq bname (last ref-lin))
(setq pt1 (transnested pt1 bname 2 0))
(setq pt2 (transnested pt2 bname 2 0))
);and 如果是块内直线，则pt1，pt2转换为世界坐标系下。
(grdraw (trans pt1 0 1)(trans pt2 0 1) -1 1)
(setqang (angle pt1 pt2)
obj-line (vlax-ename->vla-object ref-line)
ang1 (- ang (angle '(0 0 0) (getvar 'UCSXDIR)))
)
(setq angflag pt2)
(if ( < (* 0.5 pi ) ang1 (* 1.5 pi ))
(progn (setq ang (angle pt2 pt1)
angflag pt1)
);progn
)
(while
(and (setq text-e (nentsel "\n点选需要调整的文字")
len (length text-e)
text-en (car text-e))
(= (get-dxf 0 text-en) "TEXT")
);and
(cond
((= 2 len)
(setq pt-tt (get-dxf 10 text-en)
teh(get-dxf 40 text-en))
(if linflag
(setq pt-tt1(transnested pt-tt bname 0 2)) ;pt-tt1为下一步，临时转换到块坐标系下的点
(setq pt-tt1 pt-tt)
)
(setq pt-temp (vlax-curve-getClosestPointTo obj-line pt-tt1 t))
;(setq pt-temp (inters pt1 pt2 pt-tt (offset_point pt_tt 0 hnu:dimscale ang) nil))
(and
linflag
(setq pt-temp(transnested pt-temp bname 2 0))
)
(if ( < (mat:det2v (mat:v-vpt-tt pt-temp)(mat:v-vangflag pt-temp)) 0)
(setq flag hnu:dimscale)
(setq flag (- (+ teh hnu:dimscale)))
)
(setq pt-te (offset_point pt-temp0 flagang ))
(set-dxf text-en 10 pt-te)
(set-dxf text-en 50 ang)
(set-dxf text-en 72 0)
(set-dxf text-en 73 0)
);cond len 2
((= 4 len) ;When the selected object is a component of a block reference other than an attribute, nentsel returns a list containing four ;elements.
(setq pt-tt (get-dxf 10 text-en)
teh(get-dxf 40 text-en))
(setq pt-tt (transnested pt-tt (last text-e ) 2 0))
;这里得区分linflag=true时，要转换到该line块里。
(if linflag
(setq pt-tt1(transnested pt-tt bname 0 2)) ;pt-tt1为下一步，临时转换到块坐标系下的点
(setq pt-tt1 pt-tt)
)
(setq pt-temp (vlax-curve-getClosestPointTo obj-line pt-tt1 t))
;这里得区分linflag=true时，要转换到该line块里。
(and
linflag
(setq pt-temp(transnested pt-temp bname 2 0))
)
;(make_line (list pt-tt pt-temp) "0" )
;(setq pt-temp (inters pt1 pt2 pt-tt (offset_point pt_tt 0 hnu:dimscale ang) nil))
(if ( < (mat:det2v (mat:v-vpt-tt pt-temp)(mat:v-vangflag pt-temp)) 0)
(setq flag hnu:dimscale)
(setq flag (- (+ teh hnu:dimscale)))
)
(setq pt-te (offset_point pt-temp0 flagang ))
;(make_line (list pt-temp pt-te) "0");这里是正确的。如何将pt-te从世界坐标系转到块里。
(setq pt-te (transnested pt-te (last text-e)0 2))
;(setq pt-te (trans pt-te 2 test-en))
;对角度进行转化
(setq ang-te(transnested (list (cos ang)(sin ang) 0) (last text-e) 0 2))
(setq ang-te (angle (transnested (list 0 0 0 ) (last text-e) 0 2) ang-te))
(set-dxf text-en 10pt-te )
(set-dxf text-en 50 ang-te)
(set-dxf text-en 72 0)
(set-dxf text-en 73 0)
(setq i -1)
(setq ss (ssget "X" (list (cons 2(cdr (assoc 2 (entget (car(reverse(cadddr text-e)))))) ) ) )); The fourth element is a list containing the entity name of the block that contains the selected object.
; If the selected object is in a nested block (a block within a block), the list also contains the entity names of all blocks in which the selected object is nested, starting with the innermost block and continuing outward until the name of the block that was inserted in the drawing is reported.
; 所以反转，取最外面的的块名。
(while (setq s1 (ssname ss (setq i (1+ i))))
(entupd s1))
);cond len 4
);cond
)
);progn
);if
(redraw)
(princ)
);defun
(princ "\nATDAdvanced TD 文字齐线命令加载成功\nDesigned by 林霄云 2014年5月19日")
(princ) 选直线显示有问题，不能选择直线？
为啥下载不了？我已付了个币的哦 什么意思...直线和文字都是块??什么情况需要这样对齐....??? q3_2006 发表于 2014-12-15 07:01 static/image/common/back.gif
什么意思...直线和文字都是块??什么情况需要这样对齐....???
直线与文字隶属于不同的块（或外部参照），支持块，是免除进入块内操作。
非常厉害，谢谢楼主分享 刚好试用了一下，还不错，稍微有一点点，就是文字好像会挪动很大的位置，甚至跑到块外面很远的地方，希望能不能增加一个选项，就是文字可以按需要对齐的线的角度在文字自己的字身的形心或者对齐进行相应旋转。文字的位置基本上不变的那种。谢谢哈。 试了一下，还行，不过只能对齐文字，G版的ALO对齐更实用一些 新人学习中 结构的表示很喜欢这个 谢谢了 rhww 发表于 2014-12-15 12:55
非常厉害，谢谢楼主分享
非常厉害，谢谢分享哈哈 虽然厉害，但是对我来说没啥卵用
页:
[1]
2