Jump to content

Recommended Posts

Posted

Dear Masters,

 

i have one lisp for exporting points. and i have cross checked in excel values differences and auto cad dimension.i observed many points with 0.01m differences. for example in auto cad drawing showing 1.71m, but by excel coordinate difference is 1.72. why it is showing 0.01m difference. please find my lisp and make a modification to produce exact points with nil differences.

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil

(defun LM:writecsv ( lst csv / des sep )
   (if (setq des (open csv "w"))
       (progn
           (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
           (foreach row lst (write-line (LM:lst->csv row sep) des))
           (close des)
           t
       )
   )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(defun LM:lst->csv ( lst sep )
   (if (cdr lst)
       (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
       (LM:csv-addquotes (car lst) sep)
   )
)

(defun LM:csv-addquotes ( str sep / pos )
   (cond
       (   (wcmatch str (strcat "*[`" sep "\"]*"))
           (setq pos 0)    
           (while (setq pos (vl-string-position 34 str pos))
               (setq str (vl-string-subst "\"\"" "\"" str pos)
                     pos (+ pos 2)
               )
           )
           (strcat "\"" str "\"")
       )
       (   str   )
   )
)

;; gc:distinct (gilles chanteau)
;; Suprime tous les doublons d'une liste
;;
;; Argument
;; l : une liste
(defun gc:distinct (l)
   (if l
       (cons (car l) (gc:distinct (vl-remove (car l) l)))
   )
)
(defun l-coor2l-pt (lst flag / )
   (if lst
       (cons
           (list
               (car lst)
               (cadr lst)
               (if flag
                   (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
                   (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
               )
           )
           (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
       )
   )
)
(defun c:ptdef2notepad ( / js dxf_cod mod_sel n lremov str_sep oldim ename l_pt l_pr pr l_x l_y tmp1 f_openx tmp2 f_openy)
 (princ "\nSelect model object for filtering: ")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "*LINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nIsn't an available object!")
 )
 (vl-load-com)
 (setq dxf_cod (entget (ssname js 0)))
 (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
   (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
 )
 (initget "Single All Manual")
 (if (eq (setq mod_sel (getkword "\nSelect mode, [single/All/Manual]<Manual>: ")) "Single")
   (setq n -1)
   (if (eq mod_sel "All")
       (setq js (ssget "_X" dxf_cod) n -1)
       (setq js (ssget dxf_cod) n -1)
   )
 )
 (setq
   str_sep " "  ;-> **** YOU CAN CHANGE THIS STRING BY WHAT YOU WONT ! **** <-
   oldim (getvar "dimzin")
 )
 (setvar "dimzin" 0)
 (repeat (sslength js)
   (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
   (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
   (foreach pr l_pr
     (if (vlax-property-available-p ename pr)
       (setq l_pt
         (if (or (eq pr 'Coordinates) (eq pr 'FitPoints))
           (append
             (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
               (l-coor2l-pt (vlax-get ename pr) nil)
               (if (and (eq pr 'FitPoints) (zerop (vlax-get ename 'FitTolerance)))
                 (l-coor2l-pt (vlax-get ename 'ControlPoints) T)
                 (l-coor2l-pt (vlax-get ename pr) T)
               )
             )
             l_pt
           )
           (append (l-coor2l-pt (vlax-get ename pr) T) l_pt)
         )
       )
     )
   )
 )
 (setq l_x (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'car l_pt) '<))))  ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** <-
 (setq l_y (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'cadr l_pt) '<))))  ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** <

 (cond
   (
    (< (length l_x) (length l_y))
    (while (< (length l_x) (length l_y))
      (setq l_x (append l_x '("")))
    ) ;_ >while
   )
   (
    (> (length l_x) (length l_y))
    (while (> (length l_x) (length l_y))
      (setq l_y (append l_y '("")))
    ) ;_ >while
   )
 ) ;_ >cond
 
 (setq    l_x (append '("x") l_x)
   l_y (append '("y ") l_y)
 ) ;_ >setq
    
 (setq fn (getfiled "Create Output File" "" "csv" 1))
 (if (LM:WriteCSV (mapcar '(lambda (x y) (list x y))l_x l_y) fn)
   (startapp "explorer" fn)
 )  
 
;;;  (setq
;;;    tmp1 (vl-filename-mktemp "tmp_x.csv")
;;;    f_openx (open tmp1 "w")
;;;  )
;;;  (mapcar '(lambda (x) (write-line x f_openx)) l_x)
;;;  ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_x)) f_openx)
;;;  (close f_openx)
;;;  (startapp "notepad" tmp1)
;;;  (setq
;;;    tmp2 (vl-filename-mktemp "tmp_y.csv")
;;;    f_openy (open tmp2 "w")
;;;  )
;;;  (mapcar '(lambda (y) (write-line y f_openy)) l_y)
;;;  ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_y)) f_openy)
;;;  (close f_openy)

 (startapp "notepad" tmp2)
 (setvar "dimzin" oldim)
 (prin1)
)

 

please find sample drawing and output values excel file.

Error is 0.01.dwg

error 0.01.xlsx

Posted

Could it have anything to do with the precision you have specified back in AutoCAD for your units?

Posted
Could it have anything to do with the precision you have specified back in AutoCAD for your units?

 

Dear sir,

Thank you for your kind response.yes sir i have used -DWGUNITS command. with 2 digits precision.

 

 

Thanking you,

Best regards.

Posted

The difference comes about because the coordinates exported to the csv file have been rounded, whereas the coordinates in AutoCAD have not been rounded.

 

If you work like that, you have to expect slight differences.

 

The coordinates in AutoCAD to 4 decimal places are 9.9822 and 11.6967, which when subtracted give 1.7145 and when rounded give 1.71, (confirmed by dimension).

 

The figures in Excel are 9.98 and 11.70, which when subtracted give 1.72.

Posted

Oh, i need 2 decimal places coordinates like 1.71 and figures in excel also 1.71. how it is possible? any lisp routine? kindly suggest.

Posted

Change both of these:

(rtos (/ x 1.0) 2 2)

to:

(rtos x 2 

And then round in Excel following the calculation.

Posted

Dear Lee Mac,

Thank you for your kind reply.with help of your modification at auto cad coordinate value showing again more than 3 digits like a "9.9822". but i need to discover coordinate to be set to 9.98 (round off to 2 digit precision) and same exact coordinate values should be exported to CSV. any lisp routine or lisp modification?

 

Thanking you,

Best regards.

Posted

I think that you will have to format cells in Excel to show 2 decimal places. Then when you save to a csv file, the numbers will be as you require.

CellFormat.PNG

Posted
I think that you will have to format cells in Excel to show 2 decimal places. Then when you save to a csv file, the numbers will be as you require.

Dear Eldon,

thank you for response. i know about formatting of cells for 2 digits.

 

i am trying for same in auto cad for 2 digits precision drawing. because i want to export my drawing to another software.there is not coincide my export excel drawing points and auto cad drawing. so please try for auto cad scaling from 4 digits to 2 digits precision and these should match auto cad coordinates and Export CSV points should be same. please find Post#1 in this thread.

 

Thanking you,

Best regards.

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