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

xj6019

代码来自
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 txtcon  v "\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

;批量调整
(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 txtcon  v "\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

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

xj6019

这里发错了

xj6019

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

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

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

xj6019

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

yshf

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

xj6019

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

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

yshf

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