寻求相同文字内容关联程序！！！ - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第5页

lingduwx 发表于 2012-7-27 13:20:40

Gu_xl 发表于 2012-7-27 09:35 static/image/common/back.gif

G版出手就是不一样啊，
不过小弟现在发现一个小问题，就是再次用此命令选择已关联字体时，CAD出现错误后关闭，
另外一个问题就是再次复制关联的文字时，偶想要默认是关联的，但是也可以输入N不关联，望G版解决一下，谢谢

lijiao 发表于 2012-7-27 13:39:46

;;;;我也写了一个，添加关联用addgl，删除关联用delgl，显示关联用xsgl，复制文本不能产生关联。
我用的是命令反应器，只有一个反应器，不会使CAD崩溃。
ddedit命令结束时触发反应器。

(vl-load-com)
(if (not txt_gl)
(setq txt_gl (VLR-Command-Reactor
      nil
      '((:VLR-commandEnded . GL-CALL))
   )
)
)
;;;*********************************************************
(defun c:addgl ( / GLEDS GLS HANDS NEW_GL SS X txt)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
   (setq ss (OSS->VL-LIST ss))
   (setq hands (mapcar 'vla-get-handle ss))
   (setq gls (FENXI-GL hands))
   (if gls
(progn
   (setq gleds (vlax-ldata-list "CS_GUANLIAN"))
   (mapcar '(lambda (x)
      (vlax-ldata-delete "CS_GUANLIAN" x)
   )
   gls
   )
;;;删除旧的关联
   (setq new_gl (mapcar '(lambda (x / tmp)
   (cdr (assoc x gleds))
)
      gls
      )
   )
   (setq new_gl (mapcar '(lambda (x)
   (mapcar 'car x)
)
      new_gl
      )
   )
   (setq new_gl (apply 'append new_gl))
   (setq new_gl (append new_gl hands))
   (setq new_gl (remove-same new_gl))
)
(setq new_gl hands)
   )
   (setq txt (get-txt (car new_gl)))
   (mapcar '(lambda(x) (put-txt x txt)) new_gl)
   (put-gl new_gl)
   (princ "\n关联已经建立。")
)
)
(princ)
)
;;;***********************************************************
(defun c:delgl (/ GLEDS GLS HANDS NEW_GL SS X)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
   (setq ss (OSS->VL-LIST ss))
   (setq hands (mapcar 'vla-get-handle ss))
   (setq gls (FENXI-GL hands))
   (if gls
(progn
   (setq gleds (vlax-ldata-list "CS_GUANLIAN"))
   (mapcar '(lambda (x)
      (vlax-ldata-delete "CS_GUANLIAN" x)
   )
   gls
   )
;;;删除旧的关联
   (setq new_gl (mapcar '(lambda (x / tmp)
   (cdr (assoc x gleds))
)
      gls
      )
   )
   (setq new_gl (mapcar '(lambda (x)
   (mapcar 'car x)
)
      new_gl
      )
   )
   (setq new_gl (apply 'append new_gl))
   (foreach item hands
   (setq new_gl (vl-remove item new_gl))
   )
   (if (> (length new_gl) 1)
   (put-gl new_gl)
   )
   (princ "\n关联已经解除。")
)
   )
)
)
(princ)
)
;;;*********************************************************
(defun c:xsgl ( / ENT ENTS GLEDS HAND HANDS X)
(if (setq ent (car (entsel)))
(progn
   (setq ent (vlax-ename->vla-object ent))
   (setq hand (vla-get-handle ent))
   (setq gleds (vlax-ldata-list "CS_GUANLIAN"))
   (setq gleds (mapcar '(lambda (x)
   (mapcar 'car (cdr x))
)
      gleds
      )
   )
   (setq gleds (vl-remove nil (mapcar '(lambda(x) (if (member hand x) x)) gleds)))
   (if gleds
(progn
   (setq hands (car gleds))
   (setq ents (vl-remove nil (mapcar 'handent hands)))
   (setq ents (mapcar 'vlax-ename->vla-object ents))
   (mapcar '(lambda(x) (vla-Highlight x :vlax-true)) ents)
   )
)
   )
)
(princ)
)
;;;**************************************************************
(defun gl-call (aaa bbb / BJ_JG GLEDS GLS HANDS KEY OLD_GL TMP X Y)
(if (= "DDEDIT" (strcase (car bbb)))
(progn
   (setq gleds (vlax-ldata-list "CS_GUANLIAN"))
   (setq hands (mapcar '(lambda (x)
      (cons (car x) (mapcar 'car (cdr x)))
   )
   gleds
   )
   )
   (setq
gls (mapcar
      '(lambda (x)
(cons (car x)
      (vl-remove nil
   (mapcar
   '(lambda (y)
      (if (setq tmp (get-txt y))
(cons y tmp)
      )
      )
   (cdr x)
   )
      )
)
      )
      hands
   )
   )
   (foreach item gls
(setq key(car item)
      item (cdr item)
)
(setq old_gl (cdr (assoc key gleds)))
(setq tmp
      (vl-remove
nil
(mapcar '(lambda (x)
   (if (/= (cdr x) (cdr (assoc (car x) old_gl)))
      (cdr x)
   )
   )
item
)
      )
)
(if tmp
   (progn
   (vlax-ldata-delete "CS_GUANLIAN" key)
   (setq bj_jg (last tmp))
   (setq item (mapcar '(lambda (x)
   (put-txt (car x) bj_jg)
   (car x)
)
      item
      )
   )
   (put-gl item)
   )
)
   )
)
)
(princ)
)

;;;*********************************************************
(defun oss->vl-list (ss / I OUT TMP)
(setq i -1
out '()
)
(repeat (sslength ss)
(setq tmp (ssname ss (setq i (1+ i))))
(setq tmp (vlax-ename->vla-object tmp))
(setq out (cons tmp out))
)
(reverse out)
)

;;;*********************************************************
(defun put-gl (lst / GL_DATA KEY TMP X)
(if (> (length lst) 1)
(progn
   (setq key (car lst))
   (setq gl_data (vl-remove nil
      (mapcar '(lambda (x / tmp)
   (if (setq tmp (GET-TXT x))
   (cons x tmp)
   )
)
      lst
      )
   )
   )
   (vlax-ldata-put "CS_GUANLIAN" key gl_data)
)
)
(princ)
)
;;;********************************************************
(defun fenxi-gl (lst / GLEDS OUT X Y)
(setq gleds (vlax-ldata-list "CS_GUANLIAN"))
(setq gleds (mapcar '(lambda(x)
(mapcar 'car (cdr x)))
      gleds))
(setq out (vl-remove nil
      (mapcar '(lambda(x)
      (vl-remove nil
(mapcar '(lambda(y)
   (if (member x y) (car y))
   )
      gleds)
)
      )
   lst)
      )
)
(remove-same (apply 'append out))
)
;;;***************************************************
(defun remove-same (lst / OUT TMP)
(setq out '())
(while lst
(setq tmp (car lst))
(setq out (cons tmp out))
(setq lst (vl-remove tmp lst))
)
(reverse out)
)
;;;****************************************************
(defun get-txt (hand / TMP)
(if (and (setq tmp (handent hand))
   (setq tmp (vlax-ename->vla-object tmp))
   (not (vlax-erased-p tmp))
   )
(vla-get-textstring tmp)
)
)
;;;****************************************************
(defun put-txt (hand txt / TMP)
(if (and (setq tmp (handent hand))
   (setq tmp (vlax-ename->vla-object tmp))
   (not (vlax-erased-p tmp))
   )
(vla-put-textstring tmp txt)
)
)

Gu_xl 发表于 2012-7-27 14:37:39

lingduwx 发表于 2012-7-27 13:20 static/image/common/back.gif
G版出手就是不一样啊，
不过小弟现在发现一个小问题，就是再次用此命令选择已关联字体时，CAD出现错误后 ...

35楼代码已更新！
修正了已关联的物体再次关联时出错的问题！
增加取消关联命令: QXWZGL！关联后的文字被复制后，只要将原关联文字原位移动一下，或编辑一下，就自动关联！若不想关联，用取消关联命令选中复制的文字取消即可！

dongya1235 发表于 2012-7-27 14:46:36

顺路问下，有没有可以关联数字的哪？就像EXCEL中运算那样

myjping 发表于 2012-7-27 16:27:00

，

本帖最后由 myjping 于 2012-7-27 16:36 编辑

试用了lijiao 和Gu_xl各有优势：
Gu_xl可在属性里修改文字，lijiao 只能双击修改
lijiao 可以关联后再关联即多重关联，Gu_xl只可一重
希望二们多改动，弄点经典的东东
别我坚持我的观点，相关联的成组，复制后不关联，命令越少越好

革天明 发表于 2012-7-27 17:45:11

myjping 发表于 2012-7-27 16:27 static/image/common/back.gif
试用了lijiao 和Gu_xl各有优势：
Gu_xl可在属性里修改文字，lijiao 只能双击修改
lijiao 可以关联后再关联 ...

Gu_xl的可以正常运行，lrjiao的不能，06机械版，只能实现文字内容一样，改动一个其它的不变

革天明 发表于 2012-7-27 17:51:10

Gu_xl 发表于 2012-7-27 09:35 static/image/common/back.gif

G版你好！程序试用发现后只能一组一组的关联，我希望能实现“入党”功能，也就是A，B， C，是一组了，这时D也想加入，如何实现？目前我只使用一组，但组内成员的数量不定，希望能进群，也能退群

革天明 发表于 2012-7-27 17:55:20

lijiao 发表于 2012-7-27 13:39 static/image/common/back.gif
;;;;我也写了一个，添加关联用addgl，删除关联用delgl，显示关联用xsgl，复制文本不能产生关联。
我用的是 ...

你好！试用后发现不能实现关联，只能实现一次文字内容相同，也就是“文字内容刷”，可以实现“进群”，G版的不能加入新成员，有时间再修改一下，造福全人类

Gu_xl 发表于 2012-7-27 18:56:13

革天明发表于 2012-7-27 17:55
你好！试用后发现不能实现关联，只能实现一次文字内容相同，也就是“文字内容刷”，可以实现“进群”，G版 ...

这个很容易，你把程序看懂了，实现这个用不了三五句代码，这个作为你的思考题，慢慢琢麽吧!

lingduwx 发表于 2012-7-27 20:53:32

Gu_xl 发表于 2012-7-27 14:37 static/image/common/back.gif
35楼代码已更新！
修正了已关联的物体再次关联时出错的问题！
增加取消关联命令: QXWZGL！关联后的文字 ...

非常感谢G版，程序非常不错，
现在就是想怎么把悬赏的150给你啊
悬赏的那儿我一直点不了

页: 1 2 3 4 [5] 6 7 8 9 10 11 12 13

明经CAD社区's Archiver

，