[原创]：c:txtal 文本对齐曲线切线方向

梦断江南

问题的提出:
http://www.xdcad.net/forum/showthread.php?s=&threadid=270041
解决方案:
1.支持所有对齐类型的文本(text).支持多选.
2.参照实体支持所有曲线,方向取点取处的切线方向.
3.支持wcs,ucs坐标系.
4.文本自动调整角度适合观看习惯.
[php]
;; c:txtal  c:txtal  文本对齐曲线切线方向-------------梦断江南.2004.10
(defun c:txtal  (/ el ang ss i e obj p1 p2)
  (vl-cmdf ".undo" "be")
  (while (not(and (setq el (entsel "\n请选择曲线实体:"))(iscurve (car el))))
    (princ "\n不是曲线实体!")
  )
  (setq ang (getang el))
  (princ "\n选择要对齐的文字实体:")
  (setq ss (ssget '((0 . "TEXT")))
        i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (setq obj (x2o e))
    (if        (member (vlax-get obj 'Alignment) '(3 5));;(acAlignmentAligned acAlignmentFit)
      (progn
        (setq p1 (vlax-get obj 'InsertionPoint)
              p2 (vlax-get obj 'TextAlignmentPoint))
        (vlax-put obj 'TextAlignmentPoint (polar p1 ang (distance p1 p2))))
      (vlax-put obj 'rotation ang)
    )
  )
  (vl-cmdf ".undo" "e")
  (princ)
)

;;取得曲线切线方向.
(defun getang (el / e fd ang)
  (setq e   (car el)
        fd  (vlax-curve-getFirstDeriv e (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (cadr el))))
        ang (angle '(0. 0. 0.)fd)
        ang (if (and (< (* 0.5 PI) ang )(>= (* 1.5 PI) ang ))(+ PI ang)ang))
)
;;判断实体是否是曲线.
(defun iscurve (e)
  (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list (x2o e)))))
)
;;
(defun x2o (e)
  (vlax-ename->vla-object e)
)
[/php]
演示:


[swf w=750 h=550]http://www.xdcad.net/article/upload/file/291_20041010022529_txtal.swf[/swf]

andyhua5240

试用了一下，程序非常的好，有个小问题：
输入txtal后，什么也不选，想退出，这时退出不了，空格、右键、回车，都不行，只能按esc强行退出。程序报错。建议，直接退出后，程序不要报错，用户用程序没有达到预期的效果，用户自己知道出错了的，我认为不需要报错，碍眼！
谢谢！

eachy

把 entsel  改成 nentsel 增加一些情况吧

liuyj

是啊，应该对块中和外部参照中的曲线以及hatch都能操作。

梦断江南

楼上的,对hatch想怎么操作?
根据大家的意见修改如下

版本v1.1: 名称改为"txtal = 文本对齐参照"
选参照实体改为nentsel,可右键退出.
增加支持参照实体:曲线,MTEXT,TEXT,ATTRIB,ATTDEF
对齐实体支持: TEXT,MTEXT,ATTRIB,ATTDEF,SHAPE.
(其实本程序的框架支持的实体不止是这些,可以是Attribute, AttributeReference, BlockRef, Dim3PointAngular, DimAligned, DimAngular, DimDiametric, DimOrdinate, DimRadial, DimRotated, ExternalReference, MInsertBlock, MText, Raster, Shape, Text
等具有rotation属性的实体,但鉴于程序的针对性,和可操作性,仅仅支持目前的实体,有特别需要的,可以在程序的实体过滤里面自己加上 )  
第一贴的程序开放,免币下载.

后话: 至于aeo提出的对曲线,文字跟着曲线走.是可以做到的.
但我觉得功能适用有所差别,因此拟在另外的程序里面完成.
文本附着曲线程序(文字移动到曲线上):
方法是,
1.文本单字列表, 另需要一个文本到曲线的距离.
2.在曲线上取两点间的区域.(默认start ->end),按文本长度求各个定位点的切线or法线方向.
3.打散文本为多个文字,或求出定位点后写新文本.
文本模拟曲线
方法:
原理参上,只是文字(第一个)不移动,后面的文字跟着曲线的趋势弯曲排列.[/COLOR]

梦断江南

程序文本:[php]
;| txtal = 文本对齐参照-----------------------ok!!!-----梦断江南.2004.10
版本v1.1: 选参照实体改为nentsel,可右键退出.增加支持参照实体:曲线,MTEXT,TEXT,ATTRIB,ATTDEF,SHAPE
          对齐实体支持: TEXT,MTEXT,ATTRIB,ATTDEF,SHAPE.
|;
(defun c:txtal  (/ roop el hasrt ang ss i e obj al p1 p2)
  (vl-cmdf ".undo" "be")
  (setq roop T)
  (while roop
    (setq el (nentsel "\n请选择对齐参照实体:曲线,MTEXT,TEXT,ATTRIB,ATTDEF.<右键退出>:"))
    (cond
      ((and el
            (or (iscurve (car el))
                (setq hasrt (wcmatch (cdr(assoc 0 (entget (car el)))) "*TEXT,ATT*,SHAPE"))
            )
        )
        (princ "\n选择要对齐的文字实体:")
        (setq ss (ssget '((0 . "*TEXT,ATTRIB,ATTDEF,SHAPE")))
              roop nil))
      ((and (null el)(= 52 (getvar "errno"))) (setq roop nil))
      (T (princ "\n没有选中有效实体!"))
    ) ;;直到选中符合的曲线实体.或右键退出.
  )
  (if (and el ss)
    (progn
      (setq ang        (getang el);;求曲线切线角度.
            i        -1)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq obj (x2o e))
        (if (and
              (not(vl-catch-all-error-p(setq al (vl-catch-all-apply 'vlax-get (list obj 'Alignment))))) ;;区别MTEXT.
              (member al '(3 5));;相当于(acAlignmentAligned acAlignmentFit)
            )
          (progn
            (setq p1 (vlax-get obj 'InsertionPoint)
                  p2 (vlax-get obj 'TextAlignmentPoint)
            )
            (vlax-put obj 'TextAlignmentPoint (polar p1 ang (distance p1 p2)))
          )
          (vlax-put obj 'rotation ang)
        )
      )
    )
  )
  (vl-cmdf ".undo" "e")
  (princ)
)

;;取得曲线切线方向,或实体的rotation属性角度.自动更改角度为符合观看的角度.
(defun getang (el / e fd ang);;hasrt 外部参数.
  (setq e   (car el))
  (if hasrt
    (setq ang (vlax-get (x2o e) 'rotation))
    (setq fd  (vlax-curve-getFirstDeriv e (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e (cadr el))))
          ang (angle '(0. 0. 0.)fd))
  )
  (setq ang (if (and (< (* 0.5 PI) ang )(>= (* 1.5 PI) ang ))(+ PI ang)ang))
)
;;判断实体是否是曲线.
(defun iscurve (e)
  (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list (x2o e)))))
)
;;
(defun x2o (e)
  (vlax-ename->vla-object e)
) [/php]

andyhua5240

超强呀，巨好使！
谢谢！