LSP to set multiple polygons direction to clockwise

[grouch19]

Hi guys,

 

I have a bunch of DWG's with random polygons which have been collected for a mapping project in an anti clockwise direction.

 

I need all the polygons to close off in a clockwise direction.

 

I had been checking the direction with PEDIT then reversing as necessary however I have thousands of polygons to check and was curious to see if there was a way to change the directions of all polygons to clockwise?

 

If all my polygons were incorrect i could just reverse all of them however only certain ones are incorrect.

 

Any thoughts would be appreciated

 

Cheers

[GP_]

Try this:

 

 
(defun c:test ( / sel poly rpoly n sing)
   (prompt "\nSelect LWPolylines:")
   (if (setq sel (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
       (progn
           (setq poly (ssadd)
                 rpoly 0)
           (repeat (setq n (sslength sel))
               (setq sing (ssname sel (setq n (1- n))))
               (if (verso_poly sing)
                   (setq poly (ssadd sing poly)
                         rpoly (1+ rpoly)
                   )
               )
           )  
           (command "_pedit" "_m" poly "" "_r" "" )
           (princ (strcat "\nN. " (itoa rpoly) " Polylines reversed (clockwise)."))
           (princ)
       )
   )
)

(defun verso_poly ( #1 / a_1 a_2 #1 )
   (setq #1 (vlax-ename->vla-object #1))
   (setq a_1 (vlax-curve-getArea #1))
   (vla-offset #1 0.0001)
   (setq a_2 (vlax-curve-getArea (entlast)))
   (entdel (entlast))
   (if (< a_1 a_2) t nil)
)
(vl-load-com)

 

 

To be completed with error Handling.

Do not select an exaggerated number of poly (stack overflow).

[marko_ribar]

Here is mine with help of Lee Mac's sub-function for clockwise list check...

 

;;; (LM:ListClockwise-p (lw3dpts (car (entsel "\nPick LWPOLYLINE to check clockwise orientation of its vertices projected on WCS")))) ;;;
;;; (LM:ListClockwise-p (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget (car (entsel "\nPick LWPOLYLINE to check clockwise orientation of its vertices in OCS of LWP")))))) ;;;

(defun c:setlwplsclockw ( / lw3dpts LM:ListClockwise-p transptwcs transptucs v^v mxv unit 
                           ss i ch pl 
                       )

 (defun unit ( v )
   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
 )

 (defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
 )

 (defun v^v ( u v )
   (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
 )

 (defun transptucs ( pt p1 p2 p3 / ux uy uz )
   (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
   (setq ux (unit (mapcar '- p2 p1)))
   (setq uy (unit (mapcar '- p3 p1)))
   
   (mxv (list ux uy uz) (mapcar '- pt p1))
 )

 (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
   (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
   (transptucs pt pt1n pt2n pt3n)
 )

 (defun LM:ListClockwise-p ( lst )
   (minusp 
     (apply '+ 
       (mapcar
         (function
           (lambda ( a b )
             (- (* (car b) (cadr a)) (* (car a) (cadr b)))
           )
         ) lst (cons (last lst) lst)
       )
     )
   )
 )

 (defun lw3dpts ( lwpol / lwdxf lwptl lwel ux uy uz ptlst )
   (if (and lwpol (= (cdr (assoc 0 (setq lwdxf (entget lwpol)))) "LWPOLYLINE"))
     (progn
       (setq lwptl (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) lwdxf))
       (setq lwptl (mapcar '(lambda ( x ) (cdr x)) lwptl))
       (setq lwel (cdr (assoc 38 lwdxf)))
       (setq lwptl (mapcar '(lambda ( x ) (list (car x) (cadr x) lwel)) lwptl))
       (setq uz (cdr (assoc 210 lwdxf)))
       (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
       (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
       (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
       (if (not uy) (setq uy (unit (v^v uz ux))))
       (setq ptlst (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) lwptl))
     )
     (prompt "\nNo lwpolyline picked")
   )
   ptlst
 )

 (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
 (setq i -1)
 (initget "WCS OCS")
 (setq ch (getkword "\nSet LWPOLYLINES clockwise viewed from (WCS / OCS) <OCS> : "))
 (if (eq ch "WCS")
   (progn
     (while (setq pl (ssname ss (setq i (1+ i))))
       (if (not (LM:ListClockwise-p (lw3dpts pl)))
         (command "_.pedit" pl "_R" "")
       )
     )
   )
   (progn
     (while (setq pl (ssname ss (setq i (1+ i))))
       (if (not (LM:ListClockwise-p (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget pl)))))
         (command "_.pedit" pl "_R" "")
       )
     )
   )
 )
 (princ)
)

(defun c:slwsclw nil (c:setlwplsclockw))
(prompt "\nInvoke with : slwsclw")
(princ)

Edited September 20, 2013 by marko_ribar

[GP_]

... with help of Lee Mac's sub-function for clockwise list check...

That is much better than my ...

[grouch19]

Thanks so much guys!

I'm relatively new to understanding LSP routines.

GP_ I am unsure of how to get yours to start? It's probably something simple that my 5am eyes are missing

 

Marko I got yours to run on some test polygons and it seems to be perfect of the polygons are all polylines which is fine.

However some of my polygons are 3dpolylines and it didn't work on those.

 

Is it possible to chnage it so it works on 3dpolylines also?

 

Thanks again for all your help guys!

 

Cheers

Dave

[GP_]

Is it possible to chnage it so it works on 3dpolylines also?

 

Type "test" to invoke.

 

(defun c:test ( / sel poly rpoly n sing)
   ;Gian Paolo Cattaneo 12.07.2013
   (prompt "\nSelect LWPolylines:")
   (if (setq sel (ssget '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
       (progn
           (setq poly (ssadd)
                 rpoly 0)
           (repeat (setq n (sslength sel))
               (setq sing (ssname sel (setq n (1- n))))
               (if (not (LM:ListClockwise-p (pl_coord sing)))
                   (setq poly (ssadd sing poly)
                         rpoly (1+ rpoly)
                   )
               )
           )  
           (command "_.pedit" "_m" poly "" "_r" "" )
           (princ (strcat "\nN. " (itoa rpoly) " Polylines reversed (clockwise)."))
           (princ)
       )
   )
)

;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
(defun LM:ListClockwise-p ( lst )
   (minusp
       (apply '+
           (mapcar
               (function
                   (lambda ( a b )
                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                   )
               )
               lst (cons (last lst) lst)
           )
       )
   )
)
(defun pl_coord (# / p m)
   (setq p (if (vlax-curve-IsClosed #)
               (fix (vlax-curve-getEndParam #))
               (1+ (fix (vlax-curve-getEndParam #)))
           )
   )
   (while (/= 0 p)
       (setq m (cons (trans (vlax-curve-getPointAtParam # (setq p (1- p))) 0 1) m))
   )
)
(vl-load-com)

 

 

Marko's code is more complete, also expects his intervention.

[marko_ribar]

Look here :

http://www.autolisp.com/forum/threads/832-setplsplclockw-lsp-another-length-of-post-problem-from-www-cadtutor-com?p=3088#post3088

 

M.R.

[Cad64]

It has come to our attention that headers are being stripped from other members code which is then being distributed without the authors consent and without proper acknowledgement to the original author of the code. Please refer to the code posting guidelines and always give credit where credit is due: http://www.cadtutor.net/forum/showthread.php?9184-Code-posting-guidelines

 

Please ensure that you have the right to publish code on a public forum. In most cases, the code you are publishing will be your own and it will be assumed that if no attribution is given, you are the author. However, if you are not the author, you must make this clear and where possible, give credit to the author. Any routines published here must have their header intact, including any title, instructions, author contact details, date and copyright information. If at all possible, please make sure that you have the the authors permission to publish their work.

Edited July 14, 2013 by Cad64
Added Quote