Chuyển đến nội dung
Diễn đàn CADViet
harmonysouth

làm sao để chuyển đổi đường Spline thành Pline

Các bài được khuyến nghị

mình muốn chuyển đường spline thành đường polyline nhưng ko lam được nhờ mọi người giúp. thasnk !

 

Bạn dùng lệnh FLATTEN nhé

  • Like 1
  • Vote tăng 6

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
mình muốn chuyển đường spline thành đường polyline nhưng ko lam được nhờ mọi người giúp. thasnk !

Bác SSG đã có 1 lisp cho việc này. bạn chịu khó tìm xem!

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bác SSG đã có 1 lisp cho việc này. bạn chịu khó tìm xem!

Admin đã lập mục Tìm kiếm theo yêu cầu. E rằng các bác ây sẽ vất vả... nếu em lười tìm kiếm! :s_big:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Ko biết bác SSG có share đúng file này ko? Đây là file có mục đích nt

 

;; Spline2Pline.lsp © 2005 Lloyd Beachy
;; Routine to convert splines to plines

(Defun C:S2P (/	ss pt# cmdecho osmode clayer count ent lay lng pt-list
	  cnt)
 (vl-load-com)
 (setq	ss	(ssget '((0 . "spline")))
pt#	(getint "Enter number of segments <100>:")
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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nhiều khi tìm lại bài của chính mình cũng... khá vất vả! Khối lượng không nhiều, xin post lại ở đây.

Lisp này chơi tất: line, pline, spline, arc, circle, ellipse sang pline (không chứa cung tròn mà thành nhiều đoạn thẳng nhỏ liên tiếp). Chiều dài mỗi đoạn nhỏ user chọn tuỳ ý, mặc định là 0.5:

 

;;;***********************************************************
;;;CONVERT TO PLINES PROGRAM WITH FULL COMMENTS!
;;;Convert all objects: Line, Pline, Spline, Arc, Circle, Ellipse_
;;;to Plines. Length of 1 segment is specified by user
;;;Copy & Paste to Notepad, Saveas *.lsp, Appload then Type C2P to run
;;;Happy New Year 2008!
;;;Written by ssg - January 2008 - www.cadviet.com
;;;***********************************************************

;;;-------------------------------------------------------------
(defun makepl ( e d1 / ps pe d d2 p2) ;;;Make pline along curve e. Length of 1 segment = d1
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
ps (vlax-curve-getStartPoint e) ;;;Start point
pe (vlax-curve-getEndPoint e) ;;;End point
d (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) ;;;Length of curve e
d2 d1 ;;;Init variable distance
)
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
(setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along curve
(command p2) ;;;Continue pline command from current point to p2
(setq d2 (+ d2 d1)) ;;;Increase distance d2 by d1
) ;;;End while
(command pe "") ;;;Pline to pe and finish command
)
;;;-------------------------------------------------------------
(defun C:C2P( / d1 ss oldos i e ans) ;;;Convert to Plines
(if (not d0) (setq d0 0.5)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))) ;;;Selection set
oldos (getvar "osmode") ;;;Save osmode
i 0 ;;;Init counter
)
(setvar "osmode" 0) ;;;Disable osmode
(repeat (sslength ss) ;;;Repeat for all entities in ss
(setq e (ssname ss i)) ;;;Set e for entity with ordinal i in selection set ss
(makepl e d1) ;;;Use makepl function. Make pline along e
(setq i (1+ i)) ;;;Increase counter
)
(initget "Y N") ;;;Init keywords
(setq ans (getkword "\nDelete source objects? [Yes/No] <N>:")) ;;;Get answer from user
(if (= ans "Y") (command "erase" ss "")) ;;;Erase source objects if ans = "y" or "Y"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)
;;;-------------------------------------------------------------

  • Vote tăng 7

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

(defun C:s2p ()
(while (not (and
		  (setq lstSelection   (entsel "\nSelect Spline: "))
		  (setq sngSegment	 (getdist "\nGet Segment Length: "))
		  (setq objSelection   (vlax-ename->vla-object (car
lstSelection)))
		  (wcmatch (vla-get-objectname objSelection) 

"AcDb2dPolyline,AcDbPolyline,AcDbLine,AcDbArc,AcDbSpline"
		  )
		 )
	)
 (princ "\nError please select again: ")
)
(setq sngLength   (vlax-curve-getDIstAtParam objSelection
				(vlax-curve-getEndParam objSelection)
			   )
   sngDistance 0.0
)
(vl-cmdf "._pline" (vlax-curve-getpointatDist objSelection 0.0))  (repeat (fix (/ sngLength sngSegment))
 (vl-cmdf (vlax-curve-getpointatDist objSelection sngDistance))
 (setq sngDistance (+ sngDistance sngSegment))
)
(vl-cmdf (vlax-curve-getPointAtParam objSelection
	   (vlax-curve-getEndParam objSelection)
	  )
	  ""
)
)

 

Đoạn mã trên đây cũng khá hay. bạn thử dùng nhé.

  • Vote tăng 3

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Em mới học Cad, cho hỏi những đoạn Code đó gián vào đâu??

đoạn code này bạn dán nó vào trong 1 cái lisp bất kỳ xong vào cad appload cái lisp mà bạn dán lên, chạy dùng thử là okie mà

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
(defun C:s2p ()
(while (not (and
		  (setq lstSelection   (entsel "\nSelect Spline: "))
		  (setq sngSegment	 (getdist "\nGet Segment Length: "))
		  (setq objSelection   (vlax-ename->vla-object (car
lstSelection)))
		  (wcmatch (vla-get-objectname objSelection) 

"AcDb2dPolyline,AcDbPolyline,AcDbLine,AcDbArc,AcDbSpline"
		  )
		 )
	)
 (princ "\nError please select again: ")
)
(setq sngLength   (vlax-curve-getDIstAtParam objSelection
				(vlax-curve-getEndParam objSelection)
			   )
   sngDistance 0.0
)
(vl-cmdf "._pline" (vlax-curve-getpointatDist objSelection 0.0))  (repeat (fix (/ sngLength sngSegment))
 (vl-cmdf (vlax-curve-getpointatDist objSelection sngDistance))
 (setq sngDistance (+ sngDistance sngSegment))
)
(vl-cmdf (vlax-curve-getPointAtParam objSelection
	   (vlax-curve-getEndParam objSelection)
	  )
	  ""
)
)

 

Đoạn mã trên đây cũng khá hay. bạn thử dùng nhé.

 

Bro có thể viết lisp sử dụng arc trong polyline được không , mình thấy nhiều đoạn thẳng quá

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
mà mìn dùng lệnh j hả mấy pác

 

Lệnh ở ngay sau defun c : đó bạn

VD: defun C:s2p thì lệnh là s2p

:bigsmile:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Lệnh ở ngay sau defun c : đó bạn

VD: defun C:s2p thì lệnh là s2p

:cheers:

Ok. Lisp tuyệt vời thật! :cheers:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Ok. Lisp tuyệt vời thật! :cheers:

Trên diễn đàn đã có bài viết chuyển SPL sang PL không cần dùng líp!

Hãy vào chức năng tìm kiếm!

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sao mình dùng mấy Lisp này chuyển từ Elip sang polyline không đc nhỉ? Ai xem giúp mình với

 

http://www.mediafire...jvtk3bu87xe78qy

1). Muốn chuyển elip sang lwpolyline bạn phải chuyển elip sang spline, sau đó chuyển từ spline sang lwpolyline bằng lisp ở trên. Riêng chuyển từ elip sang spline thì bạn xem trang đố vui số 11 sẽ có.

2). Tuy nhiên xem trên bản vẽ thì thấy hình của bạn không ăn nhập gì với câu hỏi của bạn, vì nó có tới hàng trăm đối tượng. Vậy cần phải nối chúng lại đã.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn dùng lệnh FLATTEN nhé

Còn một cách nữa không cần phải nhớ lệnh FLATTEN:

Nhấp đúp chuột >> tiếp tục chuột phải >>> sẽ hiện ra bảng sau:

jud665fgudx.jpg

Command: _splinedit

Enter an option [Close/Join/Fit data/Edit vertex/convert to

Polyline/Reverse/Undo/eXit] <eXit>: P

Specify a precision <10>:

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Còn một cách nữa không cần phải nhớ lệnh FLATTEN:

Nhấp đúp chuột >> tiếp tục chuột phải >>> sẽ hiện ra bảng sau:

jud665fgudx.jpg

Command: _splinedit

Enter an option [Close/Join/Fit data/Edit vertex/convert to

Polyline/Reverse/Undo/eXit] <eXit>: P

Specify a precision <10>:

Acad 2007 không có tuỳ chọn "convert to Polyline". Chắc Cad đời cao hơn mới có?

Trích dẫn:

Command: _splinedit

Enter an option [Fit data/Close/Move vertex/Refine/rEverse/Undo]:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

AutoCAD2004 không biết có ko, nhưng chắc chắn 100% là Autocad2007 có, em dùng nhiều từ lâu rồi, chỗ đang làm mọi người đều dùng CAD đời cao hết nên ko nói cho bác biết được. Thao tác cũng tương tự chọn đối tượng 1 hoặc nhấp đúp, chon chuột phải hoặc trái nó không hiện ra bảng như CAD đời cao mà hiện tùy chọn dưới dòng lệnh. Bác cứ thử đi, nếu không được em sẽ Loat 2007 về và cài đặt lại rồi nói với bác sau.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

AutoCAD2004 không biết có ko, nhưng chắc chắn 100% là Autocad2007 có, em dùng nhiều từ lâu rồi, chỗ đang làm mọi người đều dùng CAD đời cao hết nên ko nói cho bác biết được. Thao tác cũng tương tự chọn đối tượng 1 hoặc nhấp đúp, chon chuột phải hoặc trái nó không hiện ra bảng như CAD đời cao mà hiện tùy chọn dưới dòng lệnh. Bác cứ thử đi, nếu không được em sẽ Loat 2007 về và cài đặt lại rồi nói với bác sau.

Tất cả ở trên là trích dẫn từ dòng command khi dùng lệnh splinedit từ bàn phím (hay nhấp chuột cũng thế) của cad2007 tôi vừa thử xong mà. Nếu bạn đã dùng có thì coi là có vậy, cũng không quan trọng gì lắm, đôi lúc có thể tôi cài không đầy đủ cũng nên.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

1). Muốn chuyển elip sang lwpolyline bạn phải chuyển elip sang spline, sau đó chuyển từ spline sang lwpolyline bằng lisp ở trên. Riêng chuyển từ elip sang spline thì bạn xem trang đố vui số 11 sẽ có.

2). Tuy nhiên xem trên bản vẽ thì thấy hình của bạn không ăn nhập gì với câu hỏi của bạn, vì nó có tới hàng trăm đối tượng. Vậy cần phải nối chúng lại đã.

1). Muốn chuyển elip sang lwpolyline bạn phải chuyển elip sang spline, sau đó chuyển từ spline sang lwpolyline bằng lisp ở trên. Riêng chuyển từ elip sang spline thì bạn xem trang đố vui số 11 sẽ có.

2). Tuy nhiên xem trên bản vẽ thì thấy hình của bạn không ăn nhập gì với câu hỏi của bạn, vì nó có tới hàng trăm đối tượng. Vậy cần phải nối chúng lại đã.

1, mình cũng đang đau đầu vì các đối tượng không liên tục đây, bây h mà nối thủ công thì khá lâu, bạn có cách nào không

2, Không ăn nhập là sao, các Lisp đưa lên đều thấy nói là chuyển các đối tượng (kể cả elip, spline...) thành polyline đó thôi?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

1, mình cũng đang đau đầu vì các đối tượng không liên tục đây, bây h mà nối thủ công thì khá lâu, bạn có cách nào không

2, Không ăn nhập là sao, các Lisp đưa lên đều thấy nói là chuyển các đối tượng (kể cả elip, spline...) thành polyline đó thôi?

1). Trên CV có nhiều lisp chuyển về pline. Riêng của tác giả SSG (chắc bạn đang dùng nó) thì chuyển được cả elip về pline nên không cần bước chuyển từ elip về spline như tôi đã nói.

2). Trong hình vẽ của bạn: các đối tượng đã chuyển về pline xong rồi. Vấn đề còn lại mà có lẽ bạn chưa nhận ra, đó là có rất nhiều pline trên hình. Bạn phải dùng lệnh PEDIT để nối chúng lại là xong.

P/S (14h47-22/2/12):

