See the top rated post in this thread. Click here

Results 1 to 6 of 6

Thread: Slow LISP Routine 2019

  1. #1
    100 Club
    Join Date
    2005-12
    Location
    Columbus, OH
    Posts
    158
    Login to Give a bone
    0

    Default Slow LISP Routine 2019

    I created a program that finds all polylines and explodes them, then finds any non ortho line and changes the color to 2.
    At the moment the program is very slow in a large drawing (being 3000 objects) I'm hoping there is a way to speed the program up.
    The other thing I'm hoping to fix is in searching for non-straight lines, I only want lines the are not 0, 15 , 30, 45, 60, 90,...etc.. At the moment 45 degree lines change color. As I'm writing this post, I just thought maybe instead of just changing the color create a layer (0_NotStraight, Color 2) and move the non ortho line to said layer.

    The other problem I'm having is when I run the program it always says unknown command. I don't know why.

    Any help would be great and thank you in advance.
    Matt Hannan
    Attached Files Attached Files

  2. #2
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,714
    Login to Give a bone
    1

    Default Re: Slow LISP Routine 2019

    Code:
    (vl-load-com)
    
    (defun c:AAS (/ *error* rtd acDoc ok ss layerName oLayer)
    
      (defun *error* (msg)
        (if ss (vla-delete ss))
        (if acDoc
          (vla-endundomark acDoc)
        )
        (cond ((not msg))                                                   ; Normal exit
              ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
              ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
        )
        (princ)
      )
    
      (defun rtd (ang) (/ (* ang 180.0) pi))
    
      (if (= 2 (getvar 'cvport))                                            ; in model or active pviewport
        (progn
          (if (ssget "_X" '((0 . "LWPOLYLINE") (410 . "Model")))
            (progn
              (vla-startundomark
                (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
              )
              (setq ok T)
              (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
                (vla-explode x)
                (vla-delete x)
              )
              (vla-delete ss)
              (setq ss nil)
            )
          )
          (if (ssget "_X" '((0 . "LINE") (410 . "Model")))
            (progn
              (if (not ok)
                (vla-startundomark
                  (setq acDoc
                         (vla-get-activedocument (vlax-get-acad-object))
                  )
                )
              )
              (setq oLayer (vla-add (vla-get-layers acDoc)
                                    (setq layerName "0_NotStraight")
                           )
              )
              (vla-put-color oLayer acyellow)
              (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
                (if
                  (not (vl-position
                         (atof (rtos (rtd (vla-get-angle x)) 2 2))
                         '(0.0 15.0 30.0 45.0 60.0 90.0)
                         ;; ^^ more angles here? ^^
                       )
                  )
                   (vl-catch-all-apply 'vla-put-layer (list x layerName))   ; assumes unlocked layers
                )
              )
            )
          )
        )
        (prompt "\n** Command not allowed in paper space ** \n")
      )
    
      (*error* nil)
    )
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  3. #3
    100 Club
    Join Date
    2005-12
    Location
    Columbus, OH
    Posts
    158
    Login to Give a bone
    0

    Default Re: Slow LISP Routine 2019

    Quote Originally Posted by BlackBox View Post
    Code:
    (vl-load-com)
    
    (defun c:AAS (/ *error* rtd acDoc ok ss layerName oLayer)
    
      (defun *error* (msg)
        (if ss (vla-delete ss))
        (if acDoc
          (vla-endundomark acDoc)
        )
        (cond ((not msg))                                                   ; Normal exit
              ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
              ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
        )
        (princ)
      )
    
      (defun rtd (ang) (/ (* ang 180.0) pi))
    
      (if (= 2 (getvar 'cvport))                                            ; in model or active pviewport
        (progn
          (if (ssget "_X" '((0 . "LWPOLYLINE") (410 . "Model")))
            (progn
              (vla-startundomark
                (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
              )
              (setq ok T)
              (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
                (vla-explode x)
                (vla-delete x)
              )
              (vla-delete ss)
              (setq ss nil)
            )
          )
          (if (ssget "_X" '((0 . "LINE") (410 . "Model")))
            (progn
              (if (not ok)
                (vla-startundomark
                  (setq acDoc
                         (vla-get-activedocument (vlax-get-acad-object))
                  )
                )
              )
              (setq oLayer (vla-add (vla-get-layers acDoc)
                                    (setq layerName "0_NotStraight")
                           )
              )
              (vla-put-color oLayer acyellow)
              (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
                (if
                  (not (vl-position
                         (atof (rtos (rtd (vla-get-angle x)) 2 2))
                         '(0.0 15.0 30.0 45.0 60.0 75.0 90.0 105.0 120.0 135.0 150.0 165.0 180.0 195.0 210.0 225.0 240.0 255.0 270.0 285.0 300.0 315.0 330.0 345.0)
                         ;; ^^ more angles here? ^^
                       )
                  )
                   (vl-catch-all-apply 'vla-put-layer (list x layerName))   ; assumes unlocked layers
                )
              )
            )
          )
        )
        (prompt "\n** Command not allowed in paper space ** \n")
      )
    
      (*error* nil)
    )
    Thank you so much, this works great! I did add the other angles (see above).

    I'm seeing a error with zero angled lines, the program is changing some of the zero to the new layer even though the properties say it is zero.
    Any thoughts on why that would happen? Or is the line truly not a zero?

  4. #4
    All AUGI, all the time
    Join Date
    2010-06
    Posts
    962
    Login to Give a bone
    0

    Default Re: Slow LISP Routine 2019

    Hi,
    Something like this?
    Code:
    (defun c:Test (/ sel int ent vla rot)
      ;;--------------------------------------------;;
      ;;	Tharwat - Date: 22.Aug.2019		;;
      ;; Explode LWpolylines in Model space then 	;;
      ;; move the lines that are generated from 	;;
      ;; polylines to certain layer name if angle	;;
      ;; is not in the range of 15 Deg.		;;
      ;;--------------------------------------------;;
      (and (setq int -1 sel (ssget "_X" '((0 . "LWPOLYLINE")(410 . "Model"))))
           (or (tblsearch "LAYER" "0_NotStraight")
               (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "0_NotStraight") (62 . 2) (70 . 0)))
               )
           (while (setq int (1+ int) ent (ssname sel int))
             (and (vlax-write-enabled-p (setq vla (vlax-ename->vla-object (ssname sel int))))
                  (foreach lw (vlax-invoke vla 'Explode)
                    (and (= (vla-get-objectname lw) "AcDbLine")
                         (setq rot (angle (vlax-curve-getstartpoint lw) (vlax-curve-getendpoint lw)))
                         (foreach ang (list rot (+ rot pi))
                           (and (zerop (rem ang 15))
                                (vla-put-layer lw "0_NotStraight")
                                )
                           )
                         )
                    )
                  )
             )
           )
      (princ)
      ) (vl-load-com)

  5. #5
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,714
    Login to Give a bone
    0

    Default Re: Slow LISP Routine 2019

    Quote Originally Posted by mhannan.100562 View Post
    Thank you so much, this works great! I did add the other angles (see above).

    I'm seeing a error with zero angled lines, the program is changing some of the zero to the new layer even though the properties say it is zero.
    Any thoughts on why that would happen? Or is the line truly not a zero?
    You're welcome.

    Hard to know for sure - being that the the routine above converts the line's angle to a 2 decimal string (rtos), then back to a real value (atof), that would suggest your line's aren't really zero.
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  6. #6
    All AUGI, all the time
    Join Date
    2003-07
    Posts
    555
    Login to Give a bone
    0

    Default Re: Slow LISP Routine 2019

    Why explode the plines this could be a backwards step, if you have plines then get vertices and angle p1<->p2 stepping through the pline check for closed, angle p4<->p1 the poster has not mentioned arcs in the plines. Not sure about speed.

    Like wise the rtos needs a lot more dec places 45.000006 is not 45.00

    Code:
    (defun c:test ( /)
    (setq plent (entsel "Pick pline"))
    (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
    (setq x 0)
    (repeat (- (length co-ord) 1)
    (setq pt1 (nth x co-ord))
    (setq pt2 (nth (setq x (1+ x)) co-ord))
    (princ (strcat "\n" (rtos (angle pt1 pt2) 2 6)))
    (setq pt1 pt2)
    )
    )
    (c:test)
    Last edited by BIG-AL; 2019-08-23 at 07:30 AM.

Similar Threads

  1. Lisp program pausing for unknown reason AutoCad 2019
    By aaronashley1977783620 in forum AutoLISP
    Replies: 2
    Last Post: 2019-08-18, 12:56 PM
  2. Replies: 3
    Last Post: 2017-11-17, 06:06 PM
  3. Lisp routine in a Lisp routine
    By jayhay35365091 in forum AutoLISP
    Replies: 8
    Last Post: 2013-10-09, 02:30 PM
  4. Run Lisp Routine From Another Lisp Routine
    By mwilson in forum AutoLISP
    Replies: 7
    Last Post: 2013-07-25, 02:46 PM
  5. Slow.. slow..very slow..Gallery
    By engwaiphyo in forum AutoCAD Gallery
    Replies: 6
    Last Post: 2009-04-09, 07:32 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •