导出文本实体的坐标

时间:2018-06-21 09:33:10

标签: lisp autocad autolisp

我想将特定图层的所有坐标和文本本身提取到CSV文件中。我正在使用Mac版本的AutoCAD 2018。 DATAEXTRACT似乎在Mac和Windows上不可用 -ATTEXT始终写入:“提取文件中有0条记录。”使用以下模板文件:

NAME C008000
X N007001
Y N007001
Z N007001

我也尝试过用Lisp尝试,但是直到这里我才知道:

(defun c:asdf () 
    (setq coordinates (assoc 10 (entget (entlast)))))
    (alert coordinates)
)

有什么想法吗? 预先感谢!

1 个答案:

答案 0 :(得分:0)

对不起,我回复了我写了一些功能,并根据您的需要进行了修改。加载此Lisp并键入命令TEXT2CSV。
然后程序会询问您“图层名称”,“输出文件夹名称”和CSV文件名称。如果输入正确,则创建CSV文件并将其保存在目标位置

;
(Defun C:text2CSV (/         extractText   FolderBox
           makecsvstring lyr           layerlist
           layerstring
          )


                    ;Function-----extractText ---------------------------------------------------------------------
                    ;[filterLIst]--->send selection filter criteria to Function by default nil then select all text
  (defun extractText
     (filterLIst / outputfile f en i ss name x y z path)

                    ;filterLIst check if filterLIst is nil then select all text from all layer
    (if (= nil filterLIst)
      (setq filterLIst
         '((-4 . "<or") (0 . "TEXT") (0 . "MTEXT") (-4 . "or>"))
      )
    )


                    ;get file path and file name
                    ;(setq path (FolderBox "Select folder" "D:/" 0))
    (setq path (FolderBox "Select Output folder:" "D:/" 0))
    (initget 1)
    (setq filename (getstring "\nType output CSV filename:"))

    (setq outputfile
       (strcat path
           "/"
           filename
           ".CSV"
       )
    )



                    ;select entity from dwg and set initial parameter
    (setq i  -1
      ss (ssget "X" filterLIst)
    )
                    ;create csv file
    (if ss
      (progn
    (setq f (open outputfile "w"))
    (if f
      (progn
        (write-line (strcat "Name," "X," "Y," "Z,") f)
        (while (setq en (ssname ss (setq i (+ 1 i))))
          (setq name (makecsvstring (cdr (assoc 1 (entget en)))))
          (setq x (rtos (nth 1 (assoc 10 (entget en)))))
          (setq y (rtos (nth 2 (assoc 10 (entget en)))))
          (setq z (rtos (nth 3 (assoc 10 (entget en)))))
                    ;write to csv
          (write-line (strcat name "," X "," Y "," Z) f)

        )
        (close f)
                    ;done
        (Alert "Done!")
      )
                    ;if error
      (print "\nWrong input unable to create csv file:")
    )
      )

      (print "\nNo text entity found:")
    )
    (princ)
  )
  ;;---------------------------------------------------------------EnD extractText --------------------------------






                    ;This function to select output folder
  (defun FolderBox (message directory flag / folder sh)
    ;; Arguments:
    ;; message: the message displayed in th dialog box
    ;; directory: the directory to browse
    ;; flag values:
    ;; 0 = Default
    ;; 1 = Only file system folders can be selected. If this bit is set, the OK button is disabled if the user selects a folder that doesn't belong to the file system (such as the Control Panel folder).
    ;; 2 = The user is prohibited from browsing below the domain within a network (during a computer search).
    ;; 4 = Room for status text is provided under the text box.
    ;; 8 = Returns file system ancestors only.
    ;; 16 = Shows an edit box in the dialog box for the user to type the name of an item.
    ;; 32 = Validate the name typed in the edit box.
    ;; 512 = None "New folder" button
    ;; 4096 = Enables the user to browse the network branch of the shell's namespace for computer names.
    ;; 8192 = Enables the user to browse the network branch of the shell's namespace for printer names.
    ;; 16384 = Allows browsing for everything.
    (vl-load-com)
    (setq shell (vlax-create-object "Shell.Application"))
    (if (setq
      folder (vlax-invoke
           shell 'browseforfolder 0 message flag directory)
    )
      (setq folder
         (vlax-get-property (vlax-get-property folder 'self) 'path)
      )
      (setq folder nil)
    )
    (vlax-release-object shell)
    folder
  )


                    ;this function add " to start and end of supply string 
  (defun makecsvstring (instring)
    (if (= nil instring)
      (setq instring "")
    )
    (strcat "\"" instring "\"")
  )


                    ;if can send direct layer name
  (setq layer (getstring "\nEnter Layer Name:" T))

  (if (and (/= layer "") (/= layer nil))
    (setq filterLIst

       (append
         (list (cons 8 layer))
         '((-4 . "<or")
           (0 . "TEXT")
           (0 . "MTEXT")
           (-4 . "or>")
          )
       )
    )

    (setq filterLIst

       '((-4 . "<or")
         (0 . "TEXT")
         (0 . "MTEXT")
         (-4 . "or>")
        )
    )

                    ;you can Edit for more filter criteria
  )
  (extractText filterLIst)


)

您可以根据需要修改代码,进一步希望获得帮助