Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

change polyline start point ?

14 REPLIES 14
Reply
Message 1 of 15
anycganycg
5193 Views, 14 Replies

change polyline start point ?

i made polyline
but i need change polyline start point for some purpose
is that possible ?
cna you help ~
14 REPLIES 14
Message 2 of 15
Anonymous
in reply to: anycganycg

"Change" it how? Stretch? Move? Trim? Extend? Reverse the direction? Just
what is it you need to do?
___

wrote in message news:5818908@discussion.autodesk.com...
i made polyline
but i need change polyline start point for some purpose
is that possible ?
Message 3 of 15
anycganycg
in reply to: anycganycg

orginal polyline :
startpoint
0---------------0-- 0 --0--0------ 0 ------- 0

wanted polyline :
start point
0---------------0-- 0 --0--0------ 0 ------- 0
Message 4 of 15
anycganycg
in reply to: anycganycg

my wanted proces
pls see my attached file~
Message 5 of 15
_gile
in reply to: anycganycg

Hi,

Here's a way.

;;; PlineOrg (2.0) -Gilles Chanteau- 15/09/2007
;;; To change the start point of a closed polyline

(defun c:plineorg (/ erreur os pt pl plst norm nb n blst pa d1 d2 d3)

(vl-load-com)

(defun erreur (msg)
(if (= msg "Function cancelled")
(princ)
(princ (strcat "\nError: " msg))
)
(setvar "OSMODE" os)
(setq *error* m:err
m:err nil
)
)

(setq m:err *error*
*error* erreur
os (getvar "OSMODE")
)
(setvar "OSMODE" 515)
(if (and
(setq pt
(getpoint
"\nSelect a new start point on the polyline: "
)
)
(setq pl (car (nentselp pt)))
(setq pl (vlax-ename->vla-object pl))
(= (vla-get-ObjectName pl) "AcDbPolyline")
(= (vla-get-Closed pl) :vlax-true)
)
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq plst (vlax-get pl 'Coordinates)
norm (vlax-get pl 'Normal)
pt (trans pt 1 0)
pa (vlax-curve-getParamAtPoint pl pt)
nb (/ (length plst) 2)
n nb
)
(repeat n
(setq blst (cons (vla-getBulge pl (setq n (1- n))) blst))
)
(if (= pa (fix pa))
(setq n (fix pa)
plst (append (sublist plst (* 2 n) nil)
(sublist plst 0 (* 2 n))
)
blst (append (sublist blst n nil) (sublist blst 0 n))
)
(setq n (1+ (fix pa))
d3 (vlax-curve-getDistAtParam pl n)
d2 (- d3 (vlax-curve-getDistAtPoint pl pt))
d3 (- d3 (vlax-curve-getDistAtParam pl (1- n)))
d1 (- d3 d2)
pt (trans pt 0 (vlax-get pl 'Normal))
plst (append (list (car pt) (cadr pt))
(sublist plst (* 2 n) nil)
(sublist plst 0 (* 2 n))
)
blst (append (list (k*bulge (nth (1- n) blst) (/ d2 d3)))
(sublist blst n nil)
(sublist blst 0 (1- n))
(list (k*bulge (nth (1- n) blst) (/ d1 d3)))
)
)
)
(vlax-put pl 'coordinates plst)
(repeat (setq n (length blst))
(vla-setBulge pl (setq n (1- n)) (nth n blst))
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(prompt "\nUnvalid entity.")
)
(princ)
)

;;; SUBLIST Return a sub-list
;;;
;;; Arguments
;;; lst : a list
;;; start : start index for the sub-list (first item = 0)
;;; leng : sub-list length (or nil)
;;;
;;; Examples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

;; K*BULGE
;; Returns a bulge which is proportional to a reference
;; Arguments :
;; b : the reference bulge
;; k : the ratio (between angles or arcs length)

(defun k*bulge (b k / a)
(setq a (atan b))
(/ (sin (* k a)) (cos (* k a)))
)


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 6 of 15
anycganycg
in reply to: anycganycg

thank you good answer!
Message 7 of 15
Anonymous
in reply to: anycganycg

How could I modify this to make the new point 0,0?

Thanks
Message 8 of 15
devitg
in reply to: anycganycg

can you please show some like the grap upside.?

Or a DWG with an before and after??
Message 9 of 15
Anonymous
in reply to: anycganycg

devitg,

Nevermind I fix it myself. It was actually pretty simple. I can post the LSP if you want it.
Message 10 of 15
devitg
in reply to: anycganycg

Post it ,please.
Message 11 of 15
Anonymous
in reply to: anycganycg

It was simple fix. All I needed to do was put 0,0 in a list format.

(defun c:porg (/ erreur os pt pl plst norm nb n blst pa d1 d2 d3)

(vl-load-com)

(setq lay (tblsearch "layer" "A-EQPM-SRVC-FUTR"))
(if (= lay)
(command "-layer" "off" "A-EQPM-SRVC-FUTR" "")
)

(defun erreur (msg)
(if (= msg "Function cancelled")
(princ)
(princ (strcat "\nError: " msg))
)
(setvar "OSMODE" os)
(setq *error* m:err
m:err nil
)
)

(setq m:err *error*
*error* erreur
os (getvar "OSMODE")
)
(setvar "OSMODE" 515)
(if (and
(setq pt (list 0.0 0.0 0.0)
; (getpoint
; "\nSelect a new start point on the polyline: "
; )
)
(setq pl (car (nentselp pt)))
(setq pl (vlax-ename->vla-object pl))
(= (vla-get-ObjectName pl) "AcDbPolyline")
(= (vla-get-Closed pl) :vlax-true)
)
(progn
(vla-StartUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq plst (vlax-get pl 'Coordinates)
norm (vlax-get pl 'Normal)
pt (trans pt 1 0)
pa (vlax-curve-getParamAtPoint pl pt)
nb (/ (length plst) 2)
n nb
)
(repeat n
(setq blst (cons (vla-getBulge pl (setq n (1- n))) blst))
)
(if (= pa (fix pa))
(setq n (fix pa)
plst (append (sublist plst (* 2 n) nil)
(sublist plst 0 (* 2 n))
)
blst (append (sublist blst n nil) (sublist blst 0 n))
)
(setq n (1+ (fix pa))
d3 (vlax-curve-getDistAtParam pl n)
d2 (- d3 (vlax-curve-getDistAtPoint pl pt))
d3 (- d3 (vlax-curve-getDistAtParam pl (1- n)))
d1 (- d3 d2)
pt (trans pt 0 (vlax-get pl 'Normal))
plst (append (list (car pt) (cadr pt))
(sublist plst (* 2 n) nil)
(sublist plst 0 (* 2 n))
)
blst (append (list (k*bulge (nth (1- n) blst) (/ d2 d3)))
(sublist blst n nil)
(sublist blst 0 (1- n))
(list (k*bulge (nth (1- n) blst) (/ d1 d3)))
)
)
)
(vlax-put pl 'coordinates plst)
(repeat (setq n (length blst))
(vla-setBulge pl (setq n (1- n)) (nth n blst))
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(prompt "\nUnvalid entity.")
)

(command "-layer" "on" "*" "")
(princ)
)

;;; SUBLIST Return a sub-list
;;;
;;; Arguments
;;; lst : a list
;;; start : start index for the sub-list (first item = 0)
;;; leng : sub-list length (or nil)
;;;
;;; Examples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

;; K*BULGE
;; Returns a bulge which is proportional to a reference
;; Arguments :
;; b : the reference bulge
;; k : the ratio (between angles or arcs length)

(defun k*bulge (b k / a)
(setq a (atan b))
(/ (sin (* k a)) (cos (* k a)))
)
Message 12 of 15
devitg
in reply to: anycganycg

You never say that point 0,0,0 ., belong to the polyline.
Message 13 of 15
Anonymous
in reply to: anycganycg

I don't follow..
Message 14 of 15
devitg
in reply to: anycganycg

Hi Robert , maybe it is my fault to understand text, I was wondering what do you mean when you want to change the origin at 0 0 , and I never guess that at 0 0 was a point in the polyline.
That is why I ask you to show a DWG ,
Maybe to ask for it can be seen an imprudent thing , but I always say , that if " A image worth 1000 words , a DWG worth 1.000.000 words.
I had seen your´s post at other forums too like
http://forums.augi.com/showthread.php?t=71963 , and download your BlockA to dig on it and Only I can find a series os four number on it .
Often I use the post as a way to learn how to do what members ask for .
I'm not a drafter but I love to do lisp , mainly when it involve calculus.
I take LISP as a mental training .
Message 15 of 15
_gile
in reply to: anycganycg

> Often I use the post as a way to learn how to do what members ask for .
> I 'm not a drafter but I love to do lisp , mainly when it involve calculus.
> I take LISP as a mental training .[/quote]

So do I.


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost