哪位有：文字齐线中点工具，谢谢

sixthsixth · 发表于 2013-9-30 17:23:28

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 sixthsixth 于 2013-9-30 22:15 编辑

哪位有：文字齐线中点工具，谢谢

我想把文字中点移到附近红色直线的中点，能不能实现这个功能呢，要能批量选择，批量移动，谢谢图纸如下：

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:文字齐线中点.dwg.rar
下载次数:17 文件大小:12.16 KB
下载权限: 不限以上 [免费赚D豆]

newer · 发表于 2013-10-1 15:09:48

本帖最后由 newer 于 2013-10-1 15:13 编辑

sixthsixth 发表于 2013-10-1 14:39
我是个菜鸟，上面两位老大的回复，我看不太懂耶，单独lisp能不能解决呢

去下载 XDRX API 和晓东通用LISP函数库，加载它们，然后执行下面测试代码，你不小心写歪的文字也能帮你调正：
代码里面设定了红色线在TEXT图层。

(defun c:tt ( / box dest e ept height mat mid ml p1 p2 position spt ss ss1 vec)
(if (setq ss (ssget '((0 . "text"))))
(progn
(XD::Begin)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq box (XD::Entity:BoxAtEcs e e)
box (XD::Geom:Box->9PT box)
position (nth 1 box)
p1 (nth 0 box)
p2 (nth 2 box)
height (xdrx_getpropertyvalue e "Height")
ss1 (xdrx_pickset_GetAtPoint position height 2 '((0 . "LINE") (8 . "TEXT")
(62 . 1)
)
)
)
(if ss1
(progn
(setq mL (xdrx_getentdata 2)
mid (xdrx_getpropertyvalue mL "MidPoint")
sPt (xdrx_getpropertyvalue mL "StartPoint")
ePt (xdrx_getpropertyvalue mL "EndPoint")
dest (list sPt ePt)
vec (mapcar
'-
ePt
sPt
)
dest (if (or (minusp (car vec))(minusp (cadr vec)))
(reverse dest)
dest
)
mat (XD::Matrix:Align position position mid p2 (cadr dest))
)
(xdrx_entity_transform e mat)
)
)
)
(XD::End)
)
)
(princ)
)

(defun c:tt ( / box dest e ept height mat mid ml p1 p2 position spt ss ss1 vec) 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (XD::Begin) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq box (XD::Entity:BoxAtEcs e e) 
              box (XD::Geom:Box->9PT box) 
              position (nth 1 box) 
              p1 (nth 0 box) 
              p2 (nth 2 box) 
              height (xdrx_getpropertyvalue e "Height") 
              ss1 (xdrx_pickset_GetAtPoint position height 2 '((0 . "LINE") (8 . "TEXT") 
                                            (62 . 1) 
                                           ) 
                  ) 
        ) 
        (if ss1 
          (progn 
            (setq mL (xdrx_getentdata 2) 
                  mid (xdrx_getpropertyvalue mL "MidPoint") 
                  sPt (xdrx_getpropertyvalue mL "StartPoint") 
                  ePt (xdrx_getpropertyvalue mL "EndPoint") 
                  dest (list sPt ePt) 
                  vec (mapcar 
                        '- 
                        ePt 
                        sPt 
                      ) 
                  dest (if (or (minusp (car vec))(minusp (cadr vec))) 
                         (reverse dest) 
                         dest 
                       ) 
                  mat (XD::Matrix:Align position position mid p2 (cadr dest)) 
            ) 
            (xdrx_entity_transform e mat) 
          ) 
        ) 
      ) 
      (XD::End) 
    ) 
  ) 
  (princ) 
)

通用LISP函数库里面的对齐函数，帮你贴下

;|
构造对齐矩阵
参数：
pj ---- 基点
ps1---- 源点1
ps2---- 源点2
pd1---- 目标点1
pd2---- 目标点2
返回值：矩阵
|;
(defun XD::MATRIX:ALIGN (pj ps1 pd1 ps2 pd2 / fromx fromy from tox toy to
mMat
)
(setq fromx (xdrx_vector_normalize (mapcar
'-
(trans ps2 1 0)
(trans ps1 1 0)
)
)
fromy (xdrx_vector_perpvector fromx)
fromz (xdrx_vector_crossproduct fromx fromy)
from (list (trans pj 1 0) fromx fromy fromz)
tox (xdrx_vector_normalize (mapcar
'-
(trans pd2 1 0)
(trans pd1 1 0)
)
)
toy (xdrx_vector_perpvector tox)
toz (xdrx_vector_crossproduct tox toy)
to (list (trans pd1 1 0) tox toy toz)
mMat (xdrx_matrix_aligncoordsystem from to)
)
mMat
)

;| 
构造对齐矩阵 
参数： 
   pj ---- 基点 
   ps1---- 源点1 
   ps2---- 源点2 
   pd1---- 目标点1 
   pd2---- 目标点2 
 
返回值：矩阵 
|; 
(defun XD::MATRIX:ALIGN (pj ps1 pd1 ps2 pd2 / fromx fromy from tox toy to 
                               mMat 
                           ) 
  (setq fromx (xdrx_vector_normalize (mapcar 
                                       '- 
                                       (trans ps2 1 0) 
                                       (trans ps1 1 0) 
                                     ) 
              ) 
        fromy (xdrx_vector_perpvector fromx) 
        fromz (xdrx_vector_crossproduct fromx fromy) 
        from (list (trans pj 1 0) fromx fromy fromz) 
        tox (xdrx_vector_normalize (mapcar 
                                     '- 
                                     (trans pd2 1 0) 
                                     (trans pd1 1 0) 
                                   ) 
            ) 
        toy (xdrx_vector_perpvector tox) 
        toz (xdrx_vector_crossproduct tox toy) 
        to (list (trans pd1 1 0) tox toy toz) 
        mMat (xdrx_matrix_aligncoordsystem from to) 
  ) 
  mMat 
)

st788796 · 发表于 2013-9-30 17:29:29

本帖最后由 st788796 于 2013-9-30 17:30 编辑

线和文字排行列，就近移动，靠的太近可能不好办

sixthsixth · 发表于 2013-9-30 18:01:34

能不能多提示下啊，这个我没思路

newer · 发表于 2013-9-30 19:57:22

sixthsixth 发表于 2013-9-30 18:01
能不能多提示下啊，这个我没思路

你把结果图在贴个上来。

要批量，就必须文字和那个红色的线有关联，比如指定层或者其他，你有什么规则吗？如果没规则，那文字边上要是有好几条红色的线，你对齐哪个？

21cn · 发表于 2013-10-1 06:08:23

sixthsixth 发表于 2013-9-30 18:01
能不能多提示下啊，这个我没思路

线一个集合，文字一个集合
遍历文字，找出线集中离文字最近的，移动文字

st788796 · 发表于 2013-10-1 11:39:53

本帖最后由 st788796 于 2013-10-1 11:43 编辑

sixthsixth 发表于 2013-9-30 18:01
能不能多提示下啊，这个我没思路

给你提供个思路，为了写起来顺手用了 API 2011 以上的 getpropertyvalue 函数，不过参照这些你可以用 alisp 写
对齐计算还不是很好，自行修改

(defun c:tt (/ ss e typ box vx an inspt tl ll lst mat)
(if (setq ss (ssget '((0 . "text,line"))))
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq typ (xdrx_getentdxf 0))
(if (= typ "TEXT")
(progn
(setq el (entget e))
(setq box (textbox (list (assoc 1 el) (assoc 40 el) (assoc 7 el)) ;_ 相对于 0 0 0 的Box
)
vx (- (caadr box) (caar box))
an (xdrx_getentdxf 50)
inspt (xdrx_getentdxf 10)
)
(setq tl
(cons
(list (mapcar '+ (polar '(0. 0. 0.) an vx) inspt) e) ;_文字底中点
tl
)
)
)
(setq ll (cons (list (cadr (xdrx_curve_getpoint e)) e) ll)) ;_((线1中点线1) (线2中点线2) ...)
)
) ;_end while
(setq mat (xdrx_matrix_identity 3))
(foreach txt tl
(setq
lst (vl-remove-if-not
'(lambda (x)
(equal
(getpropertyvalue (cadr txt) "Rotation")
(rem
(getpropertyvalue (cadr x) "Angle")
pi
)
0.0001 ;_误差角度
)
)
ll
)
) ;_过滤出和文字角度相同的线
(if lst
(progn
(setq lst (vl-sort lst
'(lambda (l1 l2) ;_ 按远近排序
(< (distance (car txt) (car l1))
(distance (car txt) (car l2))
)
)
)
)
(xdrx_entity_transform;_可以用 vl-move
(cadr txt)
(xdrx_matrix_settranslation
mat
(mapcar '- (caar lst) (car txt))
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss e typ box vx an inspt tl ll lst mat) 
  (if (setq ss (ssget '((0 . "text,line")))) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
 (setq typ (xdrx_getentdxf 0)) 
 (if (= typ "TEXT") 
   (progn 
     (setq el (entget e)) 
     (setq box (textbox (list (assoc 1 el) (assoc 40 el) (assoc 7 el)) ;_ 相对于 0 0 0 的Box 
   ) 
    vx (- (caadr box) (caar box)) 
    an (xdrx_getentdxf 50) 
    inspt (xdrx_getentdxf 10) 
     ) 
     (setq tl 
     (cons 
       (list (mapcar '+ (polar '(0. 0. 0.) an vx) inspt) e) ;_文字底中点 
       tl 
     ) 
     ) 
   ) 
   (setq ll (cons (list (cadr (xdrx_curve_getpoint e)) e) ll)) ;_((线1中点 线1) (线2中点 线2) ...) 
 ) 
      ) ;_end while 
      (setq mat (xdrx_matrix_identity 3)) 
      (foreach txt tl 
 (setq 
   lst (vl-remove-if-not 
  '(lambda (x) 
     (equal 
       (getpropertyvalue (cadr txt) "Rotation") 
       (rem 
         (getpropertyvalue (cadr x) "Angle") 
         pi 
       ) 
       0.0001 ;_误差角度 
     ) 
   ) 
  ll 
       ) 
 ) ;_过滤出和文字角度相同的线 
 (if lst 
   (progn 
     (setq lst (vl-sort lst 
          '(lambda (l1 l2) ;_ 按远近排序 
      (< (distance (car txt) (car l1)) 
         (distance (car txt) (car l2)) 
      ) 
    ) 
        ) 
     ) 
     (xdrx_entity_transform;_可以用 vl-move 
       (cadr txt) 
       (xdrx_matrix_settranslation 
  mat 
  (mapcar '- (caar lst) (car txt)) 
       ) 
     ) 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2013-10-1 12:27:10

st788796 发表于 2013-10-1 11:39
给你提供个思路，为了写起来顺手用了 API 2011 以上的 getpropertyvalue 函数，不过参照这些你可以用 ali ...

这个用API的对齐方面的函数，代码能更短，而且更通用，不平行线的文字也能给调整齐了。LISP通用函数库里面都有相关的函数。

Free-Lancer · 发表于 2013-10-1 12:49:41

本帖最后由 Free-Lancer 于 2013-10-1 13:20 编辑

newer 发表于 2013-10-1 12:27
这个用API的对齐方面的函数，代码能更短，而且更通用，不平行线的文字也能给调整齐了。LISP通用函数库里 ...

长的部分代码都在库里了:)
对line API函数xdrx_getpropertyvalue 没有 angle 属性？
利用xd-lisp-lib 库，求text 的底边线，与line构造对齐矩阵，排序部分没有其它简化，就是过滤表根据需要改造以提高准确性和效率

XDSoft · 发表于 2013-10-1 13:21:56

Free-Lancer 发表于 2013-10-1 12:49
长的部分代码都在库里了
对line xdrx_getpropertyvalue 没有 angle 属性
利用xd-lisp-lib 库，求te ...

angle 属性下版本加上。

构造选择集，可以用过一点的API选择集函数构造，拾取框半宽可以用文字的高度，选择到的红线根据文字特征点排下序，找到最近的红线,然后文字的9PT的中下点和线的中点对齐。

构造通过一点的符合过滤要求的实体选择集
调用格式：	(xdrx_pickset_getAtPoint <pt> [提示字符串] [拾取窗半宽] [层名] [内部数据库选择集编号][过滤表])
返回值：	选择集
说明：	1.层名: 可以写作 "abc", "a", "a??", "" 等, 省略层名等价于 "*"。 2.内部数据库选择集编号: 该参数为 1 - 10, 将取得的选择集存入xdrx内部数据库中的 ARX 变量, 并将 (ssname) 当前实体指针 i 置 0。 3.过滤表为LISP中的过滤表，如'((8 . "abc")(0 . "line")....),也支持AND,OR,NOT等 4.若过滤表中提供层组码8，则前面的“层名”选项不起作用。

XDSoft · 发表于 2013-10-1 13:40:20

(xdrx_getpropertyvalue (car (entsel)))

选择对象:
Class AcDbLine:

├─Angle
├─Thickness
├─Normal

Class AcDbCurve:

├─Area
├─EndParam
├─EndPoint
├─IsClosed
├─IsPeriodic
├─MidPoint
├─StartPoint
├─StartParam
├─Length

Class AcDbEntity:

├─BoundingBox
├─Color
├─ECS
├─Layer
├─Linetype
├─LinetypeScale
├─LineWeight
├─PlotStyleName
├─StretchPoint
├─Visibility

Class AcDbObject:

├─ClassName
├─ExtensionDictionary
├─FieldDictionary
├─IsA
├─IsAProxy
├─IsErased
├─IsReallyClosing
├─Handle
├─HasFields
├─MyParent
├─ObjectID
├─Owner

Free-Lancer · 发表于 2013-10-1 13:45:13

本帖最后由 Free-Lancer 于 2013-10-1 13:49 编辑

这次全了，Angle Length可以直接获取会方便很多应用
依每个text构造选集可以减少line选集长度，排序效率就可提高，程序效率自然也高了

sixthsixth · 发表于 2013-10-1 14:39:21

我是个菜鸟，上面两位老大的回复，我看不太懂耶，单独lisp能不能解决呢

q3_2006 · 发表于 2013-10-1 16:04:57

newer 发表于 2013-10-1 15:09
去下载 XDRX API 和晓东通用LISP函数库，加载它们，然后执行下面测试代码，你不小心写歪的文字也能帮你调 ...

2010 用楼主的图测试程序，没有任何反应。。

st788796 · 发表于 2013-10-1 16:27:28

缺少一个间隙，需要加载 xdapi + xd-lisp-lib.vlx

账号		自动登录	找回密码
密码			立即注册

[求助] 哪位有：文字齐线中点工具，谢谢

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评

点评

[求助] 哪位有：文字齐线中点 工具，谢谢

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评

点评

[求助] 哪位有：文字齐线中点工具，谢谢