Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
whatcholingon

[Yêu Cầu] Lisp vẽ một SPL trên một PL cho trước

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

Chào mọi người!

Mình có một bản vẽ trong đó có rất nhiều đường PL ( các đường này là đường đồng mức)

Nhưng các pl này có rất nhiều đường gấp khúc nhìn không được đẹp lắm

mọi người có thể viết cho mình một LSP như sau:

Chọn đường pl sau đó sẽ tự chạy một đường SPL bám theo đường pl cũ.

Như hình minh họa dưới

e71daaed0ba7ab3c94104d18c2029e45_45000838.t3.jpg

 

Ở trong hình mình MOVE đường SPL lên trên cho dễ nhìn thui. còn vị trị của nó là nằm cùng với PL ban đầu.

Mình up luôn bản vẽ lên mọi người coi cho dễ:

http://www.cadviet.com/upfiles/3/96857_t1.dwg

Mọi người viết giúp mình gấp nhé. mình đang rất cần.

Thanks!

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

Rất cần thì phải quick and dirty code thôi ^^

Của bạn đây, chọn hàng loạt Pline để chuyển thành SPline, giữ nguyên các thuộc tính Layer, Color,Linetype, LinetypeScale. Lisp có dùng hàm MakeSpline của bác Thái, 2 hàm của bộ Express

 


(defun c:p2s(/ ss lstPro MakeSPline ST:Geom-Vertext-List)
(command "undo" "be")
(prompt "\nChon Pline(s) :")
(cond ( (ssget (list (cons 0 "*POLYLINE")))
(vl-load-com)
(setq  lstPro '(Linetype LinetypeScale Layer Color))
(defun MakeSPline (listpoint Linetype LTScale Layer Color  / Lst)
(setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbSpline")
(cons 71 3)
(cons 74 (length listpoint))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP))))) 
(entmakex Lst)
);end
(defun ST:Geom-Vertext-List (e / typ poly) ;vlaObject
(setq typ (vlax-get e 'ObjectName))
(cond ((wcmatch typ "AcDbLine")(list (vlax-get e 'StartPoint)(vlax-get e 'EndPoint)))
(T 
(   (lambda ( f /)
(if (setq poly (vl-position typ '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline"))) 
(f (vlax-get e 'coordinates))
)
)
(lambda ( l )
(cond
((and l (= poly 0)) (cons (list (car l) (cadr l)) (f (cddr l))))
((and l (= poly 1)) (cons (list (car l) (cadr l)) (f (cdddr l))))
((and l (= poly 2)) (cons (list (car l) (cadr l) (caddr l)) (f (cdddr l))))
)
)
)
)
)
)
(vlax-for x (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))) 
(apply 
'MakeSPline 
(append
(list (ST:Geom-Vertext-List x))
(mapcar '(lambda(a)(vlax-get x a)) lstPro) 
)
)
(vla-erase x)
) 
)
)
(command "undo" "en")
)

  • 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

Thanks ketxu

nhưng khi đánh lệnh bị lỗi sau : error: no function definition: ACET-SS-TO-LIST

Ket khắc phục giùm mình nhé.

Mình dùng cad 2007 có cài Express rồ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

Nếu có express thì chắc chắn có hàm đó rồi. Bạn thử kiểm tra bằng cách copy dòng này vào commandline :

(acet-ss-to-list (ssget))

 

Nếu có thì nó sẽ chạy được

Trong trường hợp không được thì mình viết lại toàn bộ, không dùng ACET

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 đánh vào rùi chọn đối tượng nhưng vẫn báo lỗi trên. bạn sửa giúp mình với.

Chứng tỏ Express trên máy bạn có vấn đề. Mình sửa bên trên, ngay tại bài cũ, bạn down lại nhé. Lisp có thể áp dụng với mọi loại Pline (2D, 3D). Nếu muốn cả Line thì bạn xóa chữ POLY trong hàm ssget đi ^^ :) Gluck Guy

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 Làm trên cad 2010 thì lisp chạy rùi bạn ah.

Mà hình như lsp này là chuyển Pl thành Spl bạn ah.

Bạn có thể viết lsp chạy như bản vẽ mình up lên được không.

tại vì pl có nhiều chỗ gấp khúc giờ miễn sao chạy nhìn nó trơn đều. và nhìn không bị gấp khúc nữa.

Bạn nhìn ở hình. nét đầu tiên có nhiều chỗ gấp khúc. nét thứ hai ( trắng) nhìn trơn đều hơn.

chỉ cần bám theo pl cũ. những chỗ gấp khúc có thể cho chạy trơn đều có thể xê dịch 0.5m cũng được.

Thanks.

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

Chẳng phải yêu cầu của bạn chính là chuyển Pline thành SPline đó sao ? Mà spline mới chỉ có thể tạo được trên cơ sở các điểm của Pline cũ :o

Mình muốn giữ chân thực số lượng điểm, còn theo bản vẽ của bạn là lược bớt điểm đ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

Chẳng phải yêu cầu của bạn chính là chuyển Pline thành SPline đó sao ? Mà spline mới chỉ có thể tạo được trên cơ sở các điểm của Pline cũ :o

Mình muốn giữ chân thực số lượng điểm, còn theo bản vẽ của bạn là lược bớt điểm đi ?

Hình như ví dụ của chủ topic không đúng với y/c của chủ topic Ket à? Đoán: vi phân pline thành nhiều điểm để nó mịn mà ít "lệch" so với đường cũ nhất???

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

Chẳng phải yêu cầu của bạn chính là chuyển Pline thành SPline đó sao ? Mà spline mới chỉ có thể tạo được trên cơ sở các điểm của Pline cũ :o

Mình muốn giữ chân thực số lượng điểm, còn theo bản vẽ của bạn là lược bớt điểm đi ?

 

Hiện tại trên bản vẽ của mình pl. giờ tạo một PL or SPL miễn sao là bám theo đường PL cũ không quan trọng nhiều điểm hoặc ít điểm.

Miễn sao nhìn nó trơn đều là được, như ở hình vẽ là mình làm thủ công vẽ một SPL theo cái đường PL đó để nhìn nó được trơn và đẹp hơn. không bị gấp khúc nữa.

 

Bạn nhìn kỹ ở hình or trong bản vẽ nhé. Hình Pl thì không trơn và đẹp bằng Spl mình mới vẽ.

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

Nếu muốn làm mịn đi thì loại bỏ các điểm ở giữa, bạn sử dụng thằng này. Độ làm mịn càng lớn thì số đỉnh của Pline bị loại bỏ càng lớn. Ở máy của mình lấy ví dụ tầm 30 là đẹp :) Lần sau chịu khó trình bày kỹ hơn chút nữa hén, do mình hơi dốt nên dễ hiểu nhầm

(defun c:p2s(/ ss lstPro MakeSPline ST:Geom-Vertext-List  lstPro)
(command "undo" "be")
(setq a (getint "\nDo lam min :"))
(prompt "\nChon Pline(s) :")
(cond ( (ssget (list (cons 0 "*POLYLINE")))
 (vl-load-com)
 (setq  lstPro '(Linetype LinetypeScale Layer Color))
 (defun lstRe (lst n / rt sublst);(1 2 3 4)
  (defun sublst(lst it)(repeat (1- it) (setq lst (cdr lst))))
  (while lst
(setq rt (cons (car lst) rt) lst (sublst lst n))
  )  (reverse (vl-remove nil rt))
 )
 (defun MakeSPline (listpoint Linetype LTScale Layer Color  / Lst)
  (setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity")
		(cons 8 (if Layer Layer (getvar "Clayer")))
		(cons 6 (if Linetype Linetype "bylayer"))
		(cons 48 (if LTScale LTScale 1))
		(cons 62 (if Color Color 256))
		'(100 . "AcDbSpline")
   	(cons 71 3)
		(cons 74 (length listpoint))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP)))))  
  (entmakex Lst)
 );end
 (defun ST:Geom-Vertext-List (e / typ poly) ;vlaObject
  (setq typ (vlax-get e 'ObjectName))
  (cond ((wcmatch typ "AcDbLine")(list (vlax-get e 'StartPoint)(vlax-get e 'EndPoint)))
(T
(   (lambda ( f /)
 	(if (setq poly (vl-position typ '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")))    
  	(f (vlax-get e 'coordinates))
 	)
 	)
(lambda ( l )
 	(cond
  	((and l (= poly 0)) (cons (list (car l) (cadr l)) (f (cddr l))))
  	((and l (= poly 1)) (cons (list (car l) (cadr l)) (f (cdddr l))))
  	((and l (= poly 2)) (cons (list (car l) (cadr l) (caddr l)) (f (cdddr l))))
 	)
)
)
)
  )
 )
(vlax-for x (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
 (apply
  'MakeSPline
(append
(list (lstRe (ST:Geom-Vertext-List x) a))
(mapcar '(lambda(a)(vlax-get x a)) lstPro)    
)
 )
 (vla-erase x)
)
)
)
(command "undo" "en")
)

  • 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

Nếu muốn làm mịn đi thì loại bỏ các điểm ở giữa, bạn sử dụng thằng này. Độ làm mịn càng lớn thì số đỉnh của Pline bị loại bỏ càng lớn. Ở máy của mình lấy ví dụ tầm 30 là đẹp :) Lần sau chịu khó trình bày kỹ hơn chút nữa hén, do mình hơi dốt nên dễ hiểu nhầm

(defun c:p2s(/ ss lstPro MakeSPline ST:Geom-Vertext-List  lstPro)
(command "undo" "be")
(setq a (getint "\nDo lam min :"))
(prompt "\nChon Pline(s) :")
(cond ( (ssget (list (cons 0 "*POLYLINE")))
 (vl-load-com)
 (setq  lstPro '(Linetype LinetypeScale Layer Color))
 (defun lstRe (lst n / rt sublst);(1 2 3 4)
  (defun sublst(lst it)(repeat (1- it) (setq lst (cdr lst))))
  (while lst
(setq rt (cons (car lst) rt) lst (sublst lst n))
  )  (reverse (vl-remove nil rt))
 )
 (defun MakeSPline (listpoint Linetype LTScale Layer Color  / Lst)
  (setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 62 (if Color Color 256))
	'(100 . "AcDbSpline")
   	(cons 71 3)
	(cons 74 (length listpoint))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP)))))  
  (entmakex Lst)
 );end
 (defun ST:Geom-Vertext-List (e / typ poly) ;vlaObject
  (setq typ (vlax-get e 'ObjectName))
  (cond ((wcmatch typ "AcDbLine")(list (vlax-get e 'StartPoint)(vlax-get e 'EndPoint)))
(T
(   (lambda ( f /)
 	(if (setq poly (vl-position typ '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")))    
  	(f (vlax-get e 'coordinates))
 	)
 	)
(lambda ( l )
 	(cond
  	((and l (= poly 0)) (cons (list (car l) (cadr l)) (f (cddr l))))
  	((and l (= poly 1)) (cons (list (car l) (cadr l)) (f (cdddr l))))
  	((and l (= poly 2)) (cons (list (car l) (cadr l) (caddr l)) (f (cdddr l))))
 	)
)
)
)
  )
 )
(vlax-for x (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
 (apply
  'MakeSPline
(append
(list (lstRe (ST:Geom-Vertext-List x) a))
(mapcar '(lambda(a)(vlax-get x a)) lstPro)    
)
 )
 (vla-erase x)
)
)
)
(command "undo" "en")
)

 

Thanhs!

Bạn khiêm tốn quá ! mình muốn dốt như bạn mà còn chẳng được nữa là.

Về diễn giải hay trình bày một cái gì đó thì mình kém lắm. (văn học mình học cực dốt mà)

Mọi người thông cả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

Bạn dùng lệnh PE để biến nó thành đường trơn là được ! cần gì vất vả thế! mà mấy cái lisp dùng khó khăn lăm.lúc dc lúc ko!

1). Trơn theo bạn hiểu (dùng PE) không đáp ứng yêu cầu trơn của chủ topic bạn à!

2). Chả lẽ cứ lisp là dùng lúc được lúc không? Lisp tệ vậy sao? Nên chi bạn không bao giờ dùng lisp?

  • 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

Nhân tiện đây.Mọi người cho mình hỏi là thể viết lsp làm được như vậy không:

Mình có 1 đường SPL trong đó có các text nằm đè lên trên spl đó.

Vậy có cách nào or Lsp mà :

Break được đoạn spl mà text nó đè lên không vậy.

Như trong hình dưới đây:

048ae8060070f4ca5e362c6ded5874f0_45087124.t.jpg

 

Thanks!

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

Đừng Break vì như vậy nó sẽ mất tính năng của Spline, hãy dùng textmask của Express hoặc 1 lisp bác Thái viết lại để dùng với cả Anonation Text

  • 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 có thể nói rõ thao tác của lệnh Textmask không. mình thực hiền mà không được

. ở đây mình phải br nó đi để nhìn cho rễ.

(Nếu không Break thì mình có cách làm như thế này: Tạo block cái text đó có cả WIPEOUT sau đó dùng lệnh MEASURE là OK)

Nhưng sếp lại kêu là Break đi bạ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

Textmask chỉ áp dụng cho TEXT. Nếu bạn đang dùng Mtext thì Explode nó ra. Thao tác thì mình không thấy có gì đáng nói cả, đánh lệnh, chọn text, nhập giá trị offset hoặc Masktype nếu cần

Còn nếu sếp bạn muốn break thì bạn nên thuyên chuyển công tác thì hơn

  • 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 có thể nói rõ thao tác của lệnh Textmask không. mình thực hiền mà không được

. ở đây mình phải br nó đi để nhìn cho rễ.

(Nếu không Break thì mình có cách làm như thế này: Tạo block cái text đó có cả WIPEOUT sau đó dùng lệnh MEASURE là OK)

Nhưng sếp lại kêu là Break đi bạn ah.

Bảo sếp của bạn: ông bắt tôi break ra rồi nếu có phải chỉnh sửa sau này thì ông tính sao?

 

- Nếu đó là đường đồng mức và chữ số ấy là nhãn của đường đồng mức, mà sếp bạn yêu cầu như vậy thì hắn bị hâm hoặc chả biết gì về cách thức làm việc với số liệu của bản vẽ. đừng có nhắm mắt nghe cái dốt của hắn. hãy làm theo cách ketxu bày cho bạn.

 

- Nếu đó không phải là đường đồng mức mà chỉ là 1 đường mục đích ghi chú gì đó thì tốt hơn là bạn tạo 1 linetype.

  • 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

Textmask chỉ áp dụng cho TEXT. Nếu bạn đang dùng Mtext thì Explode nó ra. Thao tác thì mình không thấy có gì đáng nói cả, đánh lệnh, chọn text, nhập giá trị offset hoặc Masktype nếu cần

Còn nếu sếp bạn muốn break thì bạn nên thuyên chuyển công tác thì hơn

MTEXT thì background mask có sẵn trong properties rồi, ko cần xài lệnh textmask nữa.

83237_1.png

AutoCAD R18 có chọn dc color cho mask nữa.

Good luck!

  • 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

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
Đăng nhập để thực hiện theo  

×