AutoLISP: ReOrder Polyline Origin

Taking into consideration the previous posts about determining the origin of a closed polyline, Finding the direction of a polyline and being aware that the REVERSE command will change the origin of a closed polyline – the LISP file in this post will help you have control of defining the “Origin” or first vertex of a polyline. And as a bonus, it even works on 3D Polylines.

Here’s how:

  • Load the lisp file
  • REORDERPOLY [enter]
  • Select the polyline
  • Click an endpoint to define the new origin

ReOrder Polyline Origin

 

3D Polyline shown below

 

ReOrderPoly 3D Poly


;;; T Willey
;;; Re Order Polyline Origin
;;; http://www.theswamp.org/index.php?topic=12624.msg154976#msg154976
(defun c:ReOrderPoly (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(vl-load-com)
(defun ChangeOldStyle (Ent Pt / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (cons
   (list
    cnt
    (cdr (assoc 10 EntData))
    (cdr (assoc 42 EntData))
    (cdr (assoc 40 EntData))
    (cdr (assoc 41 EntData))
   )
   PolyInfoList
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
 (setq ShouldClose (equal StPt (cdr (assoc 10 EntData)) 0.0001))
)
(foreach Lst PolyInfoList
 (if (equal Pt (cadr Lst))
  (setq OldIndex (car Lst))
 )
)
(setq PolyInfoList (reverse PolyInfoList))
(setq StPos (vl-position (assoc OldIndex PolyInfoList) PolyInfoList))
(setq cnt StPos)
(setq Ent Pent)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq EntData (subst (cons 10 (cadr (nth cnt PolyInfoList))) (assoc 10 EntData) EntData))
 (setq EntData (subst (cons 42 (caddr (nth cnt PolyInfoList))) (assoc 42 EntData) EntData))
 (setq EntData (subst (cons 40 (cadddr (nth cnt PolyInfoList))) (assoc 40 EntData) EntData))
 (setq EntData (subst (cons 41 (last (nth cnt PolyInfoList))) (assoc 41 EntData) EntData))
 (entmod EntData)
 (setq cnt (1+ cnt))
 (if (> cnt (1- (length PolyInfoList)))
  (setq cnt 0)
 )
)
(if ShouldClose
 (progn
  (setq EntData (entget Pent))
  (entmod (subst '(70 . 1) (assoc 70 EntData) EntData))
 )
)
(entupd Pent)
)
;-----------------------------------------------------------
(command "_.undo" "_end")
(command "_.undo" "_group")
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select new starting point: "))
  (setq Pobj (vlax-ename->vla-object (car Sel)))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
 )
 (if (= Ptype "POLYLINE")
  (ChangeOldStyle (car Sel) Pt)
  (progn
   (setq PtList (vlax-get Pobj 'Coordinates))
   (if
    (and
     (= (vla-get-Closed Pobj) :vlax-false)
     (equal (car PtList) (nth (- (length PtList) 2) PtList) 0.0001)
     (equal (cadr PtList) (last PtList) 0.0001)
    )
    (setq ShouldClose T)
   )
   (setq VertexPt 0)
   (setq PtListIndex 0)
   (repeat (/ (length PtList) 2)
    (vla-GetWidth Pobj VerTexPt 'StWd 'EndWd)
    (setq PolyList
     (cons
      (list
       VertexPt
       (list
        (nth PtListIndex PtList)
        (nth (1+ PtListIndex) PtList)
       )
       (vla-GetBulge Pobj VertexPt)
       StWd
       EndWd
      )
      PolyList
     )
    )
    (setq VertexPt (1+ VertexPt))
    (setq PtListIndex (+ 2 PtListIndex))
   )
   (foreach Lst PolyList
    (if (equal (list (car Pt) (cadr Pt)) (cadr Lst))
     (setq OldIndex (car Lst))
    )
   )
   (setq VertexPt 0)
   (setq PtList nil)
   (setq PolyList (reverse PolyList))
   (setq StPos (vl-position (assoc OldIndex PolyList) PolyList))
   (setq cnt StPos)
   (repeat (length PolyList)
    (setq tmpList (nth cnt PolyList))
    (setq PtList (append PtList (cadr tmpList)))
    (vla-SetBulge Pobj VertexPt (caddr tmpList))
    (vla-SetWidth Pobj VertexPt (cadddr tmpList) (last tmpList))
    (setq VertexPt (1+ VertexPt))
    (setq cnt (1+ cnt))
    (if (> cnt (1- (length PolyList)))
     (setq cnt 0)
    )
   )
   (vlax-put Pobj 'Coordinates PtList)
   (if ShouldClose
    (vla-put-Closed Pobj :vlax-true)
   )
  )
 )
)
(command "_.undo" "_end")
(princ)
)

[\code]

Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP: Modify, AutoLISP: Polylines, Polylines. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s