Jump to content

Changes requied for Notepad format by Lisp modification

pvsvprasad

By pvsvprasad
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pvsvprasad Contributor

pvsvprasad

Posted
Posted (edited)

Dear Experts,

i need changes in Notepad output file by Lisp program modification. with help of my lisp produced as attached file (File Name is Actual lisp format X coordinates) and i need the format of notepad file as attached file (File Name is Required Format X coordinates). please find these files and kindly modify present lisp program.i have attached sample files of X coordinates. modification required Y coordinates too.

 

My present Code is:

;; 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) ! **** <-
 (setq
   tmp1 (vl-filename-mktemp "tmp_x.csv")
   f_openx (open tmp1 "w")
 )
 (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")
 )
 (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)
)

Thanking you,

best regards.

Actual lisp format X coordinates.txt

Required Format X coordiantes.txt

Sample Drawing.dwg

Edited by pvsvprasad
Luís Augusto Enthusiast

Luís Augusto

Posted
Posted (edited)

Edited:

 

;; 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) ! **** <-
 (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)
)

 

I hope this code will help you.

 

Best Regards

Luís Augusto

Edited by Luís Augusto
pvsvprasad Contributor

pvsvprasad

Posted
  • Author
Posted

Thank you for your kind reply. your code getting error.please check.

 

thanking you,

with best regards.

pvsvprasad Contributor

pvsvprasad

Posted
  • Author
Posted

thank you master, now it is working good. my final request is, can you make for CSV file version? in CSV file version both X and Y Values should be in one file with different columns please find image for sample format.

 

Kindly make CSV file version.

 

Thanking you,

Best regards.

CSV Version.JPG

broncos15 Proficient

broncos15

Posted
Posted
thank you master, now it is working good. my final request is, can you make for CSV file version? in CSV file version both X and Y Values should be in one file with different columns please find image for sample format.

 

Kindly make CSV file version.

 

Thanking you,

Best regards.

Hint, look at the open function portion of the code, it would be good practice to mess around with it. Also, if you want a great example and good code to use when writing to a csv file, look at Lee Mac's code http://www.lee-mac.com/writecsv.html.
pvsvprasad Contributor

pvsvprasad

Posted
  • Author
Posted
Hint,

 

Dear sir,

Thank you for great guidance. i have no minimum idea about coding.

 

please suggest how to adopt LEEMac's code to Luís Augusto's code.

 

Thanking you,

With best wishes.

Luís Augusto Enthusiast

Luís Augusto

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

pvsvprasad Contributor

pvsvprasad

Posted
  • Author
Posted

 

 

Dear Expert,

Really well executed and worked well. thank you for preparing.

 

Thanking you very much,

 

 

With Best Wishes.

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.

×
 Share
Go to topic listing
×
×
  • Create New...