找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1228|回复: 8

[求助]:请编一个文本间复制的程序

[复制链接]
发表于 2006-10-12 09:30:14 | 显示全部楼层 |阅读模式

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

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

×
设想是这样的:首先选择文本A,再选择文本B,回车后使文本A的内容自动复制到文本B。
这个在工作中蛮常用的。
我自己编时,选择搞不清楚,选择集内的前后怎么区分?
有高手最好能将代码都写出来,谢谢。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2006-10-13 19:37:25 | 显示全部楼层
我用vlisp编过一个,如果需要,我可上传。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

发表于 2006-10-16 01:00:06 | 显示全部楼层
加载后使用键入dim_wz_edit启动;另代码中还含“将数据拷贝至黑板名称空间变量REPLACE_WZ中”及“取黑板名称空间变量REPLACE_WZ更新所选文字或标注尺寸”两个模块。

  1. (defun load_vlsp_start ()
  2.         (vl-load-com)
  3.         (setq acadObject (vlax-get-acad-object))
  4.         (setq acadDocument (vla-get-ActiveDocument acadObject))
  5.         (setq mSpace (vla-get-ModelSpace acadDocument))               
  6. )

  7. (defun cxcshsz ()
  8.   (setvar "cmdecho" 0)
  9.   (setvar "blipmode" 0)
  10.   (graphscr)
  11. )

  12. (defun rtod (rang)
  13.   (* rang (/ 180 pi))
  14. )

  15. ;取源实体(标注实体)replace_wz
  16. (defun q_bzst_replace_wz ()
  17.         (setq        selc_TextPrefix (vlax-get-property selc_dim_object 'TextPrefix))
  18.         (setq        selc_TextSuffix (vlax-get-property selc_dim_object 'TextSuffix))
  19.         (cond
  20.                 ((and (= selc_bz_name "AcDbRadialDimension")                         
  21.                                          (= selc_TextPrefix "")
  22.                  )
  23.                  (setq selc_TextPrefix "R")
  24.                 )
  25.                 ((and (= selc_bz_name "AcDbDiametricDimension")
  26.                                         (= selc_TextPrefix "")
  27.                  )
  28.                  (setq selc_TextPrefix "%%c")
  29.                 )
  30.                 ((= selc_bz_name "AcDb2LineAngularDimension")
  31.                  (setq selc_TextSuffix "%%d")
  32.                 )
  33.         )
  34.         (setq        rz_edit (vlax-get-property selc_dim_object 'TextOverride))
  35.         (if (= selc_bz_name "AcDb2LineAngularDimension")
  36.                 (progn
  37.                         (setq        rz_measure (vlax-get-property selc_dim_object 'Measurement))
  38.                         (setq rz_measure (rtod rz_measure))
  39.                         (setq        rz_measure (rtos rz_measure 2 4))
  40.                 )
  41.                 (progn
  42.                         (setq        rz_measure (rtos (vlax-get-property selc_dim_object 'Measurement) 2 4))
  43.                 )
  44.         )       
  45.         (if (/= rz_edit "")
  46.                 (setq replace_wz rz_edit)
  47.                 (progn
  48.                         (cond
  49.                                 ((and (/= selc_TextPrefix "")
  50.                                                         (/= selc_TextSuffix "")
  51.                                                         )
  52.                                  (setq replace_wz (strcat selc_TextPrefix (strcat rz_measure selc_TextSuffix)))
  53.                                 )
  54.                                 ((and (/= selc_TextPrefix "")
  55.                                                         (= selc_TextSuffix "")
  56.                                                         )
  57.                                  (setq replace_wz (strcat selc_TextPrefix rz_measure))
  58.                                 )
  59.                                 ((and (= selc_TextPrefix "")
  60.                                                         (/= selc_TextSuffix "")
  61.                                                         )
  62.                                  (setq replace_wz (strcat rz_measure selc_TextSuffix))
  63.                                 )
  64.                                 ((and (= selc_TextPrefix "")
  65.                                                         (= selc_TextSuffix "")
  66.                                                         )
  67.                                  (setq replace_wz rz_measure)
  68.                                 )
  69.                         )
  70.                 )
  71.         )
  72. )

  73. (defun c:wz_copy (/        text_str                                 selc_ys                                        acadObject
  74.                                                                                 acadDocument                 mSpace                                                selc_dim_object
  75.                                                                                 selc_bz_name                 replace_wz                                selc_TextPrefix
  76.                                                                                 selc_TextSuffix         rz_edit                                        rz_measure
  77.                                                                          )
  78.         (cxcshsz)
  79.         (setq text_str (getstring "\n拷贝模式[选择对象(Y)/输入尺寸(N)]<选择对象>:"))
  80.         (if(/= (strcase text_str) "N")
  81.                 (progn                       
  82.                         (setq selc_ys (car (entsel "\n请选取文字或标注实体: ")))
  83.                   (if (/= selc_ys nil)
  84.                           (progn
  85.                                         (load_vlsp_start)               
  86.                                         (setq selc_dim_object (vlax-ename->vla-object selc_ys))
  87.                                         (vla-update selc_dim_object)  
  88.                                         (setq        selc_bz_name (vlax-get-property selc_dim_object 'ObjectName))
  89.                                         (if (or (= selc_bz_name "AcDbText")(= selc_bz_name "AcDbMText"))
  90.                                                 (setq replace_wz (vlax-get-property selc_dim_object 'TextString))
  91.                                         )
  92.                                         (cond
  93.                                                 ((or (= selc_bz_name "AcDbText")
  94.                                                                  (= selc_bz_name "AcDbMText")
  95.                                                  )
  96.                                                  (setq replace_wz (vlax-get-property selc_dim_object 'TextString))
  97.                                                  (vl-bb-set 'replace_wz replace_wz)
  98.                                                  (alert (strcat "\n已将数据"" replace_wz ""拷贝至黑板名称空间变量REPLACE_WZ中!"))
  99.                                                 )
  100.                                                 ((or (= selc_bz_name "AcDbRotatedDimension")
  101.                                                                  (= selc_bz_name "AcDbAlignedDimension")
  102.                                                                  (= selc_bz_name "AcDbOrdinateDimension")
  103.                                                                  (= selc_bz_name "AcDb2LineAngularDimension")
  104.                                                                  (= selc_bz_name "AcDbRadialDimension")
  105.                                                                  (= selc_bz_name "AcDbDiametricDimension")
  106.                                                  )
  107.                                                  (q_bzst_replace_wz)
  108.                                                  (vl-bb-set 'replace_wz replace_wz)
  109.                                                  (alert (strcat "\n已将数据"" replace_wz ""拷贝至黑板名称空间变量REPLACE_WZ中!"))
  110.                                                 )
  111.                                                 (t (alert "\n本模块不能处理所选实体!"))
  112.                                         )
  113.                                         (if (= (vlax-object-released-p selc_dim_object) nil)
  114.                                                 (vlax-release-object selc_dim_object)
  115.                                         )
  116.                                 )
  117.                                 (progn
  118.                                         (alert "\n 未选中文字或标注实体!")
  119.                                 )
  120.                         )
  121.                 )
  122.                 (progn
  123.                         (setq replace_wz (getstring "\n输入文字:"))
  124.                         (if (/= replace_wz nil)
  125.                                 (progn
  126.                                         (vl-bb-set 'replace_wz replace_wz)
  127.                                         (alert (strcat "\n已将数据"" replace_wz ""拷贝至黑板名称空间变量REPLACE_WZ中!"))
  128.                                 )
  129.                                 (progn
  130.                                         (if (= (vl-bb-ref 'replace_wz) nil)
  131.                                                 (alert "\n未输入文字,且黑板名称空间变量REPLACE_WZ为空!")
  132.                                                 (alert (strcat "\n未输入文字,默认黑板名称空间变量REPLACE_WZ为"" replace_wz ""!"))
  133.                                         )
  134.                                 )
  135.                         )
  136.                 )
  137.         )
  138.         (princ)
  139. )

  140. (defun c:wz_edit (/        acadObject                         acadDocument                        mSpace
  141.                                                                         replace_wz                         selc_ys2                                        selc_dim_object2
  142.                                                                         selc_bz_name2
  143.                                                                  )
  144.         (setq replace_wz (vl-bb-ref 'replace_wz))
  145.         (if (= replace_wz nil)
  146.           (progn
  147.                         (alert "\n 源实体数据不存在!")
  148.                 )
  149.                 (progn
  150.                         (load "replace")
  151.                         (cxcshsz)
  152.                         (setq selc_ys2 (car (entsel "\n请选取文字或标注实体: ")))
  153.                         (if (/= selc_ys2 nil)
  154.                                 (progn
  155.                                         (load_vlsp_start)       
  156.                                         (setq selc_dim_object2 (vlax-ename->vla-object selc_ys2))
  157.                                         (vla-update selc_dim_object2)
  158.                                         (setq        selc_bz_name2 (vlax-get-property selc_dim_object2 'ObjectName))
  159.                                         (if (or (= selc_bz_name2 "AcDbText")
  160.                                                                          (= selc_bz_name2 "AcDbMText")
  161.                                                                         (= selc_bz_name2 "AcDbRotatedDimension")
  162.                                                                         (= selc_bz_name2 "AcDbAlignedDimension")
  163.                                                                         (= selc_bz_name2 "AcDbOrdinateDimension")
  164.                                                                         (= selc_bz_name2 "AcDb2LineAngularDimension")
  165.                                                                         (= selc_bz_name2 "AcDbRadialDimension")
  166.                                                                         (= selc_bz_name2 "AcDbDiametricDimension")
  167.                                                          )
  168.                                                 (progn
  169.                                                         (if (or (= selc_bz_name2 "AcDbText")
  170.                                                                                          (= selc_bz_name2 "AcDbMText")
  171.                                                                                         )
  172.                                                                 (vla-put-TextString selc_dim_object2 replace_wz)
  173.                                                                 (vla-put-TextOverride selc_dim_object2 replace_wz)
  174.                                                         )
  175.                                                         (vla-update selc_dim_object2)
  176.                                                         (princ "\n所选数据已成功更新!")
  177.                                                 )
  178.                                                 (alert "\n本模块不能处理所选实体!")
  179.                                         )
  180.                                         (if (= (vlax-object-released-p selc_dim_object2) nil)
  181.                                                 (vlax-release-object selc_dim_object2)
  182.                                         )
  183.                                 )
  184.                                 (alert "\n 未选中文字或标注实体!")
  185.                         )
  186.                 )
  187.         )
  188.         (princ)
  189. )
  190.        
  191. (defun c:dim_wz_edit (/        selc_ys                                                acadObject
  192.                                                                                                 acadDocument                        mSpace
  193.                                                                                                 selc_dim_object                selc_bz_name
  194.                                                                                                 replace_wz                                selc_TextPrefix
  195.                                                                                                 selc_TextSuffix                rz_edit
  196.                                                                                                 rz_measure                                selc_ys2
  197.                                                                                                 selc_dim_object2        selc_bz_name2
  198.                                                                                          )
  199.         (load "replace")
  200.         (cxcshsz)
  201.         (setq selc_ys (car (entsel "\n选取源实体: ")))
  202.   (if (/= selc_ys nil)
  203.           (progn
  204.                         (load_vlsp_start)               
  205.                         (setq selc_dim_object (vlax-ename->vla-object selc_ys))
  206.                         (vla-update selc_dim_object)
  207.                         (redraw selc_ys 3)
  208.                         (setq        selc_bz_name (vlax-get-property selc_dim_object 'ObjectName))
  209.                         (if (or (= selc_bz_name "AcDbText")(= selc_bz_name "AcDbMText"))
  210.                                 (setq replace_wz (vlax-get-property selc_dim_object 'TextString))
  211.                         )
  212.                         (cond
  213.                                 ((or (= selc_bz_name "AcDbText")
  214.                                                  (= selc_bz_name "AcDbMText")
  215.                                  )
  216.                                  (setq replace_wz (vlax-get-property selc_dim_object 'TextString))
  217.                                  (vl-bb-set 'replace_wz replace_wz)
  218.                                 )
  219.                                 ((or (= selc_bz_name "AcDbRotatedDimension")
  220.                                                  (= selc_bz_name "AcDbAlignedDimension")
  221.                                                  (= selc_bz_name "AcDbOrdinateDimension")
  222.                                                  (= selc_bz_name "AcDb2LineAngularDimension")
  223.                                                  (= selc_bz_name "AcDbRadialDimension")
  224.                                                  (= selc_bz_name "AcDbDiametricDimension")
  225.                                  )
  226.                                  (q_bzst_replace_wz)
  227.                                 )
  228.                                 (t (alert "\n本模块不能处理源实体!"))
  229.                         )
  230.                         (if (= (vlax-object-released-p selc_dim_object) nil)
  231.                                 (vlax-release-object selc_dim_object)
  232.                         )
  233.                         (if (/= replace_wz nil)
  234.                                 (progn
  235.                                         (setq selc_ys2 (car (entsel "\n选取目标实体: ")))
  236.                                         (if (/= selc_ys2 nil)
  237.                                           (progn                                               
  238.                                                         (setq selc_dim_object2 (vlax-ename->vla-object selc_ys2))
  239.                                                         (vla-update selc_dim_object2)
  240.                                                         (setq        selc_bz_name2 (vlax-get-property selc_dim_object2 'ObjectName))
  241.                                                         (if (or (= selc_bz_name2 "AcDbText")
  242.                                                                                          (= selc_bz_name2 "AcDbMText")
  243.                                                                                         (= selc_bz_name2 "AcDbRotatedDimension")
  244.                                                                                         (= selc_bz_name2 "AcDbAlignedDimension")
  245.                                                                                         (= selc_bz_name2 "AcDbOrdinateDimension")
  246.                                                                                         (= selc_bz_name2 "AcDb2LineAngularDimension")
  247.                                                                                         (= selc_bz_name2 "AcDbRadialDimension")
  248.                                                                                         (= selc_bz_name2 "AcDbDiametricDimension")
  249.                                                                          )
  250.                                                                 (progn
  251.                                                                         (if (or (= selc_bz_name2 "AcDbText")
  252.                                                                                                          (= selc_bz_name2 "AcDbMText")
  253.                                                                                                         )
  254.                                                                                 (vla-put-TextString selc_dim_object2 replace_wz)
  255.                                                                                 (vla-put-TextOverride selc_dim_object2 replace_wz)
  256.                                                                         )
  257.                                                                         (vla-update selc_dim_object2)
  258.                                                                 )
  259.                                                                 (alert "\n本模块不能处理目标实体!")
  260.                                                         )
  261.                                                         (if (= (vlax-object-released-p selc_dim_object2) nil)
  262.                                                                 (vlax-release-object selc_dim_object2)
  263.                                                         )
  264.                                                 )
  265.                                                 (alert "\n  未选中目标实体!")
  266.                                         )
  267.                                 )
  268.                         )
  269.                 )
  270.                 (progn
  271.                         (alert "\n   未选中源实体!")
  272.                 )
  273.         )
  274.         (if (/= selc_ys nil)(redraw selc_ys 4))
  275.         (princ)
  276. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-10-16 11:21:02 | 显示全部楼层
谢谢。
好长啊,我原先的设想太简单了。
我的设想是:选择每一个文字,并将他的内容拷贝至剪贴板;选择第二个文字,将剪贴板上的内容粘贴至第二个文字内,确定。
按这样来编,是不是能简单呢。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-10-16 13:32:33 | 显示全部楼层
就是你的设想啊,程序长是因为包含三个模块,你不需要的话将其它两个删除,程序自然就变短了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

发表于 2006-10-28 15:19:49 | 显示全部楼层
[php]
用这个代码好看些。。VB的代码怎么设置我不知道
直接贴起的不好看^_^
Sub replace1()
Dim s As String
Dim ent As AcadObject
Dim pt(2) As Double
On Error Resume Next
resel1:  '选择第一个对象'
ThisDrawing.Utility.GetEntity ent, pt, "第一个文字:" & vbCrLf
If IsNull(ent) Then
    If MsgBox("未选择,是否重新选择?", vbYesNo) = vbYes Then
        GoTo resel1:
    Else
        GoTo exitsub:
    End If
Else
    If UCase(ent.ObjectName) <> "ACDBTEXT" Then
        If MsgBox("所选对象不符合要求,重新选择?", vbYesNo) = vbYes Then
            GoTo resel1
        Else
            GoTo exitsub:
        End If
    End If
s = ent.TextString '取得第一个文本的内容'
ThisDrawing.Utility.Prompt "第一个文本的内容为:<" & s & ">" & vbCrLf
Set ent = Nothing
resel2:      '选择第二个对象'
    ThisDrawing.Utility.GetEntity ent, pt, "第二个文字:" & vbCrLf
    If IsNull(ent) Then
        If MsgBox("未选择,是否重新选择?", vbYesNo) = vbYes Then
            GoTo resel2:
        Else
            GoTo exitsub:
        End If
    Else
        If UCase(ent.ObjectName) <> "ACDBTEXT" Then
            If MsgBox("所选对象不符合要求,重新选择?", vbYesNo) = vbYes Then
                GoTo resel2
            Else
                GoTo exitsub:
            End If
        End If
        ThisDrawing.Utility.Prompt "第二个文字的内容为<" & ent.TextString & ">" & vbCrLf
ThisDrawing.Utility.Prompt "<" & ent.TextString & ">被更改为<" & s & ">" & vbCrLf

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-9-28 15:21 , Processed in 0.201853 second(s), 48 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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