求助：点选图元，获取“文 字”内容

fengyu6913

求助：点选图元【文字，尺寸（含假尺寸），块属性文字】，获取“文 字”内容


样图如附件！

guosheyang

;;;功能：向系统剪贴板写入文字   
(defun SET-CLIP-STRING (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)
    )
)
(defun c:tt(/ ENT N STR)
  (while(not(setq e(car(nentsel)))))
  (setq ent(entget e))
  (if (=(cdr(assoc 0 ent)) "MTEXT")
      (progn (setq str(cdr(assoc 1 ent)))
            (setq n (vl-string-position (ascii ";") str))
           (setq nstr(substr str(+ 2  n)))  
      )
        (setq nstr(cdr(assoc 1 ent)))
)
  (SET-CLIP-STRING nstr)
)

fengyu6913

顶一顶，大佬来帮忙一下

gaics

(defun c:cct ();点选复制文字到剪贴板
  (SET-CLIP-STRING
    (cdr(assoc 1 (entget (car (nentsel)))))
  )
)
(defun SET-CLIP-STRING (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)
  )
)

guosheyang

(cdr(assoc 1(entget(car(nentsel)))))   用这句可以分别提取

fengyu6913

gaics 发表于 2024-7-11 07:58
(defun c:cct ();点选复制文字到剪贴板
  (SET-CLIP-STRING
    (cdr(assoc 1 (entget (car (nentsel)))) ...

针对尺寸标注拷贝出来的内容带有格式符，如：\A1;分格尺寸，\A1;174.28

fengyu6913

guosheyang 发表于 2024-7-11 08:53
(cdr(assoc 1(entget(car(nentsel)))))   用这句可以分别提取

这句针对尺寸文字时会复制出尺寸文字格式信息，如：\A1;分格尺寸，\A1;174.28

paulpipi

是的，请大神帮忙解决，谢谢

guosheyang

(defun c:tt(/ ENT N STR)
  (while(not(setq e(car(nentsel)))))
  (setq ent(entget e))
  (if (=(cdr(assoc 0 ent)) "MTEXT")
      (progn (setq str(cdr(assoc 1 ent)))
            (setq n (vl-string-position (ascii ";") str))
            (substr str(+ 2  n))  
      )
      (cdr(assoc 1 ent))
)
)

fengyu6913

guosheyang 发表于 2024-7-11 13:54
(defun c:tt(/ ENT N STR)
  (while(not(setq e(car(nentsel)))))
  (setq ent(entget e))

大佬，如何把文字内容复制到剪切板呢？