社区 › 编程申请 › 请教将内容写入剪切板的程序，怎么改改呀

xj6019 发表于 2020-10-2 08:38:51

请教将内容写入剪切板的程序，怎么改改呀

代码来自
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85614&extra=&highlight=%BC%F4%C7%D0%B0%E5&page=2
的14楼
这个代码我也用了一段时间了，只是随机性的会出现ActiveX错误，很是烦人，下面的代码可以改成不用ActiveX吗。
下面代码红色部分求一段更通用的代码来替换一下。拜托了。





(defun c:w2()
(vl-load-com)
(setq txtcon (strcat))
   (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
    (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setq i 0)
(setq txtcon (strcat))
(repeat (vla-get-count ssv)
            (setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtconv "\n ")))
                         (progn
                           (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
                               (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
                                    (setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
                                    (setq pt (vla-get-TextOverride (vla-item ssv i)) )))
                               (setq pt (vla-get-TextString (vla-item ssv i)))
                           )
                            (list pt)
                        )))
            (setq i (1+ i))
            )
(ZML-CLIP-SETSTRING txtcon)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
；批量调整

yshf 发表于 2020-10-2 08:38:52

;批量调整
(defun c:w2()
   (vl-load-com)
   ;(setq txtcon (strcat))
   ;(setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
   ;(setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
   (if (= (setq txtss (ssget '((0 . "*TEXT,DIMENSION")))) nil)
       (vl-exit-with-error (princ "\n没有选取到文本！"))
   )
   (setq i 0)
   (setq txtcon (strcat))
   ;(repeat (vla-get-count ssv)
   (repeat (sslength txtss)
       (setq txtobj (vlax-ename->vla-object (ssname txtss i)))
       (setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtconv "\n ")))
                         (progn
                           ;(if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
                           (if (= (vla-get-ObjectName txtobj) "AcDbRotatedDimension")
                               (progn
                                  ;(if (= (vla-get-TextOverride (vla-item ssv i)) "")
                                  (if (= (vla-get-TextOverride txtobj) "")
                                        ;(setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
                                        (setq pt (rtos (vla-get-Measurement txtobj) 2 2))
                                        ;(setq pt (vla-get-TextOverride (vla-item ssv i)) )
                                        (setq pt (vla-get-TextOverride txtobj) )
                                  )
                                )
                              ;(setq pt (vla-get-TextString (vla-item ssv i)))
                                (setq pt (vla-get-TextString txtobj))
                           )
                            (list pt)
                        ))
       )
       (setq i (1+ i))
)
(ZML-CLIP-SETSTRING txtcon)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)

xj6019 发表于 2020-10-2 22:21:40

本帖最后由 xj6019 于 2020-10-3 18:41 编辑

还是有不行的情况，继续有待优化

xj6019 发表于 2020-10-3 11:22:02

本帖最后由 xj6019 于 2020-10-3 11:24 编辑



这里发错了

xj6019 发表于 2020-10-3 11:24:24

yshf 发表于 2020-10-2 08:38
;批量调整
(defun c:w2()
   (vl-load-com)




你好，再拜托一下，帮我看看这个文件里面的尺寸行吗，横向的尺寸提取没问题，为什么竖向的尺寸就不能提取呢。提取到剪切板的子函数一起贴上，您测试一下。麻烦了.

(vl-load-com)
(defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
(and (= (type STR) 'STR)
       (setq HTML (vlax-create-object "htmlfile"))
       (setq RESULT (vlax-invoke
                      (vlax-get      (vlax-get HTML 'PARENTWINDOW)
                              'CLIPBOARDDATA
                      )
                      'SETDATA
                      "Text"
                      STR
                  )
       )
       (vlax-release-object HTML)
)
)

xj6019 发表于 2020-10-3 11:27:13

本帖最后由 xj6019 于 2020-10-3 19:01 编辑

yshf 发表于 2020-10-2 08:38
;批量调整
(defun c:w2()
   (vl-load-com)

上面测试文件里面只有一个方向不能提取，在另外一个文件内，两个方向都不行,我发现正常dli出来的尺寸都没问题，我用画线批量拉出来的尺寸，提取就不能成功，您看看，代码能再修正一下吗，麻烦你了

xj6019 发表于 2020-10-3 19:40:45

vla-get-TextString这个可以用其他什么函数替代吗

yshf 发表于 2020-10-4 10:22:32

所提供的“测试文件.dwg”有问题，下载后打开时显示“图形文件无效”。

xj6019 发表于 2020-10-4 11:27:51

yshf 发表于 2020-10-4 10:22
所提供的“测试文件.dwg”有问题，下载后打开时显示“图形文件无效”。

能提供个邮箱吗，可以把文件发你的邮箱里面

yshf 发表于 2020-10-5 23:14:14

测试文件中对齐标注无TextString属性

查看完整版本: 请教将内容写入剪切板的程序，怎么改改呀