寻求相同文字内容关联程序！！！

lingduwx

Gu_xl 发表于 2012-7-27 09:35
[/post]

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

lijiao

;;;;我也写了一个，添加关联用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

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

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

dongya1235

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

myjping

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

革天明

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

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

革天明

Gu_xl 发表于 2012-7-27 09:35
[/post]

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

革天明

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

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

Gu_xl

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

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

lingduwx

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

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