Author Topic: Counter Clockwise only close polyline  (Read 498 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Bull Frog
  • Posts: 383
Counter Clockwise only close polyline
« on: November 20, 2022, 11:55:57 AM »
Hi. Fro mthe code bellow i use PL-CCWA (CounterClockwise ALL). Is it possible to reverse only the close polyline ?

Code - Auto/Visual Lisp: [Select]
  1. (defun C:PL-CW()(Pl-CW-VVA "_:L" t));;;Clockwise
  2. (defun C:PL-CCW()(Pl-CW-VVA "_:L" nil));;;CounterClockwise
  3. (defun C:PL-CWA()(Pl-CW-VVA "_ALL" t));;;Clockwise ALL
  4. (defun C:PL-CCWA()(Pl-CW-VVA "_ALL" nil));;;CounterClockwise ALL
  5. (defun C:PLI-CCW()(Pl-CW-Irneb "_:L" nil));;;CounterClockwise Irneb version
  6. (defun C:PLI-CW()(Pl-CW-Irneb "_:L" t));;;Clockwise Irneb version
  7.  
  8. (defun Pl-CW-Irneb ( mode what / int:i e1 res clk+ ss)
  9.  ;;; posted Irneb
  10.  ;;; url http://www.cadtutor.net/forum/showthread.php?59671-all-polylinienrichtungen-counterclockwise
  11.  ;;; what - t Clockwise
  12.  ;;; what - nil CounterClockwise
  13.  ;;; mode - string for ssget "_:L" or "_ALL:
  14.  (or  *pl-activedoc*
  15.       (setq  *pl-activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  16.  (vla-startundomark  *pl-activedoc*)
  17.  (princ (strcat "\n" (if what "Clockwise mode"  "CounterClockwise mode") " Select Polyline"))
  18.  (setq ss nil
  19.  ss (ssget mode '((0 . "*POLYLINE"))))
  20.  (setq int:i '-1 clk+ 0)
  21.  (while (and ss (setq e1 (ssname ss (setq int:i (1+ int:i)))))
  22.    (if (vlax-write-enabled-p (vlax-ename->vla-object e1)) ;_editable
  23.    (if what
  24.      ;;;Reverse CounterClockwise->Clockwise
  25.      (if (PL-CounterClockWise-p e1)
  26.   (pl:geom-allpline-reverse e1)
  27.   (setq clk+ (1+ clk+))
  28.   )
  29. )
  30.      ;;;Reverse Clockwise->CounterClockwise
  31.      (if (null (PL-CounterClockWise-p e1))
  32.   (pl:geom-allpline-reverse e1)
  33.   (setq clk+ (1+ clk+))
  34.   )
  35. )
  36.      )
  37.      )
  38.  )
  39.  (princ (strcat "\nCheck " (itoa int:i) " polyline."))
  40.  (princ "\n\t")(princ clk+)(princ (if what  " \tCounterClockwise (reverse)" " \tClockwise (reverse)"))
  41.  (princ "\n\t")(princ (- int:i clk+))(princ (if what " \tClockwise" " \tCounterClockwise"))
  42.  (setq ss nil)(vla-endundomark  *pl-activedoc*) (princ))
  43. (defun Pl-CW-VVA ( mode what / int:i e1 res clk+ ss)
  44.  ;;; Posted VVA
  45.  ;;; Url http://www.cadtutor.net/forum/showthread.php?59671-all-polylinienrichtungen-counterclockwise
  46.  ;;; what - t Clockwise
  47.  ;;; what - nil CounterClockwise
  48.  (or  *pl-activedoc*
  49.       (setq  *pl-activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  50.  (vla-startundomark  *pl-activedoc*)
  51.  (princ (strcat "\n" (if what "Clockwise mode"  "CounterClockwise mode") " Select Polyline"))
  52.  (setq ss nil
  53.  ss (ssget mode '((0 . "*POLYLINE"))))
  54.  (setq int:i '-1 clk+ 0)
  55.  (while (and ss (setq e1 (ssname ss (setq int:i (1+ int:i)))))
  56.    (if what
  57.      ;;;Reverse CounterClockwise->Clockwise
  58.      (if (null(pl:clockwise-p e1))
  59.   (pl:geom-allpline-reverse e1)
  60.   (setq clk+ (1+ clk+))
  61.   )
  62. )
  63.      ;;;Reverse Clockwise->CounterClockwise
  64.      (if (pl:clockwise-p e1)
  65.   (pl:geom-allpline-reverse e1)
  66.   (setq clk+ (1+ clk+))
  67.   )
  68. )
  69.      )
  70.  )
  71.  (princ (strcat "\nCheck " (itoa int:i) " polyline."))
  72.  (princ "\n\t")(princ clk+)(princ (if what  " \tCounterClockwise (reverse)" " \tClockwise (reverse)"))
  73.  (princ "\n\t")(princ (- int:i clk+))(princ (if what " \tClockwise" " \tCounterClockwise"))
  74.  (setq ss nil)(vla-endundomark  *pl-activedoc*) (princ))
  75. (defun pl:geom-allpline-reverse ( pl / pln ret)
  76.  (if (= (type pl) 'VLA-OBJECT)
  77.    (setq pln (vlax-vla-object->ename pl))
  78.    (setq pln pl))
  79.  (cond ((= (pl:dxf 0 (entget pln)) "LWPOLYLINE")
  80.  (setq ret (pl:geom-LWpolyline-revers pln)))
  81. ((= (pl:dxf 0 (entget pln)) "POLYLINE")
  82.  (setq ret (pl:geom-polyline-revers  pln)))
  83. (t (setq ret nil))
  84. )
  85.  ret
  86.  )
  87. (defun pl:geom-LWpolyline-revers ( lw / e x1 x2 x3 x4 x5 x6)
  88.  (if (= (type lw) 'VLA-OBJECT)
  89.    (setq lw (vlax-vla-object->ename lw)))
  90.    (setq e (entget lw ))
  91. (foreach a1 e
  92.   (cond
  93.     ((= (car a1) 10) (setq x2 (cons a1 x2)))
  94.     ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
  95.     ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
  96.     ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
  97.     ((= (car a1) 210) (setq x6 (cons a1 x6)))
  98.     (t (setq x1 (cons a1 x1)))
  99.     ) ;_ end of cond
  100.   )
  101.         (cdr (reverse (cons (car x3) (reverse x3))))
  102.         (cdr (reverse (cons (car x4) (reverse x4))))
  103.         (cdr (reverse (cons (car x5) (reverse x5))))
  104.         ) ;_ end of list
  105.        ) ;_ end of cons
  106.      ) ;_ end of apply
  107.         ) ;_ end of apply
  108.       x6
  109.       ) ;_ end of append
  110.     ) ;_ end of append
  111.   ) ;_ end of entmod
  112.  (entupd lw)
  113.  ) ;_ end of defun
  114. (defun pl:geom-polyline-revers  
  115.                               (ent_name        /
  116.                                _dxf-code-data  tmp_ent
  117.                                i               poly_ent
  118.                                vert_ent        vertex_list
  119.                                bulge_list      start_width_list
  120.                                end_width_list
  121.                               )
  122. (if (= (type ent_name) 'VLA-OBJECT)
  123.    (setq ent_name (vlax-vla-object->ename ent_name)))
  124.  ;; Reverse "POLYLINE"
  125.  (setq tmp_ent ent_name
  126.          i       0
  127.  ) ;_ end of setq
  128.  (setq bulge_list nil vertex_list nil start_width_list nil end_width_list nil)
  129.  (while
  130.    (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent))))) ;_ end of not
  131.     (setq bulge_list
  132.            (cons (pl:dxf 42 tmp_ent) bulge_list)
  133.           vertex_list
  134.            (cons (entget tmp_ent) vertex_list)
  135.           start_width_list
  136.            (cons (pl:dxf 40 tmp_ent)
  137.                  start_width_list
  138.            ) ;_ end of cons
  139.           end_width_list
  140.            (cons (pl:dxf 41 tmp_ent) end_width_list)
  141.           i (1+ i)
  142.     ) ;_ end of setq
  143.  ) ;_ end of while
  144.  
  145.  (setq
  146.        bulge_list       (append (cdr bulge_list) (list (car bulge_list)))
  147.        start_width_list (append (cdr start_width_list)
  148.                                 (list (car start_width_list))
  149.                         ) ;_ end of append
  150.        end_width_list   (append (cdr end_width_list)
  151.                                 (list (car end_width_list))
  152.                         ) ;_ end of append
  153.        i                0
  154.        bulge_list       (mapcar '(lambda (x) (- 0 x)) bulge_list)
  155.        tmp_ent          ent_name
  156.        poly_ent         (cdr (entget tmp_ent '("*"))) ;;;Added to revers with XData
  157.        poly_ent         (subst (cons 40 (car end_width_list))
  158.                                (assoc 40 poly_ent)
  159.                                poly_ent
  160.                         ) ;_ end of subst
  161.        poly_ent         (subst (cons 41 (last start_width_list))
  162.                                (assoc 41 poly_ent)
  163.                                poly_ent
  164.                         ) ;_ end of subst
  165.  ) ;_ end of setq
  166.  (entmakex poly_ent)          ; polyline
  167.  (while
  168.    (not (= "SEQEND" (pl:dxf 0 (setq tmp_ent (entnext tmp_ent))))
  169.    ) ;_ end of not
  170.     (progn
  171.       (setq vert_ent (nth i vertex_list)
  172.             vert_ent (subst (cons 40 (nth i end_width_list))
  173.                             (assoc 40 vert_ent)
  174.                             vert_ent
  175.                      ) ;_ end of subst
  176.             vert_ent (subst (cons 41 (nth i start_width_list))
  177.                             (assoc 41 vert_ent)
  178.                             vert_ent
  179.                      ) ;_ end of subst
  180.             vert_ent (subst (cons 42 (nth i bulge_list))
  181.                             (assoc 42 vert_ent)
  182.                             vert_ent
  183.                      ) ;_ end of subst
  184.             i        (1+ i)
  185.       ) ;_ end of setq
  186.       (entmakex vert_ent)
  187.     ) ;_ end of progn
  188.  ) ;_ end of while
  189.  (entmakex (cdr (entget tmp_ent))) ; seqend
  190.  (entdel ent_name)
  191. ) ;_ end of defun
  192. (defun pl:dxf (code lst)
  193.  (if (= (type lst) 'ENAME)
  194.    (setq lst (entget lst)))
  195.  (cdr (assoc code lst))
  196.  )
  197.  
  198. ;;; Function to test if polyline is counter-clock-wise
  199. ;;; obj= vla-object / ename of the polyline
  200. ;;; Result is nil if clockwise, T if counter-clockwise
  201. (defun PL-CounterClockWise-p (obj / ang ang1 ang2 angT param)
  202.  (if (= (type Obj) 'ENAME)(setq Obj (vlax-ename->vla-object Obj)))  
  203.  (setq param 1.5
  204.        angT  0.0
  205.        ang1  (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj 0.5))
  206.  )
  207.  (while (< param (vlax-curve-getEndParam obj))
  208.    (setq ang2 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj param)))
  209.    (setq ang (- ang2 ang1))
  210.    (if (> (abs ang) pi)
  211.      (setq ang (* (if (< ang 0.0) -1.0 1.0) (- (abs ang) (* pi 2))))
  212.    )
  213.    (setq angT  (+ angT ang)
  214.          ang1  ang2
  215.          param (1+ param)
  216.    )
  217.  )
  218.  (>= angT 0.0)
  219. )
  220. (defun pl:clockwise-p  ( lw  / LST MAXP MINP)
  221. (if (= (type lw) 'ENAME)
  222.    (setq lw (vlax-ename->vla-object lw)))  
  223. (vla-GetBoundingBox lw 'MinP 'MaxP)
  224. minp(vlax-safearray->list minp)
  225. MaxP(vlax-safearray->list MaxP)
  226. (list minp(list(car minp)(cadr MaxP))
  227. MaxP(list(car MaxP)(cadr minp)))))
  228. (<=(car lst)(cadr lst)(caddr lst)(cadddr lst))
  229. (<=(cadr lst)(caddr lst)(cadddr lst)(car lst))
  230. (<=(caddr lst)(cadddr lst)(car lst)(cadr lst))
  231. (<=(cadddr lst)(car lst)(cadr lst)(caddr lst))) t nil))
  232. (princ "\nType Pl-CW, PL-CWA (ClockWise) or PL-CCW, PL-CCWA (CounterClockWise) in command line")
  233. (princ "\nFor difficult cases with a polyline use PlI-CW (ClockWise) or PLI-CCW (CounterClockWise) in command line")
  234.  


Thanks

mhupp

  • Bull Frog
  • Posts: 201
Re: Counter Clockwise only close polyline
« Reply #1 on: November 20, 2022, 01:41:26 PM »
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: [Select]
  1. (Defun C:CCWALL (/ SS)
  2.   (if (setq SS (ssget "_A" '((0 . "*POLYLINE") (70 . 1))))
  3.     (foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
  4.       (if (pl:clockwise-p e1)
  5.         (pl:geom-allpline-reverse e1)
  6.       )
  7.     )
  8.   )
  9. )

PM

  • Bull Frog
  • Posts: 383
Re: Counter Clockwise only close polyline
« Reply #2 on: November 20, 2022, 03:30:59 PM »
Thanks mhupp . I use the code works fine