Tôi đã thử chạy lisp của ssg thì quả thực nó không thể chuyển Elip sang Pline được (có lẽ file của bạn xuất từ 1 phần mềm nào đó mà lisp không hiểu?). Có cách khác: với các Elip bạn dùng lisp dưới đây để chuyển.

Sau khi chuyển xong sang Pline hết, bạn dùng Pedit để nối theo từng cụm, cũng nhanh thôi.

Tại sao phải nối theo từng cụm? Tôi đã thử chọn tất cả đối tượng để nối bằng Pedit thì nó "chẳng làm gì cả". Nhưng nếu phân ra từng cụm nhỏ và xử lý trong từng cụm thì nó nối vô tư. Tôi cũng không hiểu tại sao, nhưng thực tế trên bản vẽ của bạn là vậy (hình trên bản vẽ của bạn chỉ cần phân ra 3 cụm ở 3 góc là được).

Bạn thử xem sao nhé!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

1). Trên CV có nhiều lisp chuyển về pline. Riêng của tác giả SSG (chắc bạn đang dùng nó) thì chuyển được cả elip về pline nên không cần bước chuyển từ elip về spline như tôi đã nói.

2). Trong hình vẽ của bạn: các đối tượng đã chuyển về pline xong rồi. Vấn đề còn lại mà có lẽ bạn chưa nhận ra, đó là có rất nhiều pline trên hình. Bạn phải dùng lệnh PEDIT để nối chúng lại là xong.

1. Mình đã down vài lisp của vài tác giả ( kể cả SSG) để chuyển các đối tượng sang polyline nhưng không được nên mới up lên để hỏi?

2. bạn xem chưa kỹ hình vẽ của mình đã nói, riêng phần mình trích ra đã có rất nhiều đối tượng không phải polyline ( hình tròn bên trong, 2 đoạn nằm phía trên) chưa kể trong hình chính. pedit thì tôi biết n cần phải chuyển về Polyline trước đã bạn thân mến ah!!!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

1. Mình đã down vài lisp của vài tác giả ( kể cả SSG) để chuyển các đối tượng sang polyline nhưng không được nên mới up lên để hỏi?

2. bạn xem chưa kỹ hình vẽ của mình đã nói, riêng phần mình trích ra đã có rất nhiều đối tượng không phải polyline ( hình tròn bên trong, 2 đoạn nằm phía trên) chưa kể trong hình chính. pedit thì tôi biết n cần phải chuyển về Polyline trước đã bạn thân mến ah!!!

Lisp chuyển Elip về Pline đây bạn (tôi đi mót). Bạn chú ý trở lại bài viết trên xem thêm vì tôi vừa P/S xong.

