明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 6175|回复: 17

[源码] 文字齐线,支持块内文字,UCS(源码分享,块坐标系转换)

  [复制链接]
发表于 2014-12-15 00:02 | 显示全部楼层 |阅读模式
本帖最后由 林霄云 于 2014-12-15 01:25 编辑

文字齐线,支持块内文字和块内直线
1,问题的提出
文字齐线已有很多作品了。结构画图常需要文字与线距离固定,以示美观。或在线上或在线下。在早些时候我有意做了这么一个修改命令,对于单行文本,已成功奏效。参考线通过点选,可以是line也可以是块内的line。这里借助了G版的块内坐标系变换函数(不清楚是不是,反正先挂大神头上)。文字亦支持块内文字。

2,步骤
简述一下思路,选择参考线(直线或块内直线,并标记),获取该直线的端点,及其倾角
选择文字,分别判断,普通文字,或是块内文字。进行相应的运算修改。
难点有:在统一的坐标系下进行比对,文字方向的判断;角度也应转换。
感谢transnested函数,原作者信息丢失,十分抱歉。

3,代码
首先是引用的坐标变换函数
  1. ; (defun c:test (/ LST ENT DXF TYP ES P0 P1 )
  2.   ; (initget 1)
  3.   ; (setq lst (nentsel "\n选择物体:"))          ;nentsel嵌套选择
  4.   ; (if (and
  5.         ; (setq ent (car lst))            ;存在实体
  6.         ; (setq dxf (entget ent))            ;DXF码
  7.         ; (setq typ (cdr (assoc 0 dxf)))          ;图元类型
  8.         ; (setq p0  (cdr (assoc 10 dxf)))          ;中心点或者插入点
  9.       ; )               
  10.     ; (progn
  11.       ; (setq Es (last lst))            ;块参照列表(可能有嵌套)
  12.       ; (setq P1 (TransNested P0 Es 2 0))         ;把点从块内坐标系统变换到世界坐标系
  13.       ; (entmakeX (list '(0 . "POINT") (cons 10 p1)))                ;画出变换后的点
  14.     ; )
  15.     ; (princ "\n你没点中或者此处物体没有中心点或者插入点!")
  16.   ; )
  17.   ; (princ)
  18. ; )

  19. ;;;-----------------------------------------------------------;;
  20. ;;; 两个2d向量的叉积的数值                                    ;;
  21. ;;; 输入: 两个点(或者两个向量)                              ;;
  22. ;;; 输出: 一个数值.如果为正则是逆时针,两向量形成的平面法线向量;;
  23. ;;;       向上,为负则是顺时针,为零则两向量共线或平行。      ;;
  24. ;;;       这个数值也为原点,P1,P2三点面积的两倍。              ;;
  25. ;;;-----------------------------------------------------------;;
  26. (defun MAT:Det2V (v1 v2)
  27.   (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1)))
  28. )

  29. ;;;-----------------------------------------------------------;;
  30. ;;; 两向量相减  subtraction                                   ;;
  31. ;;; Input: v1,v2 -vectors in R^n                              ;;
  32. ;;; OutPut: A vector                                          ;;
  33. ;;;-----------------------------------------------------------;;
  34. (defun MAT:v-v (v1 v2)
  35.   (mapcar '- v1 v2)
  36. )

  37. ;;; 矢量的点积                                                         
  38. ;;; VXV Returns the dot product of 2 vectors                           
  39. (defun vxv (v1 v2)
  40.   (apply '+ (mapcar '* v1 v2))
  41. )

  42. ;;; 矢量转置                                                            
  43. ;;; TRP Transpose a matrix -Doug Wilson-                                
  44. (defun trp (m)
  45.   (apply 'mapcar (cons 'list m))
  46. )

  47. ;;; 矢量的矩阵变换                                                      
  48. ;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
  49. (defun mxv (m v)
  50.   (mapcar (function (lambda (r) (vxv r v))) m)
  51. )

  52. ;;; 点到矩阵的变换
  53. (defun mxp (m p)
  54.   (reverse (cdr (reverse (mxv m (append p '(1.0))))))
  55. )

  56. ;;; 矩阵相乘                                                            
  57. ;;; MXM Multiply two matrices -Vladimir Nesterovsky-                    
  58. (defun mxm (m q)
  59.   (mapcar (function (lambda (r) (mxv (trp q) r))) m)
  60. )

  61. ;; TransNested (gile)
  62. ;; Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
  63. ;; reference (xref or block) whatever its nested level-
  64. ;;
  65. ;; Arguments
  66. ;; pt : the point to translate
  67. ;; rlst : the parents entities list from the deepest nested to the one inserted in
  68. ;;        current space -same as (last (nentsel)) or (last (nentselp))
  69. ;; from to : as with trans function: 0 for WCS, 1 for current UCS, 2 for RCS

  70. (defun TransNested (pt rlst from to / geom)
  71.   (and (= 1 from) (setq pt (trans pt 1 0)))
  72.   (and (= 2 to) (setq rlst (reverse rlst)))
  73.   (and (or (= 2 from) (= 2 to))
  74.        (while rlst
  75.   (setq geom (if  (= 2 to)
  76.           (RevRefGeom (car rlst))
  77.           (RefGeom (car rlst))
  78.         )
  79.          rlst (cdr rlst)
  80.          pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
  81.   )
  82.        )
  83.   )
  84.   (if (= 1 to)
  85.     (trans pt 0 1)
  86.     pt
  87.   )
  88. )

  89. ;; RefGeom (gile)
  90. ;; Returns a list which first item is a 3x3 transformation matrix (rotation,
  91. ;; scales, normal) and second item the object insertion point in its parent
  92. ;; (xref, bloc or space)
  93. ;;
  94. ;; Argument : an ename

  95. (defun RefGeom (ename / elst ang norm mat u v w A B)
  96.   (setq  elst (entget ename)
  97.   ang  (cdr (assoc 50 elst))
  98.   norm (cdr (assoc 210 elst))
  99.   )
  100.   (setq u (cdr (assoc 41 elst)))
  101.   (setq v (cdr (assoc 42 elst)))
  102.   (setq w (cdr (assoc 43 elst)))
  103.   (setq A (cos ang))
  104.   (setq B (sin ang))
  105.   (list
  106.     (setq mat
  107.      (mxm
  108.        (mapcar (function (lambda (v) (trans v 0 norm T)))
  109.          '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
  110.        )
  111.        (list (list (* u A) (- (* v B)) 0.0)
  112.        (list (* u B) (* v A) 0.0)
  113.        (list 0.0 0.0 w)
  114.        )
  115.      )
  116.     )
  117.     (mapcar
  118.       '-
  119.       (trans (cdr (assoc 10 elst)) norm 0)
  120.       (mxv mat
  121.      (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
  122.       )
  123.     )
  124.   )
  125. )

  126. ;; RevRefGeom (gile)
  127. ;; RefGeom inverse function

  128. (defun RevRefGeom (ename / entData ang norm mat)
  129.   (setq  entData  (entget ename)
  130.   ang  (- (cdr (assoc 50 entData)))
  131.   norm  (cdr (assoc 210 entData))
  132.   )
  133.   (list
  134.     (setq mat
  135.      (mxm
  136.        (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
  137.        (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
  138.        (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
  139.        )
  140.        (mxm
  141.          (list (list (cos ang) (- (sin ang)) 0.0)
  142.          (list (sin ang) (cos ang) 0.0)
  143.          '(0.0 0.0 1.0)
  144.          )
  145.          (mapcar (function (lambda (v) (trans v norm 0 T)))
  146.            '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
  147.          )
  148.        )
  149.      )
  150.     )
  151.     (mapcar '-
  152.       (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
  153.       (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
  154.     )
  155.   )
  156. )
主函数
  1. (load "transnestedfun.lsp" "\n加载transnestedfun.lsp失败!")

  2. (defun C:ATD ( / ref-line ref-lin pt1 pt2 ang ang1 obj-line text-e text-en len pt-temp pt-te1  pt-tt pt-tt1 teh angflag flag s1 ss i bname ang-te ) ;Advanced TD
  3. ; 函数ATD Advanced TD 文字齐线。
  4. ; Desiged by 林霄云  2014年5月19日
  5. (if (null hnu:dimscale)
  6. (setq hnu:dimscale 100)
  7. );if
  8. (setq linflag nil)


  9. (if (and (setq ref-lin (nentsel "\n点选参考线"))
  10.         ( = (get-dxf 0 (setq ref-line (car ref-lin))) "LINE" ))
  11.       
  12. (progn

  13. (setq pt1 (get-dxf 10 ref-line)
  14.     pt2 (get-dxf 11 ref-line)
  15.     )
  16.    
  17.         (if (> (length ref-lin) 2)
  18.       (setq linflag t)
  19.       );if
  20.     (and
  21.      linflag
  22.     (setq bname (last ref-lin))
  23.     (setq pt1 (transnested pt1 bname 2 0))
  24.     (setq pt2 (transnested pt2 bname 2 0))
  25.    
  26.     );and 如果是块内直线,则pt1,pt2转换为世界坐标系下。
  27.     (grdraw (trans pt1 0 1)  (trans pt2 0 1) -1 1)
  28. (setq  ang (angle pt1 pt2)
  29.    
  30.     obj-line (vlax-ename->vla-object ref-line)
  31.     ang1 (- ang (angle '(0 0 0) (getvar 'UCSXDIR)))
  32.     )
  33.    
  34.   
  35.    
  36.     (setq angflag pt2)
  37.     (if   ( < (* 0.5 pi ) ang1   (* 1.5 pi ))
  38.     (progn (setq ang (angle pt2 pt1)
  39.            angflag pt1)
  40.       );progn  
  41.     )
  42.   
  43. (while
  44. (and (setq text-e (nentsel "\n点选需要调整的文字")
  45.                
  46.        len (length text-e)
  47.        text-en (car text-e))
  48.   
  49.    (= (get-dxf 0 text-en) "TEXT")
  50.    );and
  51. (cond
  52. ((= 2 len)

  53. (setq pt-tt (get-dxf 10 text-en)
  54.     teh  (get-dxf 40 text-en))
  55.    
  56. (if linflag
  57. (setq pt-tt1  (transnested pt-tt bname 0 2)) ;pt-tt1为下一步,临时转换到块坐标系下的点
  58. (setq pt-tt1 pt-tt)
  59. )
  60.    
  61. (setq pt-temp (vlax-curve-getClosestPointTo obj-line pt-tt1 t))
  62. ;(setq pt-temp (inters pt1 pt2 pt-tt (offset_point pt_tt 0 hnu:dimscale ang) nil))

  63. (and
  64. linflag
  65. (setq pt-temp  (transnested pt-temp bname 2 0))
  66. )

  67. (if ( < (mat:det2v (mat:v-v  pt-tt pt-temp)(mat:v-v  angflag pt-temp)) 0)
  68. (setq flag hnu:dimscale)
  69. (setq flag (- (+ teh hnu:dimscale)))
  70. )

  71. (setq pt-te (offset_point pt-temp  0 flag  ang ))
  72.    

  73. (set-dxf text-en 10 pt-te)
  74. (set-dxf text-en 50 ang)
  75. (set-dxf text-en 72 0)
  76. (set-dxf text-en 73 0)      

  77. );cond len 2

  78. ((= 4 len) ;When the selected object is a component of a block reference other than an attribute, nentsel returns a list containing four ;elements.
  79.       
  80. (setq pt-tt (get-dxf 10 text-en)
  81.     teh  (get-dxf 40 text-en))
  82. (setq pt-tt (transnested pt-tt (last text-e ) 2 0))
  83. ;这里得区分linflag=true时,要转换到该line块里。
  84. (if linflag
  85. (setq pt-tt1  (transnested pt-tt bname 0 2)) ;pt-tt1为下一步,临时转换到块坐标系下的点
  86. (setq pt-tt1 pt-tt)
  87. )
  88.    
  89. (setq pt-temp (vlax-curve-getClosestPointTo obj-line pt-tt1 t))
  90. ;这里得区分linflag=true时,要转换到该line块里。
  91. (and
  92. linflag
  93. (setq pt-temp  (transnested pt-temp bname 2 0))
  94. )

  95. ;(make_line (list pt-tt pt-temp) "0" )
  96. ;(setq pt-temp (inters pt1 pt2 pt-tt (offset_point pt_tt 0 hnu:dimscale ang) nil))

  97. (if ( < (mat:det2v (mat:v-v  pt-tt pt-temp)(mat:v-v  angflag pt-temp)) 0)
  98. (setq flag hnu:dimscale)
  99. (setq flag (- (+ teh hnu:dimscale)))
  100. )

  101. (setq pt-te (offset_point pt-temp  0 flag  ang ))
  102. ;(make_line (list pt-temp pt-te) "0");这里是正确的。如何将pt-te从世界坐标系转到块里。
  103. (setq pt-te (transnested pt-te (last text-e)  0 2))
  104. ;(setq pt-te (trans pt-te 2 test-en  ))
  105. ;对角度进行转化
  106. (setq ang-te(transnested (list (cos ang)(sin ang) 0) (last text-e) 0 2))   
  107. (setq ang-te (angle (transnested (list 0 0 0 ) (last text-e) 0 2) ang-te))
  108. (set-dxf text-en 10  pt-te )
  109. (set-dxf text-en 50 ang-te)
  110. (set-dxf text-en 72 0)
  111. (set-dxf text-en 73 0)   
  112.       
  113.       (setq i -1)
  114.       (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.
  115. ;      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.
  116. ;      所以反转,取最外面的的块名。
  117.       (while (setq s1 (ssname ss (setq i (1+ i))))
  118.       (entupd s1))
  119.       
  120.         
  121.       );cond len 4
  122.       );cond

  123. )
  124. );progn  
  125. );if  
  126. (redraw)
  127. (princ)

  128. );defun

  129. (princ "\nATD  Advanced TD 文字齐线命令加载成功\nDesigned by 林霄云 2014年5月19日")
  130. (princ)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2018-10-28 18:09 | 显示全部楼层
选直线显示有问题,不能选择直线?
发表于 2017-9-26 23:56 | 显示全部楼层
为啥下载不了?我已付了个币的哦
发表于 2014-12-15 07:01 | 显示全部楼层
什么意思...直线和文字都是块??什么情况需要这样对齐....???
 楼主| 发表于 2014-12-15 09:22 | 显示全部楼层
q3_2006 发表于 2014-12-15 07:01
什么意思...直线和文字都是块??什么情况需要这样对齐....???

直线与文字隶属于不同的块(或外部参照),支持块,是免除进入块内操作。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2014-12-15 12:55 | 显示全部楼层
非常厉害,谢谢楼主分享
发表于 2014-12-16 14:17 | 显示全部楼层
刚好试用了一下,还不错,稍微有一点点,就是文字好像会挪动很大的位置,甚至跑到块外面很远的地方,希望能不能增加一个选项,就是文字可以按需要对齐的线的角度在文字自己的字身的形心或者对齐进行相应旋转。文字的位置基本上不变的那种。谢谢哈。
发表于 2014-12-18 21:07 | 显示全部楼层
试了一下,还行,不过只能对齐文字,G版的ALO对齐更实用一些
发表于 2015-5-23 08:46 | 显示全部楼层
新人学习中
发表于 2015-8-8 11:22 | 显示全部楼层
结构的表示很喜欢这个 谢谢了
发表于 2016-6-26 19:03 来自手机 | 显示全部楼层
rhww 发表于 2014-12-15 12:55
非常厉害,谢谢楼主分享

非常厉害,谢谢分享哈哈
发表于 2016-10-14 18:36 | 显示全部楼层
虽然厉害,但是对我来说没啥卵用
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-2-28 14:08 , Processed in 0.171278 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表