THAITOPO บอร์ดแสดงวิสัยทัศน์ด้านGIS 2006-2017
Would you like to react to this message? Create an account in a few clicks or log in to continue.

lisp แก้ spline>pline

Go down

lisp แก้ spline>pline Empty lisp แก้ spline>pline

ตั้งหัวข้อ by thaitopo Thu Dec 13, 2007 10:45 pm

lisp ᡩ spline>pline(SPLINE2PLINE.LSP 1.91 KB)
㪩?ӊѨ? s2p..........?Ŕ?Download

(?͹ download 仠?ŕ肹?ר͠file ໧? spline2pline.lsp ?釂?ФÑ?)

;;;CADALYST 06/05 Tip2039: Spline2Pline.lsp Spline to Polyline Conversion (c) Lloyd Beachy

;; Spline2Pline.lsp (c) 2005 Lloyd Beachy
;; Routine to convert splines to plines

(Defun C:S2P (/ ss pt# cmdecho osmode clayer count ent lay lng pt-list cnt)
(setq ss (ssget '((0 . "spline")))
pt# (getint "Enter number of segments :")
cmdecho (getvar "cmdecho")
osmode (getvar "osmode")
clayer (getvar "clayer")
count 0 ;spline counter
);end setq
(if(null pt#)(setq pt# 100))
(setvar "cmdecho" 0)
(command ".undo" "begin") ;begin undo group
(setvar "osmode" 0)
(repeat(sslength ss) ;repeat for each spline
(setq ent (vlax-ename->vla-object (ssname ss count));change spline to vla-object
lay (vlax-get-property ent "layer") ;spline's layer
lng (vlax-curve-getDistAtPoint ent(vlax-curve-getEndPoint ent));length of spline
pt-list(list(vlax-curve-getStartPoint ent)) ;coords for start of spline
cnt 1.0 ;segment counter
);end setq
(repeat pt# ;repeat for each segment
(setq pt-list(cons(vlax-curve-getPointAtDist ent (* lng(/ cnt pt#)))pt-list));add segment's point to pt-list
(setq cnt(1 cnt)) ;counter to next segment
);end segment repeat
(setq cnt 0) ;pline counter
(setvar "clayer" lay) ;match spline's layer
(command ".pline" ;start "pline" command
(repeat(length pt-list) ;repeat for each point
(command(nth cnt pt-list)) ;enter current point
(setq cnt(1 cnt)) ;counter to next point
"" ;return value to close "pline" command
);end point repeat
);end command
(setq count(1 count)) ;counter to next spline
);end spline repeat
(command ".erase" ss "")
(setvar "osmode" osmode)
(setvar "clayer" clayer)
(command ".undo" "end") ;end of undo group
(setvar "cmdecho" cmdecho)
(princ) ;exit quietly
);end C:S2P

จำนวนข้อความ : 1571
: 27
Localisation : chiengmai
Registration date : 24/10/2006


ขึ้นไปข้างบน Go down


Permissions in this forum: