Counter Clockwise only close polyline

Code Red > AutoLISP (Vanilla / Visual)

(1/1)

PM:
Hi. Fro mthe code bellow i use PL-CCWA (CounterClockwise ALL). Is it possible to reverse only the close polyline ?

--- Code - Auto/Visual Lisp: ---(defun C:PL-CW()(Pl-CW-VVA "_:L" t));;;Clockwise(defun C:PL-CCW()(Pl-CW-VVA "_:L" nil));;;CounterClockwise(defun C:PL-CWA()(Pl-CW-VVA "_ALL" t));;;Clockwise ALL(defun C:PL-CCWA()(Pl-CW-VVA "_ALL" nil));;;CounterClockwise ALL(defun C:PLI-CCW()(Pl-CW-Irneb "_:L" nil));;;CounterClockwise Irneb version(defun C:PLI-CW()(Pl-CW-Irneb "_:L" t));;;Clockwise Irneb version (defun Pl-CW-Irneb ( mode what / int:i e1 res clk+ ss) ;;; posted Irneb ;;; url http://www.cadtutor.net/forum/showthread.php?59671-all-polylinienrichtungen-counterclockwise ;;; what - t Clockwise ;;; what - nil CounterClockwise ;;; mode - string for ssget "_:L" or "_ALL: (vl-load-com) (or *pl-activedoc* (setq *pl-activedoc* (vla-get-activedocument (vlax-get-acad-object)))) (vla-startundomark *pl-activedoc*) (princ (strcat "\n" (if what "Clockwise mode" "CounterClockwise mode") " Select Polyline")) (setq ss nil ss (ssget mode '((0 . "*POLYLINE")))) (setq int:i '-1 clk+ 0) (while (and ss (setq e1 (ssname ss (setq int:i (1+ int:i))))) (if (vlax-write-enabled-p (vlax-ename->vla-object e1)) ;_editable (if what ;;;Reverse CounterClockwise->Clockwise (if (PL-CounterClockWise-p e1)(progn (pl:geom-allpline-reverse e1) (setq clk+ (1+ clk+)) )) ;;;Reverse Clockwise->CounterClockwise (if (null (PL-CounterClockWise-p e1))(progn (pl:geom-allpline-reverse e1) (setq clk+ (1+ clk+)) )) ) ) ) (princ (strcat "\nCheck " (itoa int:i) " polyline.")) (princ "\n\t")(princ clk+)(princ (if what " \tCounterClockwise (reverse)" " \tClockwise (reverse)")) (princ "\n\t")(princ (- int:i clk+))(princ (if what " \tClockwise" " \tCounterClockwise")) (setq ss nil)(vla-endundomark *pl-activedoc*) (princ))(defun Pl-CW-VVA ( mode what / int:i e1 res clk+ ss) ;;; Posted VVA ;;; Url http://www.cadtutor.net/forum/showthread.php?59671-all-polylinienrichtungen-counterclockwise ;;; what - t Clockwise ;;; what - nil CounterClockwise (vl-load-com) (or *pl-activedoc* (setq *pl-activedoc* (vla-get-activedocument (vlax-get-acad-object)))) (vla-startundomark *pl-activedoc*) (princ (strcat "\n" (if what "Clockwise mode" "CounterClockwise mode") " Select Polyline")) (setq ss nil ss (ssget mode '((0 . "*POLYLINE")))) (setq int:i '-1 clk+ 0) (while (and ss (setq e1 (ssname ss (setq int:i (1+ int:i))))) (if what ;;;Reverse CounterClockwise->Clockwise (if (null(pl:clockwise-p e1))(progn (pl:geom-allpline-reverse e1) (setq clk+ (1+ clk+)) )) ;;;Reverse Clockwise->CounterClockwise (if (pl:clockwise-p e1)(progn (pl:geom-allpline-reverse e1) (setq clk+ (1+ clk+)) )) ) ) (princ (strcat "\nCheck " (itoa int:i) " polyline.")) (princ "\n\t")(princ clk+)(princ (if what " \tCounterClockwise (reverse)" " \tClockwise (reverse)")) (princ "\n\t")(princ (- int:i clk+))(princ (if what " \tClockwise" " \tCounterClockwise")) (setq ss nil)(vla-endundomark *pl-activedoc*) (princ))(defun pl:geom-allpline-reverse ( pl / pln ret) (if (= (type pl) 'VLA-OBJECT) (setq pln (vlax-vla-object->ename pl)) (setq pln pl)) (cond ((= (pl:dxf 0 (entget pln)) "LWPOLYLINE") (setq ret (pl:geom-LWpolyline-revers pln)))((= (pl:dxf 0 (entget pln)) "POLYLINE") (setq ret (pl:geom-polyline-revers pln)))(t (setq ret nil))) ret )(defun pl:geom-LWpolyline-revers ( lw / e x1 x2 x3 x4 x5 x6) (if (= (type lw) 'VLA-OBJECT) (setq lw (vlax-vla-object->ename lw))) (setq e (entget lw ))(foreach a1 e (cond ((= (car a1) 10) (setq x2 (cons a1 x2))) ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4))) ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3))) ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5))) ((= (car a1) 210) (setq x6 (cons a1 x6))) (t (setq x1 (cons a1 x1))) ) ;_ end of cond )(entmod (append(reverse x1)(append(apply(function append) (apply (function mapcar)(cons 'list (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ;_ end of list ) ;_ end of cons ) ;_ end of apply ) ;_ end of apply x6 ) ;_ end of append ) ;_ end of append ) ;_ end of entmod (entupd lw) ) ;_ end of defun(defun pl:geom-polyline-revers (ent_name / _dxf-code-data tmp_ent i poly_ent vert_ent vertex_list bulge_list start_width_list end_width_list )(if (= (type ent_name) 'VLA-OBJECT) (setq ent_name (vlax-vla-object->ename ent_name))) ;; Reverse "POLYLINE" (setq tmp_ent ent_name i 0 ) ;_ end of setq (setq bulge_list nil vertex_list nil start_width_list nil end_width_list nil) (while (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent))))) ;_ end of not (setq bulge_list (cons (pl:dxf 42 tmp_ent) bulge_list) vertex_list (cons (entget tmp_ent) vertex_list) start_width_list (cons (pl:dxf 40 tmp_ent) start_width_list ) ;_ end of cons end_width_list (cons (pl:dxf 41 tmp_ent) end_width_list) i (1+ i) ) ;_ end of setq ) ;_ end of while (setq bulge_list (append (cdr bulge_list) (list (car bulge_list))) start_width_list (append (cdr start_width_list) (list (car start_width_list)) ) ;_ end of append end_width_list (append (cdr end_width_list) (list (car end_width_list)) ) ;_ end of append i 0 bulge_list (mapcar '(lambda (x) (- 0 x)) bulge_list) tmp_ent ent_name poly_ent (cdr (entget tmp_ent '("*"))) ;;;Added to revers with XData poly_ent (subst (cons 40 (car end_width_list)) (assoc 40 poly_ent) poly_ent ) ;_ end of subst poly_ent (subst (cons 41 (last start_width_list)) (assoc 41 poly_ent) poly_ent ) ;_ end of subst ) ;_ end of setq (entmakex poly_ent) ; polyline (while (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent)))) ) ;_ end of not (progn (setq vert_ent (nth i vertex_list) vert_ent (subst (cons 40 (nth i end_width_list)) (assoc 40 vert_ent) vert_ent ) ;_ end of subst vert_ent (subst (cons 41 (nth i start_width_list)) (assoc 41 vert_ent) vert_ent ) ;_ end of subst vert_ent (subst (cons 42 (nth i bulge_list)) (assoc 42 vert_ent) vert_ent ) ;_ end of subst i (1+ i) ) ;_ end of setq (entmakex vert_ent) ) ;_ end of progn ) ;_ end of while (entmakex (cdr (entget tmp_ent))) ; seqend (entdel ent_name) (redraw (entlast)) (entlast)) ;_ end of defun(defun pl:dxf (code lst) (if (= (type lst) 'ENAME) (setq lst (entget lst))) (cdr (assoc code lst)) ) ;;; Function to test if polyline is counter-clock-wise;;; obj= vla-object / ename of the polyline;;; Result is nil if clockwise, T if counter-clockwise(defun PL-CounterClockWise-p (obj / ang ang1 ang2 angT param) (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj))) (setq param 1.5 angT 0.0 ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj 0.5)) ) (while (< param (vlax-curve-getEndParam obj)) (setq ang2 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj param))) (setq ang (- ang2 ang1)) (if (> (abs ang) pi) (setq ang (* (if (< ang 0.0) -1.0 1.0) (- (abs ang) (* pi 2)))) ) (setq angT (+ angT ang) ang1 ang2 param (1+ param) ) ) (>= angT 0.0))(defun pl:clockwise-p ( lw / LST MAXP MINP)(if (= (type lw) 'ENAME) (setq lw (vlax-ename->vla-object lw))) (vla-GetBoundingBox lw 'MinP 'MaxP)(setqminp(vlax-safearray->list minp)MaxP(vlax-safearray->list MaxP)lst(mapcar(function(lambda(x)(vlax-curve-getParamAtPoint lw(vlax-curve-getClosestPointTo lw x))))(list minp(list(car minp)(cadr MaxP))MaxP(list(car MaxP)(cadr minp)))))(if(or(<=(car lst)(cadr lst)(caddr lst)(cadddr lst))(<=(cadr lst)(caddr lst)(cadddr lst)(car lst))(<=(caddr lst)(cadddr lst)(car lst)(cadr lst))(<=(cadddr lst)(car lst)(cadr lst)(caddr lst))) t nil))(princ "\nType Pl-CW, PL-CWA (ClockWise) or PL-CCW, PL-CCWA (CounterClockWise) in command line")(princ "\nFor difficult cases with a polyline use PlI-CW (ClockWise) or PLI-CCW (CounterClockWise) in command line")(princ)

Thanks

mhupp:
if you modified the The original code to only work on closed polylines it would affect the other commands to only work with closed polylines as well.
I made this to build a selection set of only closed polylines and feed it to the direction checker. if true use their reverse command. So keep the other lisp loaded.

--- Code - Auto/Visual Lisp: ---(Defun C:CCWALL (/ SS) (if (setq SS (ssget "_A" '((0 . "*POLYLINE") (70 . 1)))) (foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (if (pl:clockwise-p e1) (pl:geom-allpline-reverse e1) ) ) ))

PM:
Thanks mhupp . I use the code works fine

Navigation

[0] Message Index

Go to full version