(defun EllipseToPolyline (el	/ 	cl	norm  cen	elv   pt0   pt1  	pt2	pt3   pt4   ac0
	  	ac4	a04   a02   a24  	bsc0	bsc2  bsc3  bsc4  plst	blst  spt   spa
	  	fspa	srat  ept   epa  	fepa	erat  n
	     )
 (vl-load-com)
 (setq	cl   (= (ang<2pi (vla-get-StartAngle el))
	(ang<2pi (vla-get-EndAngle el)))
norm (vlax-get el 'Normal)
cen  (trans (vlax-get el 'Center) 0 norm)
elv  (caddr cen)
cen  (3dTo2dPt cen)
pt0  (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen)
ac0  (angle cen pt0)
pt4  (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm))
pt2  (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm))
ac4  (angle cen pt4)
a04  (angle pt0 pt4)
a02  (angle pt0 pt2)
a24  (angle pt2 pt4)
bsc0 (/ (ang<2pi (- a02 ac4)) 2.)
bsc2 (/ (ang<2pi (- a04 a02)) 2.)
bsc3 (/ (ang<2pi (- a24 a04)) 2.)
bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.)
pt1  (inters pt0
     	(polar pt0 (+ ac0 (/ pi 2.) bsc0) 1.)
     	pt2
     	(polar pt2 (+ a02 bsc2) 1.)
     	nil
    	)
pt3  (inters pt2
     	(polar pt2 (+ a04 bsc3) 1.)
     	pt4
     	(polar pt4 (+ a24 bsc4) 1.)
     	nil
    	)
plst (list pt4 pt3 pt2 pt1 pt0)
blst (mapcar '(lambda (B) (tan (/ b 2.)))
     	(list bsc4 bsc3 bsc2 bsc0)
    	)
 )
 (foreach b blst
(setq blst (cons b blst))
 )
 (foreach b blst
(setq blst (cons b blst))
 )
 (foreach p (cdr plst)
(setq ang  (angle cen p)
 	plst (cons
     (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p))
     plst
      	)
)
 )
 (foreach p (cdr plst)
(setq ang  (angle cen p)
 	plst (cons
     (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p))
     plst
      	)
)
 )
 (setq	pl
    (vlax-invoke
      (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      'AddLightWeightPolyline
      (apply 'append
  	(setq	plst
	     (reverse (if cl
				(cdr plst)
				plst
		  	)
	     )
  	)
      )
    )
 )
 (vlax-put pl 'Normal norm)
 (vla-put-Elevation pl elv)
 (mapcar '(lambda (i v) (vla-SetBulge pl i v))
 	'(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
 	blst
 )
 (if cl
(vla-put-Closed pl :vlax-true)
(progn
 	(setq spt     (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint))
	spa     (vlax-curve-getParamAtPoint pl spt)
	fspa (fix spa)
	ept     (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint))
	epa     (vlax-curve-getParamAtPoint pl ept)
	fepa (fix epa)
	n     0
 	)
 	(cond
((equal spt (trans pt0 norm 0) 1e-9)
    (if (= epa fepa)
      (setq plst (sublist plst 0 (1+ fepa))
     blst (sublist blst 0 (1+ fepa))
      )
      (setq erat (/ (- (vlax-curve-getDistAtParam pl epa)
			(vlax-curve-getDistAtParam pl fepa)
	     )
	     (- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
			(vlax-curve-getDistAtParam pl fepa)
	     )
  		)
     plst (append (sublist plst 0 (1+ fepa))
	  		(list (3dTo2dPt (trans ept 0 norm)))
  		)
     blst (append (sublist blst 0 (1+ fepa))
	  		(list (k*bulge (nth fepa blst) erat))
  		)
      )
    )
)
((equal ept (trans pt0 norm 0) 1e-9)
    (if (= spa fspa)
      (setq plst (sublist plst fspa nil)
     blst (sublist blst fspa nil)
      )
      (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			(vlax-curve-getDistAtParam pl spa)
	     )
	     (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
			(vlax-curve-getDistAtParam pl fspa)
	     )
  		)
     plst (cons (3dTo2dPt (trans spt 0 norm))
			(sublist plst (1+ fspa) nil)
  		)
     blst (cons (k*bulge (nth fspa blst) srat)
			(sublist blst (1+ fspa) nil)
  		)
      )
    )
)
(T
    (setq srat (/ (- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
	  	(vlax-curve-getDistAtParam pl spa)
       	)
       	(- (vlax-curve-getDistAtParam pl (rem (1+ fspa) 17))
	  	(vlax-curve-getDistAtParam pl fspa)
       	)
		)
      	erat (/ (- (vlax-curve-getDistAtParam pl epa)
	  	(vlax-curve-getDistAtParam pl fepa)
       	)
       	(- (vlax-curve-getDistAtParam pl (rem (1+ fepa) 17))
	  	(vlax-curve-getDistAtParam pl fepa)
       	)
		)
    )
    (if (< epa spa)
      (setq plst (append
		(if (= spa fspa)
	  	(sublist plst fspa nil)
	  	(cons	(3dTo2dPt (trans spt 0 norm))
			(sublist plst (1+ fspa) nil)
	  	)
		)
		(cdr (sublist plst 0 (1+ fepa)))
		(if (/= epa fepa)
	  	(list (3dTo2dPt (trans ept 0 norm)))
		)
  		)
     blst (append
		(if (= spa fspa)
	  	(sublist blst fspa nil)
	  	(cons
			(k*bulge (nth fspa blst) srat)
			(sublist blst (1+ fspa) nil)
	  	)
		)
		(sublist blst 0 fepa)
		(if (= epa fepa)
	  	(list (nth fepa blst))
	  	(list (k*bulge (nth fepa blst) erat))
		)
  		)
      )
      (setq plst (append
		(if (= spa fspa)
	  	(sublist plst fspa (1+ (- fepa fspa)))
	  	(cons	(3dTo2dPt (trans spt 0 norm))
			(sublist plst (1+ fspa) (- fepa fspa))
	  	)
		)
		(list (3dTo2dPt (trans ept 0 norm)))
  		)
     blst (append
		(if (= spa fspa)
	  	(sublist blst fspa (- fepa fspa))
	  	(cons
			(k*bulge (nth fspa blst) srat)
			(sublist blst (1+ fspa) (- fepa fspa))
	  	)
		)
		(if (= epa fepa)
	  	(list (nth fepa blst))
	  	(list (k*bulge (nth fepa blst) erat))
		)
  		)
      )
    )
)
 	)
 	(vlax-put pl 'Coordinates (apply 'append plst))
 	(foreach b blst
(vla-SetBulge pl n B)
(setq n (1+ n))
 	)
)
 )
 pl
)

