Экспорт выделенного текста из AutoCad - PullRequest
0 голосов
/ 05 июня 2018

Мне интересно, может ли кто-нибудь из вас, замечательные люди, указать мне правильное направление.Я придумал функцию ssget, которая выбирает текст, который я ищу, но я не совсем уверен, куда идти, чтобы извлечь текст в файл txt или csv.

Вот ssgetфункция, которая работает для меня

(ssget "_X" '((0 . "TEXT,MTEXT")(1 . "ETCH*,MARK*,STAMP*")))

Мне нужно взять этот текст из папки, полной рисунков, и экспортировать его в предпочтительно CSV-файл, где я могу легко прочитать.

Заранее спасибо!

Аллан

1 Ответ

0 голосов
/ 05 июня 2018

В соответствии с вашим вопросом, вы извлекаете текст из всех рисунков соответствующей папки, вы можете использовать метод ObjectODBX, здесь вы можете запустить этот код напрямую, он извлекает текст из чертежа и создает CSV-файл с именем чертежа в той же папке, попробуйтеВы можете добавить условие фильтра, если вам нужно.

    (Defun C:ExtractFolderToCSV( /  dwgfile filelist textstring f doc LM:GetDocumentObject FolderBox folderpath)

;; Get Document Object  -  Lee Mac
;; Retrieves the VLA Document Object for the supplied filename.
;; The Document Object may be present in the Documents collection, or obtained through ObjectDBX.
;; It is the callers responsibility to release such object.
;;This function I collect from Lee-Mac Thanks lee
(defun LM:GetDocumentObject (dwg / app dbx dwl err vrs)
  (cond
    ((not (setq dwg (findfile dwg))) nil)
    ((cdr
       (assoc
     (strcase dwg)
     (vlax-for doc
           (vla-get-documents (setq app (vlax-get-acad-object)))
       (setq dwl
          (cons (cons (strcase (vla-get-fullname doc)) doc) dwl)
       )
     )
       )
     )
    )
    ((progn
       (setq dbx
          (vl-catch-all-apply
        'vla-getinterfaceobject
        (list app
              (if (< (setq vrs (atoi (getvar 'acadver))) 16)
            "objectdbx.axdbdocument"
            (strcat "objectdbx.axdbdocument." (itoa vrs))
              )
        )
          )
       )
       (or (null dbx) (vl-catch-all-error-p dbx))
     )
     (prompt "\nUnable to interface with ObjectDBX.")
    )
    ((vl-catch-all-error-p
       (setq err (vl-catch-all-apply 'vla-open (list dbx dwg)))
     )
     (prompt (strcat "\n" (vl-catch-all-error-message err)))
    )
    (dbx)
  )
)


;This function for select folder
(defun FolderBox (message directory flag / folder sh)
;;I found thiscode on web I am not remember website. sorry for that 
;; 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
)


(setq folderpath (FolderBox "Select Folder" "D:/" 0))
(if (setq filelist (vl-directory-files (strcat folderpath "/") "*.dwg" 1))
  (foreach dwgfile filelist

    (setq
      f (open
      (strcat folderpath
          "/"
          (vl-string-subst ".CSV" ".DWG" (strcase dwgfile))

      )
      "w"
    )
    )                   ;create csv file in same folder with replaceing .dwg to .csv

    (if (setq doc (LM:GetDocumentObject (strcat folderpath "/" dwgfile)))
      (progn
    (vlax-for lyt (vla-get-layouts doc)
      (vlax-for obj (vla-get-block lyt)
        (if
          (or
        (= "AcDbMText" (vla-get-objectname obj));select onlly m_text and text
        (= "AcDbText" (vla-get-objectname obj))

          )
           (progn
         (setq textstring
            (vla-get-TextString obj)
         )
         (if
           (or (= (vl-string-search "ETCH" textstring) 0) ;your test condition
             (= (vl-string-search "MARK" textstring) 0)
             (= (vl-string-search "STAMP" textstring) 0)
             )

           (write-line textstring f)
         )
           )
        )
      )
    )
    (vlax-release-object doc)
      )
    )
    (close f)

  )
)



);close defun

Надеюсь, это поможет

...