TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: daveland on September 25, 2006, 05:16:56 PM
-
Does any one have a routine that allows you to select the origin of a polyline?
Example I have a boundary which is a closed polyline and i want to select a specific vertex for the starting point. (Note: I also want to then reverse the polyline if necessary so it is going in the right direction. P.S.-I think I already have a pretty good routine for reversing.)
thanks,
Daveland
-
By "origin" do you mean centroid of a closed polyline?
-
I mean starting point. In other words i want to select a vertex anywhere along a closed polyline as the starting point.
-
I'm not sure about an easy coding solution, but if you use Break and select the point to break at as being on a vertex, then Pedit, select the section that had the Closing segment, join, now select the other segment. You will now have a closed pline starting at the selected vertex.
-
That's an interesting method Jeff :-)
-
I mean starting point. In other words i want to select a vertex anywhere along a closed polyline as the starting point.
It won't matter if a fas or vlx file is provided?
-
I am not sure what an FAS file is but if it works in Autodesk Land Desktop 2006 then FAS will be fine
-
I am not sure what an FAS file is but if it works in Autodesk Land Desktop 2006 then FAS will be fine
FAS & VLX are compiled lisp routines, let me look for those routines it was for an small civil routines I wrote in the past that do something like this:
ID_AREADER [$(if,$(eq,$(getenv,"AutoAreaReaderGpoly"),"1"),!.)&Automatic Area And Polyline Direction Reader]^P'AREAREADER
[--]
[Change Polyline D&irection]^C^CRPOL
[Remove Duplicate &Vertices]^C^CRVERTEX
[Change &Starting Vertex]^C^CCHSVERTEX
[Convert Circles Into Closed Polylines]^C^CCIRCLEPOLY
-
Sorry it didn't work either.
-
Sorry it didn't work either.
Dave;
Give me some time (if you are answering to my previous post quote), to upload the routine here.... I am doing my day job now.... :-)
-
Hey Thanks.
I am just finishing my day job but will check back in tomorrow.
Thanks you all for your efforts this will save me a tremendous amount of work if I can get it up and running.
I will check in tomorrow morning.
-
You can try this. It's seems to work on my system. No error checking, and not very pretty, but it did work on my test drawing.
(defun c:ReOrderPoly (/ Sel Pobj Pt PtList VertexPt PtListIndex PolyList StPos cnt tmpList)
(setq Sel (entsel "\n Select polyline: "))
(setq Pobj (vlax-ename->vla-object (car Sel)))
(setq Pt (getpoint "\n Select new starting point: "))
(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)
(princ)
)
-
OK... that works Tim (on the tests I did).... no need to post mine.
-
OK... that works Tim (on the tests I did).... no need to post mine.
Thanks for testing Luis. I wouldn't use it (at least not at my current job), but it seemed fun to try and code 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.
-
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.
-
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.
-
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
-
Well, since we're all sharing :-)
Here's my rendition using the BREAK & PEDIT commands:
(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)
)
-
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.
-
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.
-
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
-
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.
-
Here is my updated one that works with old style plines.
(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)
)
-
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.
-
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
(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'.
(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)
)
-
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)