;; Ang<2pi
;; Returns the angle expression betweem 0 and 2*pi
(defun ang<2pi (ang)
 (if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
 )
)

;; 3dTo2dPt
;; Returns the 2d point (x y) of a 3d point (x y z)
(defun 3dTo2dPt (pt) (list (car pt) (cadr pt)))

;; Tan
;; Returns the angle tangent
(defun tan (a) (/ (sin a) (cos a)))

;; SUBLIST
;; Returns a sub list
;;
;; Arguments
;; lst : a list
;; start : start index (first item = 0)
;; leng : the sub list length (number of items) or nil
(defun sublist (lst start leng / n r)
 (if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
 )
 (setq n (+ start leng))
 (while (< start n)
(setq r (cons (nth (setq n (1- n)) lst) r))
 )
)

;; K*BULGE
;; Returns the proportinal bulge to the référence bulge
;; Arguments :
;; b : the bulge
;; k : the proportion ratio (between angles or arcs length)
(defun k*bulge (b k / a)
 (setq a (atan B))
 (/ (sin (* k a)) (cos (* k a)))
)
;-----
;And two commands:
;EL2PL to transform selected ellipses into polylines
;PELL to draw an 'elliptical polyline' on the fly.
;; EL2PL
;; Converts ellipses and elliptcal arcs into polylines

(defun c:el2pl (/ *error* fra acdoc ss)
 (vl-load-com)
 (defun *error* (msg)
(if (and (/= msg "Fonction annulée")
    		(/= msg "Function cancelled")
   	)
 	(princ (strcat (if (= "FRA" (getvar 'locale))
              		"\nErreur: "
              		"\Error: "
            		)
            		msg
    		)
 	)
)
(vla-endUndoMark acdoc)
(princ)
 )
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (ssget '((0 . "ELLIPSE")))
(progn
 	(vla-StartUndoMark acdoc)
 	(vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc))
   	(EllipseToPolyline e)
   	(vla-delete e)
 	)
 	(vla-delete ss)
 	(vla-EndUndoMark acdoc)
)
 )
 (princ)
)

;; PELL
;; Draws an ellipse or an elliptical arc approximation (polyline) on the fly
(defun c:pell (/ *error* ec pe old ent)
 (vl-load-com)
 (defun *error* (msg)
(if (and msg
    		(/= msg "Fonction annulée")
    		(/= msg "Function cancelled")
   	)
 	(princ (strcat (if (= "FRA" (getvar 'locale))
              		"\nErreur: "
              		"\Error: "
            		)
            		msg
    		)
 	)
)
(setvar 'cmdecho ec)
(setvar 'pellipse pe)
(princ)
 )
 (setq ec  (getvar 'cmdecho)
   	pe  (getvar 'pellipse)
   	old (entlast)
 )
 (setvar 'cmdecho 1)
 (setvar 'pellipse 0)
 (command "_.ellipse")
 (while (/= 0 (getvar 'cmdactive))
(command pause)
 )
 (if (not (eq old (setq ent (entlast))))
(progn
(EllipseToPolyline (vlax-ename->vla-object ent))
(entdel ent)
)
 )
 (*error* nil)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Okie tks. Cái lisp này đã chuyển đc Elip to Polyline nhưng sao bạn không viết chương trình cho Lisp chuyển được tất cả các đối tượng như arc, spline, elip... thành Polyline, như thế có phải tiện hơn không?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×