Topic: select pline origin

[daveland]

Hey Guys

Being a relative beginner at this coding thing I have tried to use the information you provided and I am getting mixed results.

T. Willey I took your code and made it in to a .vlx file.  I'm not sure how I did it but I used the wizard in Visual Lisp and saved it as a file.

I got it to work a couple of times but then when I use this other routine called map check out of AutoDesk Land Desktop It automatically changes the line type to a regular pline from a light weight polyline and then I can't seem to use your routine anymore.

This is the message I get:
"Select new starting point: *Cancel*
lisp value has no coercion to VARIANT with this type:  ENDWD"

Any way it seems a little awkward because I have to pedit the linetype generation on and off depending on what routine I am trying to run.

some routines, like the reverse direction routine, needs a light weight pline and some routines like yours need something else.

sometimes I am also getting this error:
" Select new starting point: *Cancel*
AutoCAD.Application: Invalid class"

Thanks for your help guys.  I will check back in later.

[T.Willey]

The routine was tested with lightweight polylines.  I don't use map, so I'm not sure if that is the problem.  You don't need to make it a vlx, you can just save it as a lisp '.lsp' file and it will run just fine.  You could even just copy the whole thing to the command line, and it will load it (a beautiful thing about lisp) so you can test it.

Tim,
Works here. Nice work.
If you wanted to add a vertex for the new start vertex it would be easy enough if straight line segment but if on an arc it's a differant story. That's why I chose the Break command like Jeff hinted at for my BreakAll routine.

Thanks Alan.  I will see what it does when you select an arc as the new starting point, but I think it should work, but didn't test that.

[LE]

Here is the routine: CHSVERTEX

Run the command: CHSVERTEX
Select a closed polyline
Define the new starting point

Note:
For closed polylines only - if an open pline is selected it will be close.

HTH

[Jeff_M]

Well, since we're all sharing
Here's my rendition using the BREAK & PEDIT commands:

Code: [Select]

(defun c:movestart (/ pline brkpt)
  (while (setq pline (car (entsel)))
    (if (and (wcmatch (cdr (assoc 0 (setq ent (entget pline)))) "*POLYLINE")
     (= (logand (cdr (assoc 70 ent)) 1) 1)
     (setq brkpt (osnap (getpoint "\nVertex to move start position to: ") "near"))
     (setq brkpt (osnap brkpt "end"))
     )
      (progn
(command "break" brkpt "f" brkpt brkpt)
(command "pedit" (entlast) "j" pline "" "")
)
      )
    )
  (princ)
  )


[LE]

Note:

The reason in this case of uploading a compiled routine (fas) for CHSVERTEX was that I wrote that for a client, so please excuse me.

[T.Willey]

I will see what it does when you select an arc as the new starting point, but I think it should work, but didn't test that.

Mine works when you select an arc point as the new start point.  Mine also works with 'open' plines.  Mine DOESN'T work with heavy plines.  for some reason it errors when trying to get the width with ActiveX methods, eventhough it says it can be done in the help file.

[daveland]

LE

I like your routine.  It doesn't descriminate between types of polylines it seems to work with lightweight and regular polylines.  However, as mentioned, it doesn't handle polylines with curves.  It's a very simple clean routine and it even leaves an X showing you where your pline origin was and where it is now.

If you get around to working curves into the code let me know.

Thanks,

Daveland

[LE]

If you get around to working curves into the code let me know.

Do you have a sample drawing with some plines, that I can use for test?

I wrote my routine, for very specific needs.

[T.Willey]

Here is my updated one that works with old style plines.

Code: [Select]

(defun c:ReOrderPoly (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList)

(defun ChangeOldStyle (Ent Pt / Pent cnt EntData PolyInfoList StPos)

(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
  )
 )
 (setq cnt (1+ cnt))
)
(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)
 )
)
(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))
   (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)
  )
 )
)
(command "_.undo" "_end")
(princ)
)


[daveland]

works like a charm T. Willey. And it handles curves.

a shorter key in command and a built-in reverse polyline direction option (Yes/No) would be make it almost perfect.

[T.Willey]

works like a charm T. Willey. And it handles curves.

a shorter key in command and a built-in reverse polyline direction option (Yes/No) would be make it almost perfect.

You can change the calling command, just change this line

Code: [Select]

(defun c:ReOrderPoly (.......)the 'c:ReOrderPoly' part.

Reversing, not sure about that one, but if I get some spare time I can look into it.

You're welcome.  Here is an even better version, if the pline should be closed, but isn't, it wouldn't draw it correctly, so now it will close it if it should be.  Thanks Tim2 for pointing it out 'Tim Creary'.

Code: [Select]

(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)
)


[daveland]

T. Willey

Thanks for offering to look into this reverse thing a little further.

Attached is a routine that I got somewhere over the last two days. Possibly the AUGI web site. (I renamed the .lsp file with a .txt ending)