找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

楼主: cz7873559

[已解决] 获取字符串坐标并画线

[复制链接]
 楼主| 发表于 2013-6-8 22:49:13 | 显示全部楼层

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

使用道具 举报

发表于 2013-6-9 08:05:04 | 显示全部楼层
ll_j 发表于 2013-6-8 13:07
好不容易找到以前的帖子:http://bbs.mjtd.com/thread-99199-1-1.html
在11楼有我的回复,当时感觉是这 ...

这样解决下[pcode=lisp,true]
(defun c:tt (/ doc ms ss ll clyr)
  (vl-load-com)
  (setq doc  (vla-get-activedocument (vlax-get-acad-object))
ms   (vla-get-modelspace doc)
clyr (getvar "clayer")
  )
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "Text"))))
    (vl-catch-all-apply
      (function
(lambda (/ sl i e el str p)
   (if (not (tblsearch "layer" "xt"))
     (vl-cmdf ".layer" "m" "Xt" "c" "3" "" "")
   )
   (setq sl (sslength ss)
  i  -1
   )
   (repeat sl
     (setq e   (ssname ss (setq i (1+ i)))
    el  (entget e)
    str (strcat "f"
         (vl-string-translate
    " "
    "F"
    (vl-string-trim
      "(,)"
      (vl-princ-to-string
        (vl-string->list (cdr (assoc 1 el)))
      )
    )
         )
        )
    p   (cdr (assoc 10 el))
    p   (list (car p) (cadr p))
     )
     (set (read str) (cons (list p el) (eval (read str))))
     (if (vl-position str ll)
       nil
       (setq ll (cons str ll))
     )
   )
   (mapcar '(lambda (x / l pl)
       (setq l
       (apply
         'append
         (vl-sort
    (mapcar 'car x)
    '(lambda (e1 e2)
       (if
         (equal (car e1) (car e2) 1e-3)
          (< (cadr e1) (cadr e2))
          (< (car e1) (car e2))
       )
     )
         )
       )
       )
       (mapcar '(lambda (y)
    (entmod (append y '((62 . 3))))
         )
        (mapcar 'cadr x)
       )
       (setq
         pl (vla-addlightweightpolyline
       ms
       (vlax-make-variant
         (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbdouble
      (cons 0 (1- (length l)))
    )
    l
         )
       )
     )
       )
       (vla-put-layer pl "xt")
       ;(vla-put-color pl acred)
     )
    (vl-remove-if
      '(lambda (x) (= (length x) 1))
      (mapcar 'eval (mapcar 'read ll))
    )
   )
)
      )
    )
  )
  (vla-endundomark doc)
  (setvar "clayer" clyr)
  (if ll
    (mapcar '(lambda (x) (set (read x) nil)) ll)
  )
  (vlax-release-object doc)
  (vlax-release-object ms)
  (princ)
)[/pcode]
将汉字转化为 List ,然后组合为数字的字串,当然这个字串长度受限制,按这个计算最多 255/4 ,60个汉字达到最大,不过这个应用够了
[pcode=lisp,true]
(strcat "f"
(vl-string-translate
   " "
   "F"
   (vl-string-trim
     "(,)"
     (vl-princ-to-string
       (vl-string->list (cdr (assoc 1 el)))
     )
   )
)
)[/pcode]

点评

接着来个复杂的 这个哪位高手能写个LISP 选择作为画线基点的文字(可以单选,可以框选) 然后框选图纸 框选范围内和基点文字相同的由基点文字逐个爆炸式的画直线连接定位查找 可撤销查找线 来张例图 表里的为母  详情 回复 发表于 2013-9-20 16:38
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

已领礼包: 163个

财富等级: 日进斗金

发表于 2013-9-20 16:38:26 | 显示全部楼层
Free-Lancer 发表于 2013-6-9 08:05
这样解决下
(defun c:tt (/ doc ms ss ll clyr)
  (vl-load-com)

接着来个复杂的 这个哪位高手能写个LISP  选择作为画线基点的文字(可以单选,可以框选) 然后框选图纸 框选范围内和基点文字相同的由基点文字逐个爆炸式的画直线连接定位查找  可撤销查找线      来张例图  表里的为母体文字  框选图中相同的连线)
框选图形 N个相同的和母体中的连线定位.jpg

点评

未经测试!  详情 回复 发表于 2013-9-20 19:51
你单独发个申请的帖子吧,另外,把测试用的DWG也传上来。  详情 回复 发表于 2013-9-20 16:50
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 145个

财富等级: 日进斗金

发表于 2013-9-20 16:50:09 | 显示全部楼层
西楚河神 发表于 2013-9-20 16:38
接着来个复杂的 这个哪位高手能写个LISP  选择作为画线基点的文字(可以单选,可以框选) 然后框选图纸 框选 ...

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

使用道具 举报

发表于 2013-9-20 19:51:57 | 显示全部楼层
本帖最后由 Free-Lancer 于 2013-9-21 09:26 编辑
西楚河神 发表于 2013-9-20 16:38
接着来个复杂的 这个哪位高手能写个LISP  选择作为画线基点的文字(可以单选,可以框选) 然后框选图纸 框选 ...

未经测试!
  1. (defun XD::List:SameIndex (lst / ll nl)
  2.   (foreach x lst
  3.     (if    ll
  4.       (if (setq nl (assoc (setq index (car x)) ll))
  5.     (setq ll (subst    (cons index (append (cdr nl) (cdr x)))
  6.             nl
  7.             ll
  8.          )
  9.     )
  10.     (setq ll (cons x ll))
  11.       )
  12.       (setq ll (list x))
  13.     )
  14.   )
  15.   ll
  16. )
  17. (defun c:tt (/ s1 s2 gettl sl tl ttl l1 e1 el ln)
  18.   (defun Gettl (ss / e lst)
  19.     (xdrx_setsstodb ss 0)
  20.     (while (setq e (xdrx_getentdata 0))
  21.       (setq lst (cons (list (xdrx_getentdxf 1) e) lst))
  22.     )
  23.     lst
  24.   )
  25.   (if (and (progn
  26.          (princ "\n选择源文字....")
  27.          (setq s1 (ssget '((0 . "Text"))))
  28.        )
  29.        (progn
  30.          (princ "\n选择目标文字....")
  31.          (setq s2 (ssget '((0 . "text"))))
  32.        )
  33.       )
  34.     (progn
  35.       (setq sl    (gettl s1)
  36.         tl    (gettl s2)
  37.         ttl    (xd::list:sameindex tl)
  38.       )
  39.       (foreach x sl
  40.     (if (setq l1 (assoc (car x) ttl))
  41.       (progn
  42.         (setq e1 (cadr x)
  43.           el (cdr l1)
  44.         )
  45.         (foreach y el
  46.          (setq ln (xdrx_line_make
  47.         (trans (xdrx_getpropertyvalue e1 "Position") e1 0)
  48.         (trans (xdrx_getpropertyvalue y "Position") y 0)
  49.           ))
  50.          (xdrx_entity_setcolor ln 3)
  51.         )
  52.       )
  53.     )
  54.       )
  55.     )
  56.   )
  57.   (princ)
  58. )


点评

我试了下 选择完源文字 再框选选不到同源文字相同的文字 也画不上线 (目标文字是把相同图层的文字全选上了)  详情 回复 发表于 2013-9-20 21:43
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 163个

财富等级: 日进斗金

发表于 2013-9-20 21:43:39 | 显示全部楼层

我试了下  选择完源文字  再框选选不到同源文字相同的文字  也画不上线  (目标文字是把相同图层的文字全选上了)

点评

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

使用道具 举报

发表于 2013-9-20 21:51:49 | 显示全部楼层
西楚河神 发表于 2013-9-20 21:43
我试了下  选择完源文字  再框选选不到同源文字相同的文字  也画不上线  (目标文字是把相同图层的文字全 ...

新开个主题,把测试 DWG 附上!

点评

http://bbs.xdcad.net/thread-670698-1-1.html 已经新开了个  详情 回复 发表于 2013-9-20 22:11
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 163个

财富等级: 日进斗金

发表于 2013-9-20 22:11:45 | 显示全部楼层
Free-Lancer 发表于 2013-9-20 21:51
新开个主题,把测试 DWG 附上!

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

使用道具 举报

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

发表于 2018-6-6 13:05:34 | 显示全部楼层
给你用另一种办法做了一个,共参考。(defun c:tt (/ ss1 ss2 gettl lst1 lst2 aa a b ln)
        (defun Gettl (ss / x)
                    (mapcar
                        '(lambda(x)
                                (list (XD::Obj:DXF x 1) x)
                        )
                        (xdrx_pickset->ents ss)
                )
        )
          (if (and (setq ss1 (xd::ssget "\n选择源文字....<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*")))))
                         (setq ss2 (xd::ssget "\n选择目标文字....<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*")))))
                  )
                    (progn
                        (xdrx_begin)
                             (xdrx_sysvar_push '("osmode" 0 "cmdecho" 0))
                              (setq lst1 (gettl ss1)
                                lst2 (gettl ss2)
                              )
                        (mapcar
                                '(lambda(x)
                                        (if (setq aa (assoc (car x) lst2))
                                                (progn
                                                        (setq a (cadr aa))
                                                        (setq b (cadr x))
                                                        (setq ln (xdrx_line_make
                                                                        (trans (xdrx_getpropertyvalue a "Position") a 0)
                                                                        (trans (xdrx_getpropertyvalue b "Position") b 0)
                                                                  )
                                                        )
                                                         (xdrx_entity_setcolor ln 3);;;注:1-红,2-黄,3-绿,4-青,5-蓝,6-洋红,7-白,自己修改。
                                                )
                                        )
                                )
                                lst1
                        )
                        (xdrx_sysvar_pop)
                        (xdrx_end)       
                )
        )
        (princ)
)


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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

发表于 2018-6-6 13:09:22 | 显示全部楼层
为明确选择目标,(and (setq ss1 (xd::ssget "\n选择源文字....<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*")))))
                         (setq ss2 (xd::ssget "\n选择目标文字....<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*"))))))修改为:(and (setq ss1 (xd::ssget "\n选择平面图文字<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*")))))
                         (setq ss2 (xd::ssget "\n选择表格文字<右键退出>:" '(":L" ((0 . "Text")(1 . "*L*"))))))
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 23:40 , Processed in 0.221483 second(s), 51 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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