Jump to content

REQUIRED LISP TO EXPORT DIM TEXT INTO EXCEL OR CSV FORMAT


Khera

Recommended Posts

On 22/08/2019 at 16:22, Ish said:

I THINK , THATS WHY HE NEED SERIAL NUMBER TEXT ON DIM TEXT TO CHECK.

BECOZ SOME TIME DRAWING IN METER BUT DIMENSION TEXT IN MILIMETER.

SOME CASE DRAWING IN METER BUT DIMENSION NOT IN SCALE ONLY EDIT  LIKE ABOVE ATTACH IMAGE BY KHERA.

SOME CASE PREFIX OR SUFFIX TEXT LIKE A=1.000, 2.00 (A) 

IF S.NO IS THERE, EASY TO VERIFY/CHECK.

THANKS.

YES i need exactly this type of lisp...

Thanks

  • Like 1
Link to comment
Share on other sites

Right, I actually overlooked the red texts in the image... So the request makes more sense now.

Try the code below.

Change the value of *idxLyrNme* to your liking.

(setq *idxLyrNme* "Dim_Index_Layer")

(vl-load-com)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

; WCS must be active for this function.
; The text position for diametric and radial dimensions is on the dim line.
; Index mtexts will be closer to the dim text for these dimensions.
(defun DimToCsv_CreateIdxMtext (dim ang idx / mtxt) ; Dim is dimension object.
  (setq mtxt
    (vla-addmtext
      (KGA_Sys_ObjectOwner dim)
      (vlax-3d-point '(0.0 0.0 0.0))
      0.0
      (itoa idx)
    )
  )
  (vlax-put mtxt 'normal (vlax-get dim 'normal))
  (vlax-put
    mtxt
    'insertionpoint
    (mapcar
      '+
      (vlax-get dim 'textposition)
      (trans
        (polar
          '(0.0 0.0 0.0)
          (+ (/ pi 2.0) ang)
          (* 2.0 (vla-get-textheight dim))
        )
        (vlax-get dim 'normal)
        0
        T
      )
    )
  )
  (vlax-put mtxt 'rotation ang)
  (vla-put-attachmentpoint mtxt 5)
  (vla-put-height mtxt (* 0.75 (vla-get-textheight dim)))
  (vla-put-layer mtxt *idxLyrNme*)
  mtxt
)

(defun DimToCsv_GetDimMtext (def / ret)
  (vlax-for obj def
    (if
      (and
        (not ret)
        (= "AcDbMText" (vla-get-objectname obj))
      )
      (setq ret obj)
    )
  )
  ret
)

(defun DimToCsv_UnformatStr (str) ; Very limited.
  (vl-string-subst "°" "%%d" (vl-string-subst "Ø" "%%c" str))
)

(defun DimToCsv_WriteCsv (fnm lst)
  (KGA_Data_FileWrite
    fnm
    (mapcar '(lambda (sub) (KGA_String_Join sub ",")) lst)
  )
)

(defun c:DimToCsv ( / blks doc fnm idx lst ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (or
        (= 1 (getvar 'worlducs))
        (prompt "\nError: the current UCS is not the WCS ")
      )
      (setq ss (ssget '((0 . "DIMENSION"))))
      (setq fnm (getfiled "CSV file" (getvar 'dwgprefix) "csv" 5))
    )
    (progn
      (vla-add (vla-get-layers doc) *idxLyrNme*)
      (setq blks (vla-get-blocks doc))
      (setq idx 0)
      (setq lst
        (vl-remove
          nil
          (mapcar
            '(lambda (enm / mtxt)
              (if (setq mtxt (DimToCsv_GetDimMtext (vla-item blks (cdr (assoc 2 (entget enm))))))
                (progn
                  (setq idx (1+ idx))
                  (DimToCsv_CreateIdxMtext (vlax-ename->vla-object enm) (vla-get-rotation mtxt) idx)
                  (list (itoa idx) (strcat "\"" (DimToCsv_UnformatStr (vla-get-textstring mtxt)) "\""))
                )
              )
            )
            (KGA_Conv_Pickset_To_EnameList ss)
          )
        )
      )
      (DimToCsv_WriteCsv fnm (cons '("\"NO.\"" "\"TEXT\"") lst))
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

  • Like 2
Link to comment
Share on other sites

55 minutes ago, Roy_043 said:

Right, I actually overlooked the red texts in the image... So the request makes more sense now.

Try the code below.

Change the value of *idxLyrNme* to your liking.


(setq *idxLyrNme* "Dim_Index_Layer")

(vl-load-com)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

; WCS must be active for this function.
; The text position for diametric and radial dimensions is on the dim line.
; Index mtexts will be closer to the dim text for these dimensions.
(defun DimToCsv_CreateIdxMtext (dim ang idx / mtxt) ; Dim is dimension object.
  (setq mtxt
    (vla-addmtext
      (KGA_Sys_ObjectOwner dim)
      (vlax-3d-point '(0.0 0.0 0.0))
      0.0
      (itoa idx)
    )
  )
  (vlax-put mtxt 'normal (vlax-get dim 'normal))
  (vlax-put
    mtxt
    'insertionpoint
    (mapcar
      '+
      (vlax-get dim 'textposition)
      (trans
        (polar
          '(0.0 0.0 0.0)
          (+ (/ pi 2.0) ang)
          (* 2.0 (vla-get-textheight dim))
        )
        (vlax-get dim 'normal)
        0
        T
      )
    )
  )
  (vlax-put mtxt 'rotation ang)
  (vla-put-attachmentpoint mtxt 5)
  (vla-put-height mtxt (* 0.75 (vla-get-textheight dim)))
  (vla-put-layer mtxt *idxLyrNme*)
  mtxt
)

(defun DimToCsv_GetDimMtext (def / ret)
  (vlax-for obj def
    (if
      (and
        (not ret)
        (= "AcDbMText" (vla-get-objectname obj))
      )
      (setq ret obj)
    )
  )
  ret
)

(defun DimToCsv_UnformatStr (str) ; Very limited.
  (vl-string-subst "°" "%%d" (vl-string-subst "Ø" "%%c" str))
)

(defun DimToCsv_WriteCsv (fnm lst)
  (KGA_Data_FileWrite
    fnm
    (mapcar '(lambda (sub) (KGA_String_Join sub ",")) lst)
  )
)

(defun c:DimToCsv ( / blks doc fnm idx lst ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (or
        (= 1 (getvar 'worlducs))
        (prompt "\nError: the current UCS is not the WCS ")
      )
      (setq ss (ssget '((0 . "DIMENSION"))))
      (setq fnm (getfiled "CSV file" (getvar 'dwgprefix) "csv" 5))
    )
    (progn
      (vla-add (vla-get-layers doc) *idxLyrNme*)
      (setq blks (vla-get-blocks doc))
      (setq idx 0)
      (setq lst
        (vl-remove
          nil
          (mapcar
            '(lambda (enm / mtxt)
              (if (setq mtxt (DimToCsv_GetDimMtext (vla-item blks (cdr (assoc 2 (entget enm))))))
                (progn
                  (setq idx (1+ idx))
                  (DimToCsv_CreateIdxMtext (vlax-ename->vla-object enm) (vla-get-rotation mtxt) idx)
                  (list (itoa idx) (strcat "\"" (DimToCsv_UnformatStr (vla-get-textstring mtxt)) "\""))
                )
              )
            )
            (KGA_Conv_Pickset_To_EnameList ss)
          )
        )
      )
      (DimToCsv_WriteCsv fnm (cons '("\"NO.\"" "\"TEXT\"") lst))
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

EXCELLENT, NO 1, WORKING PERFECTLY..

THANKS A LOT 

BIG PROBLEM SOLVE.

THANKS THIS PLATFORM & MEMBER.

Link to comment
Share on other sites

1 hour ago, Roy_043 said:

Right, I actually overlooked the red texts in the image... So the request makes more sense now.

Try the code below.

Change the value of *idxLyrNme* to your liking.


(setq *idxLyrNme* "Dim_Index_Layer")

(vl-load-com)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

; WCS must be active for this function.
; The text position for diametric and radial dimensions is on the dim line.
; Index mtexts will be closer to the dim text for these dimensions.
(defun DimToCsv_CreateIdxMtext (dim ang idx / mtxt) ; Dim is dimension object.
  (setq mtxt
    (vla-addmtext
      (KGA_Sys_ObjectOwner dim)
      (vlax-3d-point '(0.0 0.0 0.0))
      0.0
      (itoa idx)
    )
  )
  (vlax-put mtxt 'normal (vlax-get dim 'normal))
  (vlax-put
    mtxt
    'insertionpoint
    (mapcar
      '+
      (vlax-get dim 'textposition)
      (trans
        (polar
          '(0.0 0.0 0.0)
          (+ (/ pi 2.0) ang)
          (* 2.0 (vla-get-textheight dim))
        )
        (vlax-get dim 'normal)
        0
        T
      )
    )
  )
  (vlax-put mtxt 'rotation ang)
  (vla-put-attachmentpoint mtxt 5)
  (vla-put-height mtxt (* 0.75 (vla-get-textheight dim)))
  (vla-put-layer mtxt *idxLyrNme*)
  mtxt
)

(defun DimToCsv_GetDimMtext (def / ret)
  (vlax-for obj def
    (if
      (and
        (not ret)
        (= "AcDbMText" (vla-get-objectname obj))
      )
      (setq ret obj)
    )
  )
  ret
)

(defun DimToCsv_UnformatStr (str) ; Very limited.
  (vl-string-subst "°" "%%d" (vl-string-subst "Ø" "%%c" str))
)

(defun DimToCsv_WriteCsv (fnm lst)
  (KGA_Data_FileWrite
    fnm
    (mapcar '(lambda (sub) (KGA_String_Join sub ",")) lst)
  )
)

(defun c:DimToCsv ( / blks doc fnm idx lst ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (or
        (= 1 (getvar 'worlducs))
        (prompt "\nError: the current UCS is not the WCS ")
      )
      (setq ss (ssget '((0 . "DIMENSION"))))
      (setq fnm (getfiled "CSV file" (getvar 'dwgprefix) "csv" 5))
    )
    (progn
      (vla-add (vla-get-layers doc) *idxLyrNme*)
      (setq blks (vla-get-blocks doc))
      (setq idx 0)
      (setq lst
        (vl-remove
          nil
          (mapcar
            '(lambda (enm / mtxt)
              (if (setq mtxt (DimToCsv_GetDimMtext (vla-item blks (cdr (assoc 2 (entget enm))))))
                (progn
                  (setq idx (1+ idx))
                  (DimToCsv_CreateIdxMtext (vlax-ename->vla-object enm) (vla-get-rotation mtxt) idx)
                  (list (itoa idx) (strcat "\"" (DimToCsv_UnformatStr (vla-get-textstring mtxt)) "\""))
                )
              )
            )
            (KGA_Conv_Pickset_To_EnameList ss)
          )
        )
      )
      (DimToCsv_WriteCsv fnm (cons '("\"NO.\"" "\"TEXT\"") lst))
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

 

Thanks 

supeeeeeeeeer

 

  • Like 1
Link to comment
Share on other sites

14 hours ago, Roy_043 said:

Right, I actually overlooked the red texts in the image... So the request makes more sense now.

Try the code below.

Change the value of *idxLyrNme* to your liking.


(setq *idxLyrNme* "Dim_Index_Layer")

(vl-load-com)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

; WCS must be active for this function.
; The text position for diametric and radial dimensions is on the dim line.
; Index mtexts will be closer to the dim text for these dimensions.
(defun DimToCsv_CreateIdxMtext (dim ang idx / mtxt) ; Dim is dimension object.
  (setq mtxt
    (vla-addmtext
      (KGA_Sys_ObjectOwner dim)
      (vlax-3d-point '(0.0 0.0 0.0))
      0.0
      (itoa idx)
    )
  )
  (vlax-put mtxt 'normal (vlax-get dim 'normal))
  (vlax-put
    mtxt
    'insertionpoint
    (mapcar
      '+
      (vlax-get dim 'textposition)
      (trans
        (polar
          '(0.0 0.0 0.0)
          (+ (/ pi 2.0) ang)
          (* 2.0 (vla-get-textheight dim))
        )
        (vlax-get dim 'normal)
        0
        T
      )
    )
  )
  (vlax-put mtxt 'rotation ang)
  (vla-put-attachmentpoint mtxt 5)
  (vla-put-height mtxt (* 0.75 (vla-get-textheight dim)))
  (vla-put-layer mtxt *idxLyrNme*)
  mtxt
)

(defun DimToCsv_GetDimMtext (def / ret)
  (vlax-for obj def
    (if
      (and
        (not ret)
        (= "AcDbMText" (vla-get-objectname obj))
      )
      (setq ret obj)
    )
  )
  ret
)

(defun DimToCsv_UnformatStr (str) ; Very limited.
  (vl-string-subst "°" "%%d" (vl-string-subst "Ø" "%%c" str))
)

(defun DimToCsv_WriteCsv (fnm lst)
  (KGA_Data_FileWrite
    fnm
    (mapcar '(lambda (sub) (KGA_String_Join sub ",")) lst)
  )
)

(defun c:DimToCsv ( / blks doc fnm idx lst ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (or
        (= 1 (getvar 'worlducs))
        (prompt "\nError: the current UCS is not the WCS ")
      )
      (setq ss (ssget '((0 . "DIMENSION"))))
      (setq fnm (getfiled "CSV file" (getvar 'dwgprefix) "csv" 5))
    )
    (progn
      (vla-add (vla-get-layers doc) *idxLyrNme*)
      (setq blks (vla-get-blocks doc))
      (setq idx 0)
      (setq lst
        (vl-remove
          nil
          (mapcar
            '(lambda (enm / mtxt)
              (if (setq mtxt (DimToCsv_GetDimMtext (vla-item blks (cdr (assoc 2 (entget enm))))))
                (progn
                  (setq idx (1+ idx))
                  (DimToCsv_CreateIdxMtext (vlax-ename->vla-object enm) (vla-get-rotation mtxt) idx)
                  (list (itoa idx) (strcat "\"" (DimToCsv_UnformatStr (vla-get-textstring mtxt)) "\""))
                )
              )
            )
            (KGA_Conv_Pickset_To_EnameList ss)
          )
        )
      )
      (DimToCsv_WriteCsv fnm (cons '("\"NO.\"" "\"TEXT\"") lst))
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

sir, 

it is possible to add code in same lisp for text & mtext also to export in csv.

than it will be 3 in 1 lisp program.

1 dim text

2 text

3 mtext

 

thanks.

 

Link to comment
Share on other sites

  • 4 years later...
On 8/20/2019 at 11:21 AM, sudipta_1986 said:

HI 

VERRY GOOD LISP 

POSSIBLE EXPORT TO CLIPORT ???

AFTER SEVERAL TESTS I HAVE A PROBLEM WHEN I SELECT MORE THAN 2 DIMENSIONS
ERROR AROUND EXPRESSION (ENTGET EN )

Edited by DELLA MAGGIORA YANN
Link to comment
Share on other sites

Le 27/08/2019 à 06 :34, Ish a dit :

monsieur

Il est possible d’ajouter du code dans le même Lisp pour le texte et le textmult ainsi que pour exporter en CSV.

qu’il s’agira d’un programme 3 en 1 lisp.

1 texte en noir

2 Texte

3 mtext

 

merci.

 

BONJOUR SUPER LISP MERCI
SERAIT-IL POSSIBLE D’OUVRIR LE NOTEBOOK DIRECTEMENT APRÈS LA SAISIE SANS ÊTRE OBLIGÉ DE CRÉER UN NOUVEAU FICHIER

Link to comment
Share on other sites

Please post also in English

 

HELLO SUPER LISP THANK YOU
WOULD IT BE POSSIBLE TO OPEN THE NOTEBOOK DIRECTLY AFTER TYPING WITHOUT HAVING TO CREATE A NEW FILE

 

Just a comment you can open Word or Excel, possibly Libreoffice and create text with out a file being made.

 

If some one knows a correct call to application for either of these based on can be done, note not Open using Shell etc.

 

(setq myxl (vlax-get-or-create-object "notepad.Application"))

(setq myxl (vlax-get-or-create-object "wordpad.Application"))

; this is connect Word
(setq myword (vlax-get-or-create-object "word.Application"))
; #<VLA-OBJECT _Application 000000003F286068>

 

 

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...