REQUIRED LISP TO EXPORT DIM TEXT INTO EXCEL OR CSV FORMAT

August 25, 2019

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

August 26, 2019

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)
)

August 26, 2019

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.

August 26, 2019

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

August 27, 2019

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.

March 10

On 8/20/2019 at 11:21 AM, sudipta_1986 said:

Commande : DX

DIM-XL(dx).lsp 1.81 kB · 75 téléchargements

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 March 11 by DELLA MAGGIORA YANN

March 11

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

March 11

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>

Sign In

REQUIRED LISP TO EXPORT DIM TEXT INTO EXCEL OR CSV FORMAT

Recommended Posts

Khera

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Roy_043

Khera

BIGAL

Posted Images

Roy_043

Ish

Khera

Ish

DELLA MAGGIORA YANN

DELLA MAGGIORA YANN

BIGAL

Join the conversation

Roy_043

Khera

BIGAL

Tutorials

Forums

Activity