can you speed up my lisp

[Tomislav]

Hello everyone. I have this little lisp for inserting points that I made but it's painfully slow.

So can someone optimize it?

 

(DEFUN C:plo (/ f name coords textline textposition code fonth dec note
              code_y code_x text_y note_x)

  
  (defun *error* (msg)
    (close f)
    (princ msg)
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO cmd)
    (setvar 'DIMZIN dzim)    
    )

  
  (vl-load-com)
  (setq cmd(getvar 'CMDECHO)
        osm (getvar 'OSMODE)
        dzim(getvar 'DIMZIN)
        )
  (setvar 'CMDECHO 0)
  (setvar 'PDMODE 34)
  (setvar 'DIMZIN 0) 
  (setq coord_y nil
	coord_x nil
	coord_z nil
	code nil
	name nil
	fonth nil
	textline nil
        dec nil
        code_y nil
        code_x nil
        text_y nil
        note nil
        note_x nil) 
  (setq f (open (getfiled "Coordinate File" (getvar 'DWGPREFIX) "txt" 4) "r"))
  (initget "Y N")
  (or(setq coord_name(getkword"\nDo points in coordinate file have names? [<Yes>/No] :"))
     (setq coord_name "Y")
     )
  (setq fonth (getreal "\nEnter text height: "))
  (setvar 'PDSIZE (/ fonth 2))
  (setq dec(getint"\nEnter number of decimal places to round coords: "))
  (command "-style" "°Point text" "swisscl.ttf" fonth 1 "" "" "" )
  (if (not (tblsearch "LAYER" "°Point NUM"))
    (vl-cmdf "-layer" "n" "°Point NUM" "c" "3" "°Point NUM" "")
    )
  (if (not (tblsearch "LAYER" "°Point H"))
    (vl-cmdf "-layer" "n" "°Point H" "c" "2" "°Point H" "")
    )
  (if (not (tblsearch "LAYER" "°Point CODE"))
    (vl-cmdf "-layer" "n" "°Point CODE" "c" "1" "°Point CODE" "")
    )
  (if (not (tblsearch "LAYER" "°Point NOTE"))
    (vl-cmdf "-layer" "n" "°Point NOTE" "c" "8" "°Point NOTE" "")
    )
  (if (not (tblsearch "LAYER" "°Point2D"))
    (vl-cmdf "-layer" "n" "°Point2D" "c" "7" "°Point2D" "")
    )
  (if (not (tblsearch "LAYER" "°Point3D"))
    (vl-cmdf "-layer" "n" "°Point3D" "c" "5" "°Point3D" "")
    )
  (while (setq textline (read-line f))
    (if (= textline "")
      (progn
	(alert"Error in coordinate file, aborting !!")
	(close f)
	(quit)
	)
      )   
    (setq textline(vl-string-right-trim "," textline)) 
    (if (= coord_name "Y")
      (setq name (substr textline 1(vl-string-position (ascii ",") textline)))
      (setq name "")
      )
    (setq textline(vl-string-left-trim name textline)
    	  textline(vl-string-left-trim "," textline)
          coord_y(substr textline 1 (vl-string-position (ascii ",") textline))
          textline (substr textline (+(strlen coord_y)2) (strlen textline))
          coord_x(substr textline 1 (vl-string-position (ascii ",") textline))
          textline (substr textline (+(strlen coord_x)2) (strlen textline))
          coord_z(substr textline 1 (vl-string-position (ascii ",") textline))
          textline (substr textline (+(strlen coord_z)2) (strlen textline))
          code(substr textline 1 (vl-string-position (ascii ",") textline))
          code_2(substr code 1 2)
          note (substr textline (+(strlen code)2) (strlen textline))
          coord_y(rtos(distof coord_y 2)2 dec)
          coord_x(rtos(distof coord_x 2)2 dec)
          coord_z(rtos(distof coord_z 2)2 dec)          
          tekst_y(rtos(+(distof coord_y 2)(* fonth 0.3))2 dec)   
          height_x(rtos(-(-(distof coord_x 2)(* fonth 0.2))fonth)2 dec)          
          )
    (if (and
          (or(= code_2 "48")(= code_2 "49"))
          (/= (substr code 3 2) "")
          )
      (setq note (substr code 3 2)
            code code_2
            )
      )
    (setq code_y(rtos(-(distof coord_y 2)(* fonth 0.35)(* fonth 0.6 (strlen code)))2 dec)
          note_y(rtos(-(distof coord_y 2)(* fonth 0.35)(* fonth 0.6 (strlen note)))2 dec)         
          )
    (setvar "osmode" 0)
    (if (= coord_name "Y")
      (progn
	(vl-cmdf "-layer" "s" "°Point NUM" "")
	(vl-cmdf "text" (strcat tekst_y "," coord_x)  "0" name)
	)
      )
    (vl-cmdf "-layer" "s" "°Point H" "")
    (vl-cmdf "text" (strcat tekst_y "," height_x)  "0" coord_z)
    (vl-cmdf "-layer" "s" "°Point CODE" "")
    (vl-cmdf "text" (strcat code_y "," coord_x)  "0" code)
    (vl-cmdf "-layer" "s" "°Point NOTE" "")
    (vl-cmdf "text" (strcat note_y "," height_x)  "0" note)
    (vl-cmdf "-layer" "s" "°Point3D" "")
    (vl-cmdf "point" (strcat coord_y "," coord_x "," coord_z))
    (vl-cmdf "-layer" "s" "°Point2D" "")
    (vl-cmdf "point" (strcat coord_y "," coord_x))
    (vl-cmdf "-layer" "off" "°Point3D" "")
    (setq coord_y nil
	  coord_x nil
	  coord_z nil
	  code nil
          textline nil
	  name nil)
  )
  (vl-cmdf "_.zoom" "_e")
  (close f)
  (setvar 'OSMODE osm)
  (setvar 'DIMZIN dzim)
  (setvar 'CMDECHO cmd)
  (princ)
)

 

[dlanorh]

I am assuming that the text file is a CSV file format pt num/name, N, E, Z, code, note. It would be easier if you supplied a small sample file text file and a sample drawing (saved as AutoCAD 2010 or lower for me) showing the required information as processed.

 

Why two layers Point2D and Point3D, when you never ask if you want a 2D or 3D point?

[Tomislav]

Yes, the format is right and now I attached input file.

I need 2d and 3d because I use them intermittently.  

When u run it through lisp you get result after 15sec.

PUNITOVCI 020419.txt

Edited November 13, 2019 by Tomislav

[dlanorh]

39 minutes ago, Tomislav said:

Yes, the format is right and now I attached input file.

I need 2d and 3d because I use them intermittently.  

When u run it through lisp you get result after 15sec.

PUNITOVCI 020419.txt 45.41 kB · 2 downloads

 

I need to know how this looks when you import the file into autocad eg a sample drawing of an imported point saved in autoCAD 2010 format.

[rlx]

Like dlanorh #metoo have a little bit difficulty understanding how to interpret your data file. If i'm correct your have 2 flavors :

 

19P,649155.550,5033239.480,0.000,,
5625,649203.409,5034432.575,93.975,182727,

 

first line is item with a name (19P) + x y z + ,

second line is ? + x y z + ?

 

so first type actually contains 4 items :  (19P 649155.550 5033239.480 0.000)

and second line contains 5 items         :  (5625 649203.409 5034432.575 93.975 182727)

Edited November 13, 2019 by rlx

[Jonathan Handojo]

Well, first of all, try not to use vl-cmdf or command. This will really slow you down for sure. 

 

For example, in making new layers, you can create a list of dotted pairs, and then run mapcar to iterate through each one: 

(setq acadobj (vlax-get-acad-object)
      adoc (vla-get-ActiveDocument acadobj)
      msp (vla-get-ModelSpace adoc)
      layer_color
       (list
	 '("°Point NUM" . 3)
	 '("°Point H" . 2)
	 '("°Point CODE" . 1)
	 '("°Point NOTE" . 8)
	 '("°Point 2D" . 7)
	 '("°Point 3D" . 5)
	 )
      )

(mapcar
  '(lambda (i)
     (if (not (tblsearch "Layer" (car i)))
       (vla-put-Color (vla-Add (vla-get-layers adoc) (car i)) (cdr i)))
     )
  layer_color
  )

 

And here is an example that you can iterate through commas to save you coding space and time:

 

(setq text "12,23,34,45,56,67,89,"
      between_commas nil)

(while (vl-string-search "," text)
  (setq between_commas (cons (substr text 1 (vl-string-search "," text)) between_commas)
	text (substr text (+ 2 (vl-string-search "," text))))
  )

(setq between_commas (reverse between_commas))

 

Result is between_commas each in a list. You can even do the same with the variables. After which, you can do (mapcar 'cons variable text) or other lambda functions other than cons. 

 

Last but not least:

 

(setq text_height 10 ; assumed, can change to suit
      combinations
       (list
	 (list "°Point H" (list tekst_y height_x 0) coord_z)
	 (list "°Point CODE" (list code_x coord_x 0) code)
	 (list "°Point NOTE" (list note_y height_x 0) note)
	 )
      )

(mapcar
  '(lambda (x)
     (vla-put-layer (vla-AddText msp (caddr x) (apply 'vlax-3D-Point (cadr x)) text_height) (car x)))
  combinations
  )

 

Hopefully that helps with speeding you up some.

 

Thanks

Jonathan Handojo

 

[dlanorh]

54 minutes ago, rlx said:

Like dlanorh #metoo have a little bit difficulty understanding how to interpret your data file. If i'm correct your have 2 flavors :

 

19P,649155.550,5033239.480,0.000,,
5625,649203.409,5034432.575,93.975,182727,

 

first line is item with a name (19P) + x y z + ,

second line is ? + x y z + ?

 

so first type actually contains 4 items :  (19P 649155.550 5033239.480 0.000)

and second line contains 5 items         :  (5625 649203.409 5034432.575 93.975 182727)

 

I'm assuming the lines with 4 items are actually survey stations (stn id,  coord list) and the lines with five items are surveyed points (pt number, coords list, point code), but without knowing the final format optimising the final format is problematic.

[Tomislav]

the format is:  point number/name,y,x,z,code,note (sometimes there's no code and most of time there's no note that's why it's ,, on the end)

and I included dwg

punitovci.dwg

Edited November 13, 2019 by Tomislav

[Jonathan Handojo]

Hmm, That looks like something you'd be better off by creating a dynamic block using that point with three different attributes, namely PointNUM, PointH, and PointCODE (for example). Your code would be so much shorter, faster, and more organised with that. By first creating one dynamic block, you can do:

 

(setq vblock (vla-InsertBlock msp (apply 'vlax-3D-Point pt) block_name 1 1 1 0))

 

where:

 

msp is as written in my previous post, or (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))

pt is a 3D point 

block_name is your block name

 

After which, you can have a look at Lee Mac's forum on Attribute Functions right here: http://www.lee-mac.com/attributefunctions.html

and use those to set the different attributes PointNUM, PointH, and PointCODE.

[Tomislav]

2 hours ago, Jonathan Handojo said:

Well, first of all, try not to use vl-cmdf or command. This will really slow you down for sure. 

 

For example, in making new layers, you can create a list of dotted pairs, and then run mapcar to iterate through each one: 

(setq acadobj (vlax-get-acad-object)
      adoc (vla-get-ActiveDocument acadobj)
      msp (vla-get-ModelSpace adoc)
      layer_color
       (list
	 '("°Point NUM" . 3)
	 '("°Point H" . 2)
	 '("°Point CODE" . 1)
	 '("°Point NOTE" . 8)
	 '("°Point 2D" . 7)
	 '("°Point 3D" . 5)
	 )
      )

(mapcar
  '(lambda (i)
     (if (not (tblsearch "Layer" (car i)))
       (vla-put-Color (vla-Add (vla-get-layers adoc) (car i)) (cdr i)))
     )
  layer_color
  )

 

And here is an example that you can iterate through commas to save you coding space and time:

 

(setq text "12,23,34,45,56,67,89,"
      between_commas nil)

(while (vl-string-search "," text)
  (setq between_commas (cons (substr text 1 (vl-string-search "," text)) between_commas)
	text (substr text (+ 2 (vl-string-search "," text))))
  )

(setq between_commas (reverse between_commas))

 

Result is between_commas each in a list. You can even do the same with the variables. After which, you can do (mapcar 'cons variable text) or other lambda functions other than cons. 

 

Last but not least:

 

(setq text_height 10 ; assumed, can change to suit
      combinations
       (list
	 (list "°Point H" (list tekst_y height_x 0) coord_z)
	 (list "°Point CODE" (list code_x coord_x 0) code)
	 (list "°Point NOTE" (list note_y height_x 0) note)
	 )
      )

(mapcar
  '(lambda (x)
     (vla-put-layer (vla-AddText msp (caddr x) (apply 'vlax-3D-Point (cadr x)) text_height) (car x)))
  combinations
  )

 

Hopefully that helps with speeding you up some.

 

Thanks

Jonathan Handojo

 

 

 

 

first part you suggested I inserted although it's creating layers just once so there's no significant speed increase.

second part I didn't inserted cause I must figure the way to get seperate parts of that text..

third part I inserted and added following, but my part is not working (as you can see I'm not that much into VLA)

    (setq put_points
             (list
               (list "°Point 3D" (list coord_y coord_x coord_z))
               (list "°Point 2D" (list coord_y coord_x 0))
             ) ;_  list
      ) ;_  setq
      (mapcar
        '(lambda (y)
           (vla-put-layer
             (vla-AddPoint msp               
               (apply 'vlax-3D-Point (cadr x))               
             ) ;_  vla-AddText
             (car y)
           ) ;_  vla-put-layer
         ) ;_  lambda
        put_points
      ) ;_  mapcar

 

[Tomislav]

4 minutes ago, Jonathan Handojo said:

Hmm, That looks like something you'd be better off by creating a dynamic block using that point with three different attributes, namely PointNUM, PointH, and PointCODE (for example). Your code would be so much shorter, faster, and more organised with that. By first creating one dynamic block, you can do:

 

(setq vblock (vla-InsertBlock msp (apply 'vlax-3D-Point pt) block_name 1 1 1 0))

 

where:

 

msp is as written in my previous post, or (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))

pt is a 3D point 

block_name is your block name

 

After which, you can have a look at Lee Mac's forum on Attribute Functions right here: http://www.lee-mac.com/attributefunctions.html

and use those to set the different attributes PointNUM, PointH, and PointCODE.

 

 

I can't use blocks cause I need all that numbers on the screen and in layers and also I never worked(lisp) with any blocks

[Jonathan Handojo]

6 minutes ago, Tomislav said:

(apply 'vlax-3D-Point (cadr x))

 

There's your error. 

 

Put 

(apply 'vlax-3D-Point (cadr y))

 

[Jonathan Handojo]

25 minutes ago, Tomislav said:

first part you suggested I inserted although it's creating layers just once so there's no significant speed increase.

second part I didn't inserted cause I must figure the way to get seperate parts of that text..

third part I inserted and added following, but my part is not working (as you can see I'm not that much into VLA)

 

The second part results in the separated parts of the text between the commas, resulted in between_commas, just that they're in a list, so you can say... the first item in the list is the pointID, the second item in the list is the y_Coordinate,....

 

Of course, it's always up to you to modify your routines. I'm just offering alternative ways.

 

Thanks,

Jonathan Handojo.

Edited November 13, 2019 by Jonathan Handojo

[Tomislav]

29 minutes ago, Jonathan Handojo said:

 

There's your error. 

 

Put 

(apply 'vlax-3D-Point (cadr y))

 

 

I've changed that but I get bad argument type??

[ronjonp]

I have not read this thread closely so excuse me if I'm way off .. that last error I'm assuming that that '(cadr y)' is a point?

 

If so then use:

(vlax-3D-Point (cadr y))

Although I'd use entmake as it's generally faster:

Quote

_$ 
Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

    (ENTMAKE (QUOTE ((0 . "point") (10 0...).....1609 / 3.16 <fastest>
    (vla-AddPoint MS (vlax-3d-point (QUO...).....5078 / 1.00 <slowest>

 
; 1 form loaded from #<editor "<Untitled-1> loading...">
_$ 

Have you seen Lee's point manager?

 

You could also use his readcsv function to bring your data in.

 

Simple example:

(defun c:foo (/ csv f)
  (if (and (setq f (getfiled "Select a CSV File" "" "csv" 16)) (setq csv (lm:readcsv f)))
    (foreach l csv
      ;; we have at least 4 items in the sublist
      (if (> (length l) 3)
	(entmakex (list	'(0 . "point")
			;; First item is layername ?
			(cons 8 (car l))
			;; Next 3 are X Y Z ?
			(cons 10 (list (atof (cadr l)) (atof (caddr l)) (atof (cadddr l))))
		  )
	)
      )
    )
  )
  (princ)
)
(princ)

 

Edited November 13, 2019 by ronjonp

[Tomislav]

yes, I have Lee's lisp but it's not quite what I need...

interesting benchmarking you got there...

 

Thank you ALL for help so far! 

[dlanorh]

Attached is my version of your lisp. It works on my system with your text file, the only modifications i've made is to give the 4 text items a justification. I cannot completely check this as I don't have the specified font on my system. Whether it is faster on your system I can't tell.

 

Hope this helps.

 

plo.lsp

[Tomislav]

2 hours ago, dlanorh said:

Attached is my version of your lisp. It works on my system with your text file, the only modifications i've made is to give the 4 text items a justification. I cannot completely check this as I don't have the specified font on my system. Whether it is faster on your system I can't tell.

 

Hope this helps.

 

plo.lsp 4.35 kB · 0 downloads

 

 

well, that is very fast..thank you..

now I'll need to understand it and tweak it

[dlanorh]

29 minutes ago, Tomislav said:

 

 

well, that is very fast..thank you..

now I'll need to understand it and tweak it

 

If you need help with anything let me know.

[rlx]

didn't had time to post this until now so assumed dlanorh would have posted by now (and he didn't dissapoint haha)

haven't looked at his code but I have no doubt it works just fine.

Here's mine anyway. I don't do anything with the precision in my code but it shouldn't be hard to implement.

(defun c:plo ( / coordinate-file-name coordinate-file-pointer sysvar-names sysvar-oldvalues
                 fonth coord_name dec textline data)
 
  (defun _init ()
    (vl-load-com)
    (setq sysvar-names
           (list (cons 'cmdecho 0)(cons 'dimzin 0)(cons 'osmode 0)(cons 'pdmode 34))
          sysvar-oldvalues (mapcar '(lambda (x)(getvar (car x))) sysvar-names))
    (mapcar '(lambda (x)(setvar (car x) (cdr x))) sysvar-names)
  )
 
  (defun _exit ()
    ; using this would also reset pdmode
    ;(mapcar '(lambda (x y)(setvar (car x) y)) sysvar-names sysvar-oldvalues)
    (if coordinate-file-pointer (close coordinate-file-pointer))
  )
 
  (defun *error* (msg) (princ msg) (_exit) (princ))

  ;;; main body
  (_init)
  (cond
    ((not (setq coordinate-file-name (getfiled "Coordinate File" (getvar 'DWGPREFIX) "txt" 4)))
     (princ "\nNo coordinate file selected"))
    ((not (setq coordinate-file-pointer (open coordinate-file-name "r")))
     (princ "\nUnable to read from coordinate file"))
    (t
     (initget "Y N")
     (or (setq coord_name (getkword "\nDo points in coordinate file have names? [<Yes>/No] :"))
         (setq coord_name "Y"))
     (setq fonth (getreal "\nEnter text height: "))
     (setvar 'PDSIZE (/ fonth 2.0))
     (setq dec (getint"\nEnter number of decimal places to round coords: "))
     (command "-style" "°Point text" "swisscl.ttf" fonth 1 "" "" "" )
     (check_layers)
     (while (setq textline (read-line coordinate-file-pointer))
       (setq data (SplitStr (vl-string-trim " ," textline) ","))
       (if (= (length data) 5) (place_point_with_code)(place_point_without_code))
     )
     (vl-cmdf "-layer" "off" "°Point3D" "")
    )
  )
  (vl-cmdf "_.zoom" "_e")
  (_exit)
  (princ)
)

(defun place_point_with_code ( / point-num x y z point-code)
  (mapcar '(lambda (name value)(set name value)) '(point-num x y z point-code) data)
  (place_point_entity (list (atof x) (atof y)))
  (place_point_num (list (atof x) (atof y)) point-num)
  (place_point_h (list (atof x) (atof y)) z)
  (place_point_code (list (atof x) (atof y)) point-code)
)

(defun place_point_without_code ( / point-num x y z)
  (mapcar '(lambda (name value)(set name value)) '(point-num x y z) data)
  (place_point_entity (list (atof x) (atof y)))
  (place_point_num (list (atof x) (atof y)) point-num)
  (place_point_h (list (atof x) (atof y)) z)
)

(defun place_point_entity (point)
  (entmakex (list (cons 0 "POINT") (cons 10 point) (cons 8 "°Point2D"))))

(defun place_point_num (point point-num / ip)
  (setq ip (polar point (* pi 0.45) (* fonth 0.5)))
  (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point NUM")
    (cons 10 ip) (cons 11 ip) (cons 40 fonth) (cons 72 0) (cons 73 2))))

(defun place_point_h (point point-h / ip)
  (setq ip (polar point (* pi -0.45) (* fonth 0.5)))
  (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point H")
    (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 0) (cons 73 2))))

(defun place_point_code (point point-code / ip)
  (setq ip (polar point (* pi 0.55) (* fonth 0.5)))
  (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point CODE")
    (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 2) (cons 73 2))))


(defun check_layers () (mapcar '(lambda (x) (create_layer (car x) (cadr x)))
  '(("°Point NUM" 3) ("°Point H" 2)("°Point CODE" 1)("°Point NOTE" 8)("°Point2D" 7)("°Point3D" 5))))

; n = name, c = color
(defun create_layer (n c) (if (and (snvalid n) (null (tblsearch "layer" n))) (entmake (list
  (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord")
    (cons 2 n) (cons 62 c) (cons 70 0) (cons 290 1)))))

;;; s = string d = delimiter p = position delimiter (thanx Lee Mac)
(defun SplitStr ( s d / p )
  (if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s)))