设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1714|回复: 4

[源码] API应用 文字移至圆中心

[复制链接]

点击这里给我发消息

已领礼包: 1259个

财富等级: 财源广进

发表于 2013-11-8 23:29:34 | 显示全部楼层 |阅读模式

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

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

x
  1. (defun c:tt (/ ss el)
  2.   (if (progn
  3.         (princ "\nSelect Text and Circle .....")
  4.         (setq ss (ssget '((0 . "text,circle"))))
  5.       )
  6.     (progn
  7.       (setq el        (mapcar
  8.                   '(lambda (x / typ)
  9.                      (if (= (setq typ (xdrx_getpropertyvalue x "IsA"))
  10.                             "AcDbText"
  11.                          )
  12.                        (list (nth 4 (XD::Geom:Box->9pt (XD::Entity:Box x)))
  13.                              (list x typ)
  14.                        )
  15.                        (list (xdrx_getpropertyvalue x "Center") (list x typ))
  16.                      )
  17.                    )
  18.                   (xdrx_pickset->ents ss)
  19.                 )
  20.             el        (XD::List:GroupByIndex el 120.);_误差根据自己图形情况调整
  21.             el        (vl-remove-if '(lambda (x) (= (length x) 2)) el)
  22.             el        (vl-remove-if
  23.                   '(lambda (x)
  24.                      (apply
  25.                        '=
  26.                        (mapcar 'cadr (cdr x))
  27.                      )
  28.                    )
  29.                   el
  30.                 )
  31.             mat        (xdrx_matrix_identity 3)
  32.       )
  33.       (mapcar '(lambda (x)
  34.                  (xdrx_setpropertyvalue
  35.                    (cadr x)
  36.                    "Position"
  37.                    (xdrx_getpropertyvalue (car x) "Center")
  38.                  )
  39.                )
  40.               (mapcar '(lambda (a) (mapcar 'car a))
  41.                       (mapcar
  42.                         '(lambda
  43.                            (c)
  44.                             (vl-sort
  45.                               c
  46.                               '(lambda
  47.                                  (m n)
  48.                                   (< (cadr m) (cadr n))
  49.                                )
  50.                             )
  51.                          )
  52.                         (mapcar
  53.                           'cdr
  54.                           el
  55.                         )
  56.                       )
  57.               )
  58.       )
  59.     )
  60.   )
  61.   (princ)
  62. )
mvtext.gif
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2013-11-9 11:46:22 | 显示全部楼层
  1. ;; 文本移到最近圆心
  2. (defun c:test1411 ()
  3.   (xyp-CMDLA0)
  4.   (if (setq ss (ssget '((0 . "text,CIRCLE"))))
  5.     (progn
  6.       (setq lst        (xyp-Sort-SsDxf ss 0)
  7.             ss1        (xyp-list2ss (cadar lst))
  8.       )
  9.       (foreach s0 (cadadr lst)
  10.         (setq s1 (xyp-EnameClosestToSsel s0 ss1 5))
  11.         (xyp-move s0 (xyp-9pt s0 5) (xyp-9pt s1 5))
  12.       )
  13.     )
  14.   )
  15.   (xyp-CMDLA1)
  16. )

点评

呵呵,院长也来了,用 API 仿写了下院长的函数  详情 回复 发表于 2013-11-9 13:47
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

已领礼包: 1259个

财富等级: 财源广进

 楼主| 发表于 2013-11-9 13:47:33 | 显示全部楼层

呵呵,院长也来了,用 API 仿写了下院长的函数

  1. (defun List2SS (el / ss)
  2.   (setq ss (ssadd))
  3.   (foreach e el
  4.     (ssadd e ss)
  5.   )
  6.   ss
  7. )
  8. (defun sort-ssdxf (ss code / ll l)
  9.   (setq
  10.     lst        (mapcar        '(lambda (x) (list (cdr (assoc code (entget x))) x))
  11.                 (xdrx_pickset->ents ss)
  12.         )
  13.     ll        (list (list (car lst)))
  14.     lst        (cdr lst)
  15.   )
  16.   (while lst
  17.     (if        (setq
  18.           l (vl-remove-if-not '(lambda (x) (= (car x) (caaar ll))) lst)
  19.         )
  20.       (setq ll        (cons (append l (car ll)) (cdr ll))
  21.             lst        (vl-remove-if '(lambda (x) (= (car x) (caaar ll))) lst)
  22.       )
  23.     )
  24.     (setq ll  (cons (list (car lst)) ll)
  25.           lst (cdr lst)
  26.     )
  27.   )
  28.   (mapcar '(lambda (x)
  29.              (cons (caar x) (mapcar 'cadr x))
  30.            )
  31.           (cdr ll)
  32.   )
  33. )
  34. (defun EnameClosestToSsel (e ss n / el p)
  35.   (ssdel e ss)
  36.   (setq        p  (nth n (XD::Geom:Box->9pt (XD::Entity:Box e)))
  37.         el (xdrx_pickset->ents ss)
  38.         el (mapcar
  39.              '(lambda (x)
  40.                 (cons
  41.                   (distance p
  42.                             (nth n (XD::Geom:Box->9pt (XD::Entity:Box x)))
  43.                   )
  44.                   x
  45.                 )
  46.               )
  47.              el
  48.            )
  49.         el (vl-sort el '(lambda (e1 e2) (< (car e1) (car e2))))
  50.   )
  51.   (cdar el)
  52. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 135个

财富等级: 日进斗金

发表于 2020-5-6 22:06:30 | 显示全部楼层
这个程序怎么运行不了呢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2020-5-13 17:46:54 | 显示全部楼层
本帖最后由 trrt6767 于 2020-5-13 17:49 编辑

15884793855eae45992f714.png

15884795005eae460ccb4f6.png

15884794485eae45d8792ae.png

15884796395eae46977f54b.png



15884797785eae47222ea84.png

15884798875eae478f41081.png
15884800555eae48379a95c.png


15884801275eae487f55865.png


15884801885eae48bc2f198.png


15884802425eae48f263498.png

15884802845eae491d03552.png

















论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2020-10-21 13:13 , Processed in 0.200547 second(s), 50 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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