Author Topic: Polyline Direction  (Read 1792 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Guest
Polyline Direction
« on: December 12, 2021, 03:28:13 AM »
Hi . I am using this code to find the direction of the polyline. If the polyline is clockwise show red arrows unless show green arrows. Is it posssible only in case we have the red arrows to reverse the direction of the polyline?

Thanks


Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun c:pld (/ *error* VxV clockwise-p acDoc ms ss i e j p a c h s f r d)
  3.         ms (if
  4.                (eq (getvar 'cvport) 1)
  5.                (vla-get-paperspace acDoc)
  6.                (vla-get-modelspace acDoc)
  7.                )
  8.   )
  9.  
  10.   (defun *error* (m)
  11.     (and m (not (wcmatch (strcase m) "*CANCEL*,*EXIT*,*QUIT*")) (princ (strcat "\nError: " m)))
  12.     (vla-endundomark acDoc)
  13.     (princ)
  14.     )
  15.  
  16.   (defun VxV (a b)
  17.     (list (- (* (cadr a) (caddr b)) (* (caddr a) (cadr b)))
  18.           (- (* (caddr a) (car b)) (* (car a) (caddr b)))
  19.           (- (* (car a) (cadr b)) (* (cadr a) (car b)))
  20.     )
  21.   )
  22.   ;(clockwise-p ename)                         ;
  23.   ;argument:                                   ;
  24.   ;   e - ename of curve                       ;
  25.   ;       closed 2D curve in WCS               ;
  26.   ;return: T for clockwise curve               ;
  27.   ;----the pacman shape (and probably more)    ;
  28.   ;    doesn't work in acad2011                ;
  29.   ;A curve has the same orientation as an      ;
  30.   ;infinitesimal segment positioned around its ;
  31.   ;minima or maxima                            ;
  32.   ;Stefan M. 11.11.2013                        ;
  33.   (defun clockwise-p (e / p1 p2 p a b d f1 f2)
  34.     (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p2)
  35.       (mapcar '- (vlax-safearray->list p1) '(1 1 0))
  36.       '(1 0 0)
  37.    )
  38. )
  39.           a  (vlax-curve-getstartparam e)
  40.           b  (vlax-curve-getendparam e)
  41.           d  (if
  42.                (eq (cdr (assoc 0 (entget e))) "SPLINE")
  43.                 (* 0.01 (- b a))
  44.                 0.1
  45.              )
  46.           f1 (vlax-curve-getfirstderiv e (+ a (rem (+ p d) (- b a))))
  47.           f2 (vlax-curve-getfirstderiv e (+ a (rem (+ (- p d) (- b a)) (- b a))))
  48.     )
  49.     (minusp (caddr (VxV f2 f1)))
  50.   )
  51.   ;selfinters[ecting object]                   ;
  52.   ;argument:                                   ;
  53.   ;   o - vla-object                           ;
  54.   ;       CLOSED 2D curve in WCS               ;
  55.   ;return: T for selfintersecting curve        ;
  56.   ;Stefan M. 11.11.2013                        ;
  57.   (defun selfinters (o / a)
  58.     (or
  59.         (setq a (vl-catch-all-apply 'vlax-invoke (list ms 'addregion (list o))))
  60.       )
  61.       (vla-delete (car a))
  62.       )
  63.     )
  64.    
  65.  
  66.   (if
  67.     (setq ss (ssget '((0 . "*POLYLINE,SPLINE,LINE"))))
  68.      (progn
  69.        (setq h (* 0.05 (getvar 'viewsize)))
  70.        (repeat (setq i (sslength ss))
  71.          (setq e (ssname ss (setq i (1- i)))
  72.                c (cond ((and                         ;arrows color
  73.                           (vlax-curve-isplanar e)
  74.                           (vlax-curve-isclosed e)
  75.                           (not (selfinters (vlax-ename->vla-object e)))
  76.                         )
  77.                         (if (clockwise-p e) 1 3)     ;green if clocwise, red if not
  78.                        )
  79.                        ((if (< (car (vlax-curve-getstartpoint e)) (car (vlax-curve-getendpoint e))) 1 3))
  80.                        )
  81.                )
  82.          (if
  83.            (eq (cdr (assoc 0 (entget e))) "SPLINE")
  84.            (setq s (vlax-curve-getstartparam e)      ;start curve
  85.                  f (vlax-curve-getendparam e)
  86.                  j 10                     ;10 arrows on a single spline
  87.                  d (/ (- f s) j)                     ;segment "length" (in paramter units)
  88.                  )
  89.            (setq s 0.0
  90.                  j (fix (vlax-curve-getendparam e))  ;1 arrow per segment for polylines
  91.                  d 1.0
  92.                  )
  93.            )
  94.          (repeat j
  95.            (setq j (1- j)
  96.                  r (+ s (* j d) (* 0.5 d))           ;current parameter
  97.                  p (vlax-curve-getpointatparam e r)
  98.                  a ((lambda (d) (atan (cadr d) (car d))) (vlax-curve-getfirstderiv e r))
  99.            )
  100.            (grdraw p (polar p (+ a (* pi 0.9)) h) c)
  101.            (grdraw p (polar p (- a (* pi 0.9)) h) c)
  102.          )
  103.        )
  104.      )
  105.   )
  106.  
  107.   (vla-endundomark acDoc)
  108.   (princ)
  109. )
  110.  
  111.  
  112.  


zak26

  • Newt
  • Posts: 33
Re: Polyline Direction
« Reply #2 on: December 12, 2021, 09:44:30 AM »
What I usually do to reverse a polyline direction is the following, hope it helps
Code: [Select]
(vl-cmdf "_.pedit" e "_r" "")

PM

  • Guest
Re: Polyline Direction
« Reply #3 on: December 12, 2021, 11:18:50 AM »
 Hi zak26 and mhupp. I know the reverse command ,but i don't know how to write

if is red then reverse the polyline. In this way i skip to go to modify menu to reverse it

Thanks

mhupp

  • Bull Frog
  • Posts: 250
Re: Polyline Direction
« Reply #4 on: December 12, 2021, 01:57:46 PM »
Read the notes in the lisp.

Code - Auto/Visual Lisp: [Select]
  1.   ;(clockwise-p ename)                         ;
  2.   ;argument:                                   ;
  3.   ;   e - ename of curve                       ;
  4.   ;       closed 2D curve in WCS               ;
  5.   ;return: T for clockwise curve               ;

line 83  (if (clockwise-p e) 1 3)     ;green if clocwise, red if not


Maybe run this before the other code or at the start.
Code - Auto/Visual Lisp: [Select]
  1. ;;----------------------------------------------------------------------------;;
  2. ;; Flips Backwards ploylines
  3. (defun C:SWAP (/ SS)
  4.   (setq SS (ssget "_X" '((210 0.0 0.0 -1.0))))
  5.   (if (/= SS nil)
  6.     (progn
  7.       (prompt (strcat "\nEntities Swapped: " (itoa (sslength SS))))
  8.       (vl-cmdf "_.Mirror3d" SS "" "xy" "0,0,0" "y")
  9.     )
  10.     (prompt "\nNothing to Swap!")
  11.   )
  12.   (princ)
  13. )

« Last Edit: December 12, 2021, 02:02:55 PM by mhupp »

PM

  • Guest
Re: Polyline Direction
« Reply #5 on: December 12, 2021, 03:38:16 PM »
Thanks mhupp

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Polyline Direction
« Reply #6 on: December 12, 2021, 05:03:03 PM »
Just a side note Autocad has "Reverse" as a command but Bricscad does not so what about a Line ?

Code: [Select]
(defun c:rt ( / oldsnap pt1 pt2 obj ana)
(setq oldsnap (getvar 'osmode))
  (setvar "osmode" 0)
  (while
    (setq ss (ssget "+.E:S:" (list (cons 0 "*line"))))
    (if (= ss nil)
      (alert "You have not picked \nPline or \nLine")
      (progn
       (setq obj (vlax-ename->vla-object (ssname ss 0)))
       (if (= (vla-get-ObjectName obj) "AcDbLine")
       (progn
         

         (vlax-put-property obj 'startpoint pt2)
         (vlax-put-property obj 'endpoint pt1)
        )
        (command "pedit" (ssname ss 0) "R" "")
       )
      )
  )
  )
  (setvar "osmode" oldsnap)
  (princ)
)
A man who never made a mistake never made anything

PM

  • Guest
Re: Polyline Direction
« Reply #7 on: December 12, 2021, 05:42:52 PM »
Nobody understand what i ask for.  I ask to include the autocad reverse command in the code of the first post .If the arrows is red then reverse the polyline.

Thanks

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8662
  • AKA Daniel
Re: Polyline Direction
« Reply #8 on: December 12, 2021, 07:17:31 PM »
Maybe check the vertex segments, if more are clockwise,
if the cross product of AB and AC are co-directional to the normal of the plane, then it should be clockwise.

I have no idea how to do this in lisp  :mrgreen:

mhupp

  • Bull Frog
  • Posts: 250
Re: Polyline Direction
« Reply #9 on: December 12, 2021, 08:04:12 PM »
Nobody understand what i ask for.  I ask to include the autocad reverse command in the code of the first post .If the arrows is red then reverse the polyline.

Thanks

Update line 83 of your original code

zak26

  • Newt
  • Posts: 33
Re: Polyline Direction
« Reply #10 on: December 13, 2021, 09:29:50 AM »
Nobody understand what i ask for.  I ask to include the autocad reverse command in the code of the first post .If the arrows is red then reverse the polyline.

Thanks
Just as Mhupp just said it's easy, you just have to do this
Code: [Select]
(defun c:pld2 (/ *error* VxV clockwise-p acDoc ms ss i e j p a c h s f r d)
  (vl-load-com)
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
        ms (if
               (eq (getvar 'cvport) 1)
               (vla-get-paperspace acDoc)
               (vla-get-modelspace acDoc)
               )
  )
  (vla-startundomark acDoc)
 
  (defun *error* (m)
    (and m (not (wcmatch (strcase m) "*CANCEL*,*EXIT*,*QUIT*")) (princ (strcat "\nError: " m)))
    (vla-endundomark acDoc)
    (princ)
    )
 
  (defun VxV (a b)
    (list (- (* (cadr a) (caddr b)) (* (caddr a) (cadr b)))
          (- (* (caddr a) (car b)) (* (car a) (caddr b)))
          (- (* (car a) (cadr b)) (* (cadr a) (car b)))
    )
  )
  ;(clockwise-p ename)                         ;
  ;argument:                                   ;
  ;   e - ename of curve                       ;
  ;       closed 2D curve in WCS               ;
  ;return: T for clockwise curve               ;
  ;----the pacman shape (and probably more)    ;
  ;    doesn't work in acad2011                ;
  ;A curve has the same orientation as an      ;
  ;infinitesimal segment positioned around its ;
  ;minima or maxima                            ;
  ;Stefan M. 11.11.2013                        ;
  (defun clockwise-p (e / p1 p2 p a b d f1 f2)
    (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p2)
    (setq p  (vlax-curve-getparamatpoint e
   (vlax-curve-getclosestpointtoprojection e
      (mapcar '- (vlax-safearray->list p1) '(1 1 0))
      '(1 0 0)
   )
)
          a  (vlax-curve-getstartparam e)
          b  (vlax-curve-getendparam e)
          d  (if
               (eq (cdr (assoc 0 (entget e))) "SPLINE")
                (* 0.01 (- b a))
                0.1
             )
          f1 (vlax-curve-getfirstderiv e (+ a (rem (+ p d) (- b a))))
          f2 (vlax-curve-getfirstderiv e (+ a (rem (+ (- p d) (- b a)) (- b a))))
    )
    (minusp (caddr (VxV f2 f1)))
  )
  ;selfinters[ecting object]                   ;
  ;argument:                                   ;
  ;   o - vla-object                           ;
  ;       CLOSED 2D curve in WCS               ;
  ;return: T for selfintersecting curve        ;
  ;Stefan M. 11.11.2013                        ;
  (defun selfinters (o / a)
    (or
      (vl-catch-all-error-p
        (setq a (vl-catch-all-apply 'vlax-invoke (list ms 'addregion (list o))))
      )
      (vla-delete (car a))
      )
    )
   
 
  (if
    (setq ss (ssget '((0 . "*POLYLINE,SPLINE,LINE"))))
     (progn
       (setq h (* 0.05 (getvar 'viewsize)))
       (repeat (setq i (sslength ss))
         (setq e (ssname ss (setq i (1- i)))
               c (cond ((and                         ;arrows color
                          (vlax-curve-isplanar e)
                          (vlax-curve-isclosed e)
                          (not (selfinters (vlax-ename->vla-object e)))
                        )
                        (if (clockwise-p e) 1 3)     ;green if clocwise, red if not
                       )
                       ((if (< (car (vlax-curve-getstartpoint e)) (car (vlax-curve-getendpoint e))) 1 3))
                 )
         )
         (if (= c 1)
             (progn
                (vl-cmdf "_.pedit" e "_r" "")
        (setq c 3)
     )
         )
         (if
           (eq (cdr (assoc 0 (entget e))) "SPLINE")
           (setq s (vlax-curve-getstartparam e)      ;start curve
                 f (vlax-curve-getendparam e)
                 j 10                     ;10 arrows on a single spline
                 d (/ (- f s) j)                     ;segment "length" (in paramter units)
                 )
           (setq s 0.0
                 j (fix (vlax-curve-getendparam e))  ;1 arrow per segment for polylines
                 d 1.0
                 )
           )
         (repeat j
           (setq j (1- j)
                 r (+ s (* j d) (* 0.5 d))           ;current parameter
                 p (vlax-curve-getpointatparam e r)
                 a ((lambda (d) (atan (cadr d) (car d))) (vlax-curve-getfirstderiv e r))
           )
           (grdraw p (polar p (+ a (* pi 0.9)) h) c)
           (grdraw p (polar p (- a (* pi 0.9)) h) c)
         )
       )
     )
  )
 
  (vla-endundomark acDoc)
  (princ)
)
Now you won't see the Red arrows, and all of your polylines will be counter clockwise, you should try to modify your lisps.
And the command is now pld2
« Last Edit: December 13, 2021, 09:34:03 AM by zak26 »

mhupp

  • Bull Frog
  • Posts: 250
Re: Polyline Direction
« Reply #11 on: December 13, 2021, 11:14:01 AM »
Just as Mhupp just said it's easy, you just have to do this

Nice Zak26 but was thinking more of a one line edit.
(if (clockwise-p e) (vl-cmdf "_.pedit" e "_r" ""))
before
(if (clockwise-p e) 1 3)

zak26

  • Newt
  • Posts: 33
Re: Polyline Direction
« Reply #12 on: December 14, 2021, 09:37:15 AM »
Nice Zak26 but was thinking more of a one line edit.
(if (clockwise-p e) (vl-cmdf "_.pedit" e "_r" ""))
before
(if (clockwise-p e) 1 3)
I was thinking something similar but in that line c is been setup, so you can't do something like that and also if you do that you leave c without a value so becomes an error

mhupp

  • Bull Frog
  • Posts: 250
Re: Polyline Direction
« Reply #13 on: December 14, 2021, 12:12:28 PM »
Code - Auto/Visual Lisp: [Select]
  1. (setq e (ssname ss (setq i (1- i)))
  2.       c (cond ((and                         ;arrows color
  3.                (vlax-curve-isplanar e)
  4.                (vlax-curve-isclosed e)
  5.                 (not (selfinters (vlax-ename->vla-object e)))
  6.                )
  7.                (if (clockwise-p e) (vl-cmdf "_.pedit" e "_r" ""))
  8.                (if (clockwise-p e) 1 3)     ;green if clocwise, red if not  ;it will always be 3 now maybe just change to (setq c 3)?
  9.               )
  10.               ((if (< (car (vlax-curve-getstartpoint e)) (car (vlax-curve-getendpoint e))) 1 3))
  11.         )
  12. )

What I was talking about. I need to be more articulate when posting.
Should have said add this line instead of edit