转换属性定义t 乐筑天下 - Powered by Discuz! Archiver

manirpg 发表于 2022-7-5 16:39:42

转换属性定义t

请有人帮助我，是否有任何lisp用于将属性定义（非块属性）转换为文本或多行文字

David Bethel 发表于 2022-7-5 16:47:05

这里有一个老掉牙的例子：

;=======================================================================
; Atd2Text.Lsp                                  Feb 28, 2003
; Change ATTDEF To Text Using Tag Name As Text Value
;================== Start Program ======================================
(princ "\nCopyright (C) 2003, Fabricated Designs, Inc.")
(princ "\nLoading Atd2Text v1.1 ")
(setq a2t_ nil lsp_file "Atd2Text")

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun a2t_smd ()
(SetUndo)
(setq olderr *error*
*error* (lambda (e)
            (while (> (getvar "CMDACTIVE") 0)
                  (command))
            (and (/= e "quit / exit abort")
               (princ (strcat "\nError: *** " e " *** ")))
            (command "_.UNDO" "_END" "_.U")
            (a2t_rmd))
   a2t_var '(("CMDECHO" . 0) ("MENUECHO" . 0)
            ("MENUCTL" . 0) ("MACROTRACE" . 0)
            ("OSMODE" . 0) ("SORTENTS" . 119)
            ("BLIPMODE". 0) ("MODEMACRO" . ".")
            ("SNAPMODE". 0) ("UCSICON" . 1)
            ("ORTHOMODE" . 0) ("GRIDMODE" . 0)
            ("ELEVATION" . 0) ("THICKNESS". 0)
            ("HIGHLIGHT" . 0) ("REGENMODE". 1)
            ("CECOLOR" . "BYLAYER")
            ("CELTYPE" . "BYLAYER")))
(foreach v a2t_var
(setq a2t_rst (cons (cons (car v) (getvar (car v))) a2t_rst))
(setvar (car v) (cdr v)))
(princ (strcat (getvar "PLATFORM") " Release " (ver)
   " -Convert ATTDEF to TEXT ....\n"))
(princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun a2t_rmd ()
(setq *error* olderr)
(foreach v a2t_rst (setvar (car v) (cdr v)))
(command "_.UNDO" "_END")
(prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))

(PDot);************ Main Program ***************************************
(defun a2t_ (/ olderr a2t_var a2t_rst st tc ss en ed i)
(a2t_smd)

(initget 1 "Tag Default Prompt")
(setq st (getkword "\nMake Text Show ATTDEF -> Default/Prompt/Tag: "))
(cond ((= st "Tag")    (setq tc 2))
   ((= st "Prompt") (setq tc 3))
   ((= st "Default")(setq tc 1)))

(while (not ss)
   (setq ss (ssget '((0 . "ATTDEF")))))

(setq i (sslength ss))
(princ (strcat "\nChanging " (rtos i 2 0) " ATTDEFs to TEXT\n"))

(while (not (minusp (setq i (1- i))))
   (princ (strcat "\r" (rtos i 2 0) "       "))
   (setq en (ssname ss i)
         ed (entget en))
   (entdel en)
   (entmake (list (cons 0 "TEXT")
                  (cons 1 (cdr (assoc tc ed)))
                  (assoc 7 ed)
                  (assoc 8 ed)
                  (assoc 10 ed)
                  (assoc 11 ed)
                  (if (assoc 39 ed)
                        (assoc 39 ed)
                        (cons 39 0.0))
                  (assoc 40 ed)
                  (assoc 41 ed)
                  (assoc 50 ed)
                  (assoc 51 ed)
                  (if (assoc 62 ed)
                        (assoc 62 ed)
                        (cons 62 256))
                  (assoc 71 ed)
                  (assoc 72 ed)
                  (cons 73 (cdr (assoc 74 ed)))
                  (assoc 210 ed))))
(a2t_rmd))

(PDot);************ Load Program ***************************************
(defun C:Atd2Text () (a2t_))
(if a2t_ (princ "\nAtd2Text Loaded\n"))
(prin1)
;|================== End Program =======================================

-大卫

Lee Mac 发表于 2022-7-5 16:51:15

David，不要试图踩到你的脚趾，但这也应该解释多行文字attdef：

(defun c:AttDef2Text ( / ss )
;; © Lee Mac~01.06.10
(vl-load-com)

(if (setq ss (ssget "_:L" '((0 . "ATTDEF"))))
(
(lambda ( i / e o )
   (while (setq e (ssname ss (setq i (1+ i))))
      (if
      (
         (if (and (vlax-property-available-p
                     (setq o (vlax-ename->vla-object e)) 'MTextAttribute)
                  (eq :vlax-true (vla-get-MTextAttribute o)))

            MAttDef2MText AttDef2Text
         )
         (entget e)
      )
      (entdel e)
      )
   )
)
-1
)
)
(princ)
)

(defun AttDef2Text ( eLst / dx74 dx2 )
;; © Lee Mac~01.06.10

(setq dx74 (cdr (assoc 74 eLst)) dx2 (cdr (assoc 2 eLst)))

(entmake
(append '( (0 . "TEXT") ) (RemovePairs '(0 100 1 2 3 73 74 70 280) eLst)
(list
   (cons 73 dx74)
   (cons1dx2)
)
)
)
)

(defun MAttDef2MText ( eLst )
;; © Lee Mac~01.06.10

(entmake
(append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") )
(RemoveFirstPairs '(40 50 41 7 71 72 71 72 73 10 11 11 210)
   (RemovePairs '(-1 102 330 360 5 0 100 101 1 2 3 42 43 51 74 70 280) eLst)
)
(list (cons 1 (cdr (assoc 2 eLst))))
)
)
)

(defun RemoveFirstPairs ( pairs lst )
;; © Lee Mac

(defun foo ( pair lst )
(if lst
(if (eq pair (caar lst))
   (cdr lst)
   (cons (car lst) (foo pair (cdr lst)))
)
)
)

(foreach pair pairs
(setq lst (foo pair lst))
)
lst
)

(defun RemovePairs ( pairs lst )
;; © Lee Mac
(vl-remove-if
(function
(lambda ( pair )
   (vl-position (car pair) pairs)
)
)
lst
)
)

David Bethel 发表于 2022-7-5 16:53:47

李，

没问题。OP有点模糊-大卫

manirpg 发表于 2022-7-5 17:00:44

亲爱的朋友们：，
David和Lee，这两个代码都很好地工作，并且正在进行修改。。。。。。。。。。。。。。。。。。。。。
多谢…………：D： D:D
马尼

Lee Mac 发表于 2022-7-5 17:03:21

不客气

WindowsIHateYou 发表于 2022-7-5 17:07:19

我试过了（第#3页），得到了如下错误：

我也尝试了#2，它成功了，但无法保留属性值。

Lee Mac 发表于 2022-7-5 17:11:40

你复制了我帖子中的所有代码吗？

WindowsIHateYou 发表于 2022-7-5 17:16:25

S、 O.B。

浏览器中的“全选”不会保留在报价框中。所以我强调了“all”，但显然“all”不包括最后一个括号。因此，再一次，我的用户名。

现在可以了。谢谢

Lee Mac 发表于 2022-7-5 17:21:53

不客气

页: [1] 2

乐筑天下's Archiver

转换属性定义t