Jump to content
Khera

REQUIRED LISP TO EXPORT DIM TEXT INTO EXCEL OR CSV FORMAT

Recommended Posts

Khera
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

Share this post


Link to post
Share on other sites
Roy_043

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

Share this post


Link to post
Share on other sites
Ish
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.

Share this post


Link to post
Share on other sites
Khera
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

Share this post


Link to post
Share on other sites
Ish
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.

 

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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