怎样把TEXT文字转换成ATTDEF定义的属性

lxl217114

psdcdr 发表于 2012-6-4 09:28
忘记在哪里找到的，一起分享下，

祝愿所有找LSP的朋友，都能得到答案！

这个程序有效，感谢分享

baitang36

lxl217114 发表于 2022-8-27 12:29
这个程序有效，感谢分享

(DEFUN C:TEXT2ATT (/ SS1 N TXTENT AA A1 A73 LST_210 LST_10)
  (VL-CMDF "_.undo" "_group")
  (SETVAR "blipmode" 0)
  (PRINC "\n选择TEXT文本对象: ")
  (setq SS1 (SSGET '((0 . "TEXT"))))
  (VL-CMDF "_.UCS" "W")
  (setq N 0)
  (REPEAT (SSLENGTH SS1)
    (setq TXTENT (SSNAME SS1 N))
    (setq LST_210 (APPEND LST_210 (LIST (ASSOC 210 (ENTGET TXTENT)))))
    (setq LST_10 (APPEND LST_10 (LIST (ASSOC 10 (ENTGET TXTENT)))))
    (setq AA (MEMBER '(100 . "AcDbEntity") (ENTGET TXTENT)))
    (setq A73 (CDR (ASSOC 73 AA)))
    (setq A1 (CDR (ASSOC 1 AA)))
    (ENTMAKE
      (APPEND '((0 . "ATTDEF"))
              (REVERSE (CDDR (REVERSE AA)))
              '((100 . "AcDbAttributeDefinition") (70 . 8))
              (LIST (CONS 74 A73) (CONS 3 A1) (CONS 2 A1))
      )
    )
    (setq N (1+ N))
  )
  (VL-CMDF "_.erase" SS1 "")
  (VL-CMDF "_.UCS" "P")
)

lxl217114

baitang36 发表于 2022-8-29 07:57
(DEFUN C:TEXT2ATT (/ SS1 N TXTENT AA A1 A73 LST_210 LST_10)
  (VL-CMDF "_.undo" "_group")
  (SET ...

谢谢盛老师

菜鸟初来乍到

psdcdr 发表于 2012-6-4 09:28
忘记在哪里找到的，一起分享下，

祝愿所有找LSP的朋友，都能得到答案！

非常感谢你的分享

andyzha

试试这个

2. (DEFUN C:TXT2ATT (/ SS1 N TXTENT AA A1 A73 LST_210 LST_10)
   
3.   (VL-CMDF "_.undo" "_group")
   
4.   (SETVAR "blipmode" 0)
   
5.   (PRINC "\n选择TEXT文本对象: ")
   
6.   (setq SS1 (SSGET '((0 . "TEXT"))))
   
7.   (VL-CMDF "_.UCS" "W")
   
8.   (setq N 0)
   
9.   (REPEAT (SSLENGTH SS1)
   
10.     (setq TXTENT (SSNAME SS1 N))
    
11.     (setq LST_210 (APPEND LST_210 (LIST (ASSOC 210 (ENTGET TXTENT)))))
    
12.     (setq LST_10 (APPEND LST_10 (LIST (ASSOC 10 (ENTGET TXTENT)))))
    
13.     (setq AA (MEMBER '(100 . "AcDbEntity") (ENTGET TXTENT)))
    
14.     (setq A73 (CDR (ASSOC 73 AA)))
    
15.     (setq A1 (CDR (ASSOC 1 AA)))
    
16.     (ENTMAKE
    
17.       (APPEND '((0 . "ATTDEF"))
    
18.               (REVERSE (CDDR (REVERSE AA)))
    
19.               '((100 . "AcDbAttributeDefinition") (70 . 8))
    
20.               (LIST (CONS 74 A73) (CONS 3 A1) (CONS 2 A1))
    
21.       )
    
22.     )
    
23.     (setq N (1+ N))
    
24.   )
    
25.   (VL-CMDF "_.erase" SS1 "")
    
26.   (VL-CMDF "_.UCS" "P")
    
27. )

(DEFUN C:TXT2ATT (/ SS1 N TXTENT AA A1 A73 LST_210 LST_10)<br />   (VL-CMDF "_.undo" "_group")<br />   (SETVAR "blipmode" 0)<br />   (PRINC "\n选择TEXT文本对象: ")<br />   (setq SS1 (SSGET '((0 . "TEXT"))))<br />   (VL-CMDF "_.UCS" "W")<br />   (setq N 0)<br />   (REPEAT (SSLENGTH SS1)<br />     (setq TXTENT (SSNAME SS1 N))<br />     (setq LST_210 (APPEND LST_210 (LIST (ASSOC 210 (ENTGET TXTENT)))))<br />     (setq LST_10 (APPEND LST_10 (LIST (ASSOC 10 (ENTGET TXTENT)))))<br />     (setq AA (MEMBER '(100 . "AcDbEntity") (ENTGET TXTENT)))<br />     (setq A73 (CDR (ASSOC 73 AA)))<br />     (setq A1 (CDR (ASSOC 1 AA)))<br />     (ENTMAKE<br />       (APPEND '((0 . "ATTDEF"))<br />               (REVERSE (CDDR (REVERSE AA)))<br />               '((100 . "AcDbAttributeDefinition") (70 . 8))<br />               (LIST (CONS 74 A73) (CONS 3 A1) (CONS 2 A1))<br />       )<br />     )<br />     (setq N (1+ N))<br />   )<br />   (VL-CMDF "_.erase" SS1 "")<br />   (VL-CMDF "_.UCS" "P")<br /> )

jkop

psdcdr 发表于 2012-6-4 09:28
忘记在哪里找到的，一起分享下，

祝愿所有找LSP的朋友，都能得到答案！

感谢分享，刚好有这方面的需求。

KO你

baitang36 发表于 2022-8-29 07:57
(DEFUN C:TEXT2ATT (/ SS1 N TXTENT AA A1 A73 LST_210 LST_10)
  (VL-CMDF "_.undo" "_group")
  (SET ...

普通字转属性字程序有了，但属性字转普通字还没有
目前在论坛只找到一个如下    但这个没处理好文字对正问题，希望有高手改成保留原有校正等属性，只转换就好了
;; 属性转文字　
(defun C:TAG2TXT ()
   (setq sset (ssget '((0 . "ATTDEF"))))
   (setq num (sslength sset) itm 0)
   (while (< itm num)
     (setq hnd (ssname sset itm))
     (setq ent (entget hnd))
     (setq new '((0 . "TEXT")))
     (setq new (append new (list (cons 1 (cdr (assoc 2 ent))))))
     (setq dolst (list 7 8 10 11 39 40 41 50 51 62 71 72 73))
     (foreach grp dolst
       (setq addto (assoc grp ent))
       (if (/= addto nil)
         (setq new (append new (list (assoc grp ent))))
       )
     )
     (entdel hnd)
     (entmake new)
     (setq itm (1+ itm))
   )
   (princ)
)