Đến nội dung


Hình ảnh
* - - - - 1 Bình chọn

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


  • Please log in to reply
35 replies to this topic

#1 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 09:31 AM

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
Hình đã gửi

Ở 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.c.../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!
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 May 2012 - 10:11 AM

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")
)

  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 10:45 AM

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.
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 May 2012 - 11:02 AM

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
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 11:05 AM

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.
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 May 2012 - 11:11 AM

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
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 11:12 AM

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.
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 May 2012 - 11:22 AM

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 ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 21 May 2012 - 11:27 AM

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???
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 11:35 AM

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ẽ.
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 May 2012 - 11:47 AM

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")
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 21 May 2012 - 11:57 AM

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.
  • 0

#13 Haiautrang_212

Haiautrang_212

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 May 2012 - 07:25 PM

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!
  • 0

#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 21 May 2012 - 07:33 PM

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?
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 22 May 2012 - 11:19 PM

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:
Hình đã gửi

Thanks!
  • 0

#16 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 22 May 2012 - 11:24 PM

Đừ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
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#17 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 22 May 2012 - 11:38 PM

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.
  • 0

#18 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 22 May 2012 - 11:57 PM

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
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#19 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 23 May 2012 - 12:00 AM

Vậy muốn break cũng không có cách nào à bạn
  • 0

#20 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 May 2012 - 12:04 AM

Vậy muốn break cũng không có cách nào à bạn

Thực hiện lệnh Break :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC