TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on March 02, 2006, 12:55:46 PM
-
How does one generate a polyline from a list of points?
The number of points in my list may vary at different times.
Any help would be appreciated.
:-)
-
(command "_.pline")
(foeach pt PtList)
(command pt)
)
(comamnd "")
-
One way:
(setq ptlist '((0.0 0.0)(10.0 0.0)(10.0 10.0)(20.0 10.0)))
(command "pline")
(mapcar '(lambda (x)
(command x)
)
ptlist)
(command "")
-
Modified from this post (http://www.theswamp.org/forum/index.php?topic=6977.msg85862#msg85862) --
(apply 'command
(append
'(".pline")
points
'("")
)
)
Of course there's always the entmake / activex route too ... :)
-
Thanks everyone, I will give it a try.
:-)
-
(entmakex
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
'(70 . 1)
) ;_ list
(mapcar '(lambda (x) (cons 10 x)) lst)
) ;_ append
)
-
how can I generate the pline with a different width of the last segment from a list of points, I cant change the width when the command PL function was processing.
-
how can I generate the pline with a different width of the last segment from a list of points, I cant change the width when the command PL function was processing.
;**************** lw_width.lsp *********************************
; Change of initial and final width
; The arbitrary segment of a polyline.
; Writer Evgeniy Elpanov.
(defun C:LW_WIDTH (/ ENDWIDTH GR LW PAR STARTWIDTH)
(vl-load-com)
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(setq lw (entsel "\n Select the necessary segment in a polyline. "))
(if (and lw (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE"))
(progn
(setq par (vlax-curve-getParamAtPoint (car lw)
(vlax-curve-getClosestPointTo (car lw) (cadr lw))
) ;_ vlax-curve-getParamAtPoint
lw (vlax-ename->vla-object (car lw))
) ;_ setq
(princ "\n Set width of the beginning of a segment.\t")
(vla-GetWidth lw (fix par) 'StartWidth 'EndWidth)
(while (and (setq gr (grread 5)) (= (car gr) 5))
(vla-SetWidth lw
(fix par)
(setq StartWidth (* (distance (cadr gr)
(vlax-curve-getClosestPointTo lw (cadr gr))
) ;_ distance
2.
) ;_ *
) ;_ setq
EndWidth
) ;_ vla-SetWidth
) ;_ while
(if (= (car gr) 2)
(vla-SetWidth lw
(fix par)
(setq StartWidth (atof (strcat (princ (vl-list->string (cdr gr)))
(getstring)
) ;_ strcat
) ;_ atof
) ;_ setq
EndWidth
) ;_ vla-SetWidth
) ;_ if
(princ "\n Set width of the extremity of a segment.\t")
(while (and (setq gr (grread 5)) (= (car gr) 5))
(vla-SetWidth lw
(fix par)
StartWidth
(* (distance (cadr gr)
(vlax-curve-getClosestPointTo lw (cadr gr))
) ;_ distance
2.
) ;_ *
) ;_ vla-SetWidth
) ;_ while
(if (= (car gr) 2)
(vla-SetWidth lw
(fix par)
StartWidth
(atof (strcat (princ (vl-list->string (cdr gr))) (getstring)))
) ;_ vla-SetWidth
) ;_ if
) ;_ progn
(princ "\n It is elected nothing or object not a polyline.\t")
) ;_ if
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(princ)
) ;_ defun
; for the button:
^C^C^P(if (not C:lw_width) (load "lw_arc")) lw_width
PS. Modify => formatting the code
-
I do not see in the samples provided [bulge] curve
.... wonder if allways those polylines will be straight...
Correction s for a d
-
I do not see in the samples provides [bulge] curve.... wonder if allways those polylines will be straight...
Example - change of curvature visual (line segment => arc segment)
;**************** lW_arc.lsp *************************************
; Substitution of a linear segment in a polyline
; The arc segment.
; Writer Evgeniy Elpanov.
(defun C:LW_ARC (/ A1 ENT GR I LST LW PAR PT)
(vl-load-com)
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(setq lw (entsel "\n Select the necessary segment in a polyline. "))
(if (and lw (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE"))
(progn (setq par (vlax-curve-getParamAtPoint (car lw)
(vlax-curve-getClosestPointTo (car lw) (cadr lw))
) ;_ vlax-curve-getParamAtPoint
a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par))
(vlax-curve-getPointAtParam (car lw) (1+ (fix par)))
) ;_ angle
) ;_ setq
(princ "\n Set visually a curvature of a segment. ")
(while (and (setq gr (grread 5)) (= (car gr) 5))
(setq i 0
lst nil
ent (entget (car lw))
) ;_ setq
(while (or (/= (caar ent) 42)
(if (< i (fix par))
(setq i (1+ i))
) ;_ if
) ;_ or
(setq lst (cons (car ent) lst)
ent (cdr ent)
) ;_ setq
) ;_ while
(redraw)
(grdraw (setq pt (vlax-curve-getPointAtParam
(car lw)
(fix par)
) ;_ vlax-curve-getPointAtParam
) ;_ setq
(cadr gr)
6
1
) ;_ grdraw
(entmod (append (reverse (cons (cons 42
(/ (sin (/ (- a1 (angle pt (cadr gr))) 2.))
(cos (/ (- a1 (angle pt (cadr gr))) 2.))
) ;_ /
) ;_ cons
lst
) ;_ cons
) ;_ reverse
(cdr ent)
) ;_ append
) ;_ entmod
(entupd (car lw))
) ;_ while
) ;_ progn
(princ "\n It is selected nothing or plant not a polyline. ")
) ;_ if
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(redraw)
(princ)
) ;_ defun
; for the button:
^C^C^P(if (not C:LW_ARC) (load "lw_arc")) LW_ARC
PS. Modify => formatting the code
-
Generate a Pline from a list of points and bulge
If you have (and lst-pt lst-bulge):
(if (and (setq en (car (entsel)))
(= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
) ;_ and
(setq lst-pt (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget en))
) ;_ mapcar
lst-bulge (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 42))) (entget en))
) ;_ mapcar
) ;_ setq
) ;_ if
Example:
(entmakex
(apply
(function append)
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "New_polyline")
'(62 . 3)
'(100 . "AcDbPolyline")
(cons 90 (length lst-pt))
'(70 . 0)
;;'(70 . 1) = Closed
) ;_ list
(mapcar
(function list)
(mapcar (function (lambda (a) (cons 10 a))) lst-pt)
(mapcar (function (lambda (a) (cons 42 a))) lst-bulge)
) ;_ mapcar
) ;_ cons
) ;_ apply
) ;_ entmakex
>LE
I have answered your question?
-
Evgeniy,
nice code .. which version of ACad do you use ?
I like the dynamic visual ARC routine !
Thanks for formatting the code .. much easier to read :-)
be well
kerry
-
Evgeniy,
nice code .. which version of ACad do you use ?
I like the dynamic visual ARC routine !
Thanks for formatting the code .. much easier to read :-)
be well
kerry
AutoCad 2004 en
:-)
-
Generate a Pline from a list of points and bulge
If you have (and lst-pt lst-bulge):
) ;_ entmakex
>LE
I have answered your question?
Not exactly... I have not tested your code.... I was talking of just pure list of points..... and from them generate the pline... I will post a sample ... give me some minutes... and I need my first coffee...
I see you know very well LISP... where are you from?
==
Luis Esquivel
-
where are you from?
Moscow, Russia
-
Side tracking I know, but it has to be said as well as producing nice code you have one very cool avatar. :-)
-
Evgeniy;
My question was in general, since I noticed that the topic is how to generate a pline from a list of points, all the code provided was just for straight pline...
Here is one code to generate a pline with straight and curve segments.
Download the ZIP file.... please and open pline_vlisp.lsp
Have fun.
Luis Esquivel
Correction: Removing the code and placing it into a ZIP file...
-
Side tracking I know, but it has to be said as well as producing nice code you have one very cool avatar. :-)
AutoCad 2000 + Accurender
PS. Modify => + Photoshop
-
Very cool the code!
You could see only my public code.
My work code I cannot show. :-(
-
Very cool the code!
You could see only my public code.
My work code I cannot show. :-(
No problem... for what I have seen so far, looks like you really know how to code and you are a problem solver...
Again welcome here...
-
I work with polylines much...
My old programs:
Reverse "LWPOLYLINE"
(defun c:rlw (/ E LW X1 X2 X3 X4 X5 X6)
(if (and (setq lw (car (entsel "\nSelect lwpolyline")))
(= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
) ;_ and
(progn
(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)))
) ;_ cond
) ;_ foreach
(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))))
) ;_ list
) ;_ cons
) ;_ apply
) ;_ apply
x6
) ;_ append
) ;_ append
) ;_ entmod
(entupd lw)
) ;_ progn
) ;_ if
) ;_ defun
Direction "LWPOLYLINE"
(defun c:lwcl (/ LW LST MAXP MINP)
(setq lw (vlax-ename->vla-object (car (entsel))))
(vla-GetBoundingBox lw 'MinP 'MaxP)
(setq
minp (vlax-safearray->list minp)
MaxP (vlax-safearray->list MaxP)
lst (mapcar
(function
(lambda (x)
(vlax-curve-getParamAtPoint
lw
(vlax-curve-getClosestPointTo lw x)
) ;_ vlax-curve-getParamAtPoint
) ;_ lambda
) ;_ function
(list minp
(list (car minp) (cadr MaxP))
MaxP
(list (car MaxP) (cadr minp))
) ;_ list
) ;_ mapcar
) ;_ setq
(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))
) ;_ or
t
) ;_ if
) ;_ defun
-
I work with polylines much...
My old programs:
Reverse "LWPOLYLINE"
(defun c:rlw (/ E LW X1 X2 X3 X4 X5 X6)
) ;_ defun
Direction "LWPOLYLINE"
(defun c:lwcl (/ LW LST MAXP MINP)
(setq lw (vlax-ename->vla-object (car (entsel))))
(vla-GetBoundingBox lw 'MinP 'MaxP)
) ;_ defun
I am testing C:LWCL ... it always returning NIL.... what is supposed to do? or what I am doing wrong here...
Thanks.
-
I am testing C:LWCL ... it always returning NIL.... what is supposed to do?
Not tested it, but I think it is checking if pline drawn CW or CCW!
-
Eso entendi Sergio... solo que a mi me regresa solamente NIL
He he...
-
(entmakex
'((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(90 . 4)
(70 . 1)
(10 0. 0.)
(10 100. 0.)
(10 100. 100.)
(10 0. 100.)
)
) ;_ entmakex
c:lwcl=> NIL
(entmakex
'((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(90 . 4)
(70 . 1)
(10 0. 0.)
(10 0. 100.)
(10 100. 100.)
(10 100. 0.)
)
) ;_ entmakex
c:lwcl => T
-
Hey Luis,
How you do that? You are not listed in users on line, and yet!!!!
-
OK,
I got it working now...
Thanks.
-
Mi scusi, Luis
The thingy [yeah I get technical at times] on the left says you are offline. Neat!
-
:-D
-
Serge ;
-
OK,
I got it working now...
Thanks.
Luis,
Did you change the code, or just determine what it was doing ? :-)
-
Did you change the code, or just determine what it was doing ? :-)
The code was OK... for some reasons it was showing only NIL... my bad doing wrong testing.... it is Sunday and did a lot of handy-man work today - excuse # 232434556436
-
it is Sunday and did a lot of handy-man work today
No placido Domingo 4 u?
Eso entendi Sergio... solo que a mi me regresa solamente NIL
It works now. Tell you what, that Evgeniy is a man of few words, programmatically. He has a knack in compressing to simplest core.
Thanks Kerry, it appears that there is more than meet the eyes on that new forum!
-
It works now. Tell you what, that Evgeniy is a man of few words, programmatically. He has a knack in compressing to simplest core.
:kewl:
And very good for this forum....
-
Evgeniy;
Вы пишете в другом языке программирования?
-
And very good for this forum....
Thanks :-)
My the friend has shown this forum - (kpblc)
http://www.theswamp.org/index.php?action=profile;u=1044
-
Evgeniy;
Вы пишете в другом языке программирования?
Почти нет, основные AutoLISP, DCL и SQL...
-
ElpanovEvgeniy
Thank you very much for your help.
Now I can draw a pl with different bulge width from a list.
I think it can be use for match two pline with some character, for example, width or bulge.
Most of the following code comes from you:),Thank you~
(defun c:test()
(if (and (setq en (car (entsel)))
(= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
) ;_ and
(setq lst-pt (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget en))
) ;_ mapcar
lst-bulge (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 42))) (entget en))
)
lst-w1 (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 40))) (entget en))
) ;_ mapcar
lst-w2 (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 41))) (entget en))
) ;_ mapcar
) ;_ setq
)
) ;_ if
(defun c:test1()
(entmakex
(apply
(function append)
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "New_polyline")
'(62 . 3)
'(100 . "AcDbPolyline")
(cons 90 (length lst-pt))
'(70 . 0)
;;'(70 . 1) = Closed
) ;_ list
(mapcar
(function list)
(mapcar (function (lambda (a) (cons 10 a))) lst-pt)
(mapcar (function (lambda (a) (cons 40 a))) lst-w1)
(mapcar (function (lambda (a) (cons 41 a))) lst-w2)
(mapcar (function (lambda (a) (cons 42 a))) lst-bulge)
) ;_ mapcar
) ;_ cons
) ;_ apply
) ;_ entmakex
)
-
The new version lw_arc.lsp
http://www.theswamp.org/index.php?topic=8878.msg114384#msg114384
;**************** lw_arc.lsp *************************************
; Substitution of a linear segment in a polyline
; The arc segment.
; Writer Evgeniy Elpanov.
; Last edit 04.06.06
(defun C:LW_ARC (/ LW i P1 P2 P3)
(vl-load-com)
(or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (and (setq lw (entsel "\n Select the necessary segment in a polyline. "))
(= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE")
) ;_ and
(progn
(setq i (fix (vlax-curve-getParamAtPoint
(car
lw
) ;_ car
(vlax-curve-getClosestPointTo (car lw) (cadr lw))
) ;_ vlax-curve-getParamAtPoint
) ;_ fix
p1 (vlax-curve-getPointAtParam (car lw) i)
p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
lw (vlax-ename->vla-object (car lw))
) ;_ setq
(princ "\n Set visually a curvature of a segment. ")
(vla-StartUndoMark doc)
(while (and (setq p2 (grread 5)) (= (car p2) 5))
(vla-SetBulge
lw
i
((lambda (a) (/ (sin a) (cos a)))
(/ (- (angle p1 (cadr p2)) (angle (cadr p2) p3)) -2.)
)
) ;_ vla-SetBulge
) ;_ while
(vla-EndUndoMark doc)
) ;_ progn
(princ "\n It is selected nothing or plant not a polyline. ")
) ;_ if
)
-
Evgeniy,
I like that a lot. :-)
You do good work. 8-)
-
Evgeniy,
I like that a lot. :-)
You do good work. 8-)
Yes, I will second that.
Gary
-
> Alan and Gary
Thank you! :-)
-
Generate a Pline from a list of points and bulge
If you have (and lst-pt lst-bulge):
(if (and (setq en (car (entsel)))
(= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
) ;_ and
(setq lst-pt (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget en))
) ;_ mapcar
lst-bulge (mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 42))) (entget en))
) ;_ mapcar
) ;_ setq
) ;_ if
Example:
(entmakex
(apply
(function append)
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "New_polyline")
'(62 . 3)
'(100 . "AcDbPolyline")
(cons 90 (length lst-pt))
'(70 . 0)
;;'(70 . 1) = Closed
) ;_ list
(mapcar
(function list)
(mapcar (function (lambda (a) (cons 10 a))) lst-pt)
(mapcar (function (lambda (a) (cons 42 a))) lst-bulge)
) ;_ mapcar
) ;_ cons
) ;_ apply
) ;_ entmakex
>LE
I have answered your question?
Why does this routine not close a polyline? I tried uncommenting the 70.1 but it spit out an error.
-
Did you comment out the (70 . 0) in front of the (70 . 1)? You can only have one (like Highlander).
-
THERE CAN BE ONLY ONE!!!!!! :-D Thanks. :ugly:
-
Did you comment out the (70 . 0) in front of the (70 . 1)? You can only have one (like Highlander).
You needs you a Sean Connery avatar.
-
Did you comment out the (70 . 0) in front of the (70 . 1)? You can only have one (like Highlander).
You needs you a Sean Connery avatar.
True, and I guess I could have quoted the movie correctly.
There can be only one!
-
THERE CAN BE ONLY ONE!!!!!! :-D Thanks. :ugly:
You're welcome. I didn't see this one before I posted (clicked on the link in recent topics).