Đến nội dung


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

Thêm node vào đường Pline


  • Please log in to reply
75 replies to this topic

#61 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 06 May 2010 - 11:16 AM

Bây giờ muốn bỏ node ra khỏi polyline thì có làm đc kg các bác ?

Trong Cad thì dùng lệnh overkill
Trong LISP thì sửa đổi 2 thông số :
- coordinates : tọa độ node
- bulge : tạm dịch là độ lồi lõm của Curve
rồi Update Pline.

Đây là LISP xóa node Pline đơn giản gồm các Vertex là LINE (sẽ xóa luôn 2 Vertex kề với node)
(defun c:dvx (/ bulges coords ent idx param pt);del Vretex
(defun removenth (n lst / i rtn)
(setq i -1)
(foreach x lst
(if (/= n (setq i (1+ i)))
(setq rtn (cons x rtn)) ) )
(reverse rtn) )

(while (and (setq ent (entsel "\nSelect vertex to remove: "))
(eq (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
(setq pt (osnap (cadr ent) "near")
ent (vlax-ename->vla-object (car ent))) )
(setq param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0)))
(setq coords (vlax-get ent 'coordinates)
idx -1
bulges nil)
(repeat (/ (length coords) 2)
(setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges))
)
(setq bulges (removenth param (reverse bulges)))
(repeat 2
(setq coords (removenth (* 2 param) coords)) )
(vlax-put ent 'coordinates coords)
(setq idx -1)
(foreach bulge bulges
(vla-setbulge ent (setq idx (1+ idx)) bulge))
)
(princ)
)

  • 2

#62 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 23 August 2010 - 09:39 PM

Mong bác dùng thử và cho ý kiến để mình rút kinh nghiệm nha.


(defun c:NBPL()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (car (entsel "\n Pick chon doi tuong : ")))
(Hli ss)
(setq po (getpoint "\n Chon diem cat : "))
;;;(setq ddau (vlax-curve-getstartPoint ss ))
;;;(setq dcuoi (vlax-curve-getEndPoint ss ))
(if (= (cdr (assoc 0 (entget ss))) "POLYLINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(command "undo" "be")
(entdel ent )
(command "undo" "e")
(setq ss (entlast))
(command "undo" "1")
(Command "Pedit" ss "j" ent "" "")
(Hli (entlast))
(while po
(setq po (getpoint "\n Chon diem cat tiep theo : "))
;;;(Command "select" ddau dcuoi "")
;;;(setq ss (ssget "P"))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(command "undo" "be")
(entdel ent)
(command "undo" "e")
(setq ss (entlast))
(command "undo" "1")
(Command "Pedit" ss "j" ent "" "")
;;;(sssetfirst ss ss)
(Hli ss)
)
)
)
)
)
(if (= (cdr (assoc 0 (entget ss))) "LWPOLYLINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
(while po
(setq po (getpoint "\n Chon diem cat tiep theo : "))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
)
)
)
)
)
(if (= (cdr (assoc 0 (entget ss))) "LINE")
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "y" "j" ent "" "")
(setq ss (entlast))
(Hli ss)
(while po
(setq po (getpoint "\n Chon diem cat tiep theo : "))
(if (/= po nil)
(progn
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
)
)
)
)
)
(setvar "osmode" oldos)

(princ)
)
;
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))
)

Chúc bác khỏe và vui.

PS: các loại đường khác như arc , cung elip và spline mình thấy hình như mọi người ít dùng nên cũng chưa nghiên cứu rõ lắm. Nếu bác xét thấy cần thiết thì mình sẽ thử cố tí nữa xem sao. Hề hề hề....

Cám ơn bác nhiều. E hiện đang sử dụng phần mềm, nên khi break thì nó mất 1 số tính năng do phần mềm nó định nghĩa. Liệu có thể chỉ cần chèn điểm vertex (nhưng k break sau đó nối lại) được k ?
  • 0

#63 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 24 August 2010 - 08:31 AM

lisp này cũng tốt đấy chứ. Chỉ có điều nếu tách nhập điểm riêng thì người dùng bắt điểm chính xác hơn.

Sao các lisp ADV và IV Addvertex.lsp e tải xuống nhưng khi chạy, đường pline vẫn còn nguyên vẹn, k thêm được điểm vertex nào bác nhỉ ? Giúp đỡ e với. E đang sử dụng cad 2010
  • 0

#64 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 24 August 2010 - 10:28 AM

Sao các lisp ADV và IV Addvertex.lsp e tải xuống nhưng khi chạy, đường pline vẫn còn nguyên vẹn, k thêm được điểm vertex nào bác nhỉ ? Giúp đỡ e với. E đang sử dụng cad 2010

Bạn kiểm tra lại xem đường của bạn có phải là Line không. Để đảm bảo lisp chạy chính xác thì tốt nhất bạn nên dùng lệnh Convert để chuyển tất cả các đối tượng về đối tượng mới của Cad (nhiều bản vẽ dùng Cad đời cũ nên hay gặp trường hợp này)
  • 0

#65 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 24 August 2010 - 10:51 AM

Bạn kiểm tra lại xem đường của bạn có phải là Line không. Để đảm bảo lisp chạy chính xác thì tốt nhất bạn nên dùng lệnh Convert để chuyển tất cả các đối tượng về đối tượng mới của Cad (nhiều bản vẽ dùng Cad đời cũ nên hay gặp trường hợp này)

Mình vẽ thử 1 đường pl mới luôn mà. Mình tạo 1 bản vẽ mới, sau đó vẽ pl và apload file *.vlx, và thực thi thử 2 lệnh là ADV hoặc IV. Đường polyline vẫn trơ ra, k thêm được điểm nào cả.
  • 0

#66 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 24 August 2010 - 11:42 AM

Mình vẽ thử 1 đường pl mới luôn mà. Mình tạo 1 bản vẽ mới, sau đó vẽ pl và apload file *.vlx, và thực thi thử 2 lệnh là ADV hoặc IV. Đường polyline vẫn trơ ra, k thêm được điểm nào cả.

Trước khi chạy Lisp của Nataca, Sony hãy sử dụng lệnh Convert trước cái đã
Command: convert

Enter type of objects to convert [Hatch/Polyline/All] : P -> gõ P

Enter object selection preference [Select/All] : S -> gõ S
Select objects to convert: 1 found -> Chọn cái PLINE định thêm Vertex
Select objects to convert: -> Enter
  • 0

#67 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 12 January 2011 - 09:32 AM

Chào bạn AGI,
Bạn xem thử cái lisp này, mình cải tạo từ cái lisp của bác Tue_NV theo ý của bạn. Với cả LWPOLYLINE kín cũng như hở, sau khi thêm node đều không bị cắt rời mà vẫn giữ nguyên ename cũ. Bạn có thể so sánh hai cái lisp này sẽ thấy mình chỉ thay đổi cái cách sử dụng lệnh pedit của bác Tue_NV sau khi break mà thôi.
Bạn dùng thử và cho ý kiến nha.


(defun c:NBPL()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (car (entsel "\n Pick chon doi tuong : ")))
(Hli ss)
(setq po (getpoint "\n Chon diem cat : "))
;;;(setq ddau (vlax-curve-getstartPoint ss ))
;;;(setq dcuoi (vlax-curve-getEndPoint ss ))
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
(while po (setq po (getpoint "\n Chon diem cat tiep theo : "))
;;;(Command "select" ddau dcuoi "")
;;;(setq ss (ssget "P"))
(Command "break" ss po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
;;;(sssetfirst ss ss)
(Hli ss)
)
(setvar "osmode" oldos)
(princ)
)
;
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))
)


Hy vọng nó đạt được điều bạn mong muốn. Chúc bạn vui.

Lisp này hay ghê. Nhưng chỉ hay ghê với đường Lwpolyline. Còn đường polyline thì đối tượng bị vụn ra mất.
Em dùng Cad2007.
Anh phamthanhbinh hoàn thiện giúp được không?
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#68 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 12 January 2011 - 03:06 PM

Lisp này hay ghê. Nhưng chỉ hay ghê với đường Lwpolyline. Còn đường polyline thì đối tượng bị vụn ra mất.
Em dùng Cad2007.
Anh phamthanhbinh hoàn thiện giúp được không?

Hề hề hề,
Bạn đã thử cái lisp ở bài viết số 57 chưa??? Hình như nó có thể dùng được với yêu cầu của bạn.
Chúc bạn vui...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#69 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 12 January 2011 - 03:35 PM

Cái này với Cad2010 trở lên không cần LSP bạn ạ, nó là một lệnh sẵn trong pedit luôn, up lên mà xài bạn ạ, đẹp và nhiều tiện ích hơn nữa. :)
  • 1
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#70 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 14 April 2012 - 01:49 PM

Chào bác Meohoang,
Bác thử dùng cái này coi sao nhé.
Mình bổ sung thêm vào lisp để có thể sử dụng với các loại đường LINE, POLYLINE, và LWPOLYLINE bác ạ.
Thực ra cái đường 2Dpolyline như bác nêu chính là cái đường LWPOLYLINE mà mình đã làm trong cái lisp cũ. Tuy nhiên với POLYLINE tức là đường 3Dpolyline thì lisp không đúng nữa do với các POLYLINE này sau khi break nó sẽ tạo ra hai đối tượng hoàn toàn mới và cái đối tượng cũ (ename) bị mất đi. Vì thế cái lệnh Pedit của mình không còn đúng nữa.
Với các line cũng vậy break thì ngon nhưng khi pedit lại phải thay đổ cấu trúc lệnh mới được và sau khi pedit thì các LINE sẽ trở thành LWPOLYLINE.
Vì thế mình dùng thêm hàm điều kiện để pedit cho từng trường hợp cụ thể. Bác cứ xem thêm trong lisp sẽ hiểu cách mình làm.
Cách này tuy chưa gọn gàng lắm nhưng có thể dùng được bác ạ.
Mong bác dùng thử và cho ý kiến để mình rút kinh nghiệm nha.

(defun c:NBPL()(vl-load-com)(setq oldos (getvar "osmode"))(setvar "osmode" 0)(setq ss (car (entsel "\n Pick chon doi tuong : ")))(Hli ss)(setq po (getpoint "\n Chon diem cat : "));;;(setq ddau (vlax-curve-getstartPoint ss  ));;;(setq dcuoi (vlax-curve-getEndPoint ss ))(if (= (cdr (assoc 0 (entget ss))) "POLYLINE")(progn(Command "break" ss po "@")(setq ent (entlast))(command "undo" "be")(entdel ent )(command "undo" "e")(setq ss (entlast))(command "undo" "1")(Command "Pedit" ss "j" ent "" "")(Hli (entlast))(while po (setq po (getpoint "\n Chon diem cat tiep theo : "));;;(Command "select" ddau dcuoi "");;;(setq ss (ssget "P"))(if (/= po nil)(progn(Command "break" ss po "@")(setq ent (entlast))(command "undo" "be")(entdel ent)(command "undo" "e")(setq ss (entlast))(command "undo" "1")(Command "Pedit" ss "j" ent "" "");;;(sssetfirst ss ss)(Hli ss))))))(if (= (cdr (assoc 0 (entget ss))) "LWPOLYLINE")(progn(Command "break" ss po "@")(setq ent (entlast))(Command "Pedit" ss "j" ent "" "")(Hli ss)(while po (setq po (getpoint "\n Chon diem cat tiep theo : "))(if (/= po nil)(progn(Command "break" ss po "@")(setq ent (entlast))(Command "Pedit" ss "j" ent "" "")(Hli ss))))))(if (= (cdr (assoc 0 (entget ss))) "LINE")(progn(Command "break" ss po "@")(setq ent (entlast))(Command "Pedit" ss "y" "j" ent "" "")(setq ss (entlast))(Hli ss)(while po (setq po (getpoint "\n Chon diem cat tiep theo : "))(if (/= po nil)(progn(Command "break" ss po "@")(setq ent (entlast))(Command "Pedit" ss "j" ent "" "")(Hli ss))))))(setvar "osmode" oldos)(princ));(defun HLI(ent)(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))) 

Chúc bác khỏe và vui.

PS: các loại đường khác như arc , cung elip và spline mình thấy hình như mọi người ít dùng nên cũng chưa nghiên cứu rõ lắm. Nếu bác xét thấy cần thiết thì mình sẽ thử cố tí nữa xem sao. Hề hề hề....

Giữ bắt điểm trong code này thì cần làm j bác ơi. Chọn pline xong toàn mất bắt điểm thui....
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#71 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 April 2012 - 02:35 PM

Giữ bắt điểm trong code này thì cần làm j bác ơi. Chọn pline xong toàn mất bắt điểm thui....

Chẳng hạn, sửa lại như thế này:

(defun c:NBPL()
(setq ss (car (entsel "\n Pick chon doi tuong : ")))
(Hli ss)
(setq po (getpoint "\n Chon diem cat : "))
(Command "break" ss "non" po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss)
(while po (setq po (getpoint "\n Chon diem cat tiep theo : "))
(Command "break" ss "non" po "@")
(setq ent (entlast))
(Command "Pedit" ss "j" ent "" "")
(Hli ss))
(princ))
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd))))

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


#72 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 14 April 2012 - 10:57 PM

Giữ bắt điểm trong code này thì cần làm j bác ơi. Chọn pline xong toàn mất bắt điểm thui....

Hề hề hề,
Mất là mất thế nào nhỉ???
Trong lisp đã có trả biến "osmode" về giá trị ban đầu rồi mà.
Mà nếu có mất thì khôi phục lại mấy hồi hè??? Bạn hãy kiểm tra lại thao tác của bạn xem sao nhé. Trong quá trình chạy lisp bạn hòan toàn có quyền lựa chọn kiểu truy bắt trên thanh công cụ của CAD cơ mà....
Hề hề hề,
Nếu vẫn thấy không khoái thì hãy thử cái của bác DoanVanHa xem sao nhé. Qua đó bạn sẽ hiểu được cần hay không cần việc thay đổi biến này.
Hề hề hề,...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#73 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 April 2012 - 11:07 PM

Hề hề hề,
Mất là mất thế nào nhỉ???
Trong lisp đã có trả biến "osmode" về giá trị ban đầu rồi mà.
Mà nếu có mất thì khôi phục lại mấy hồi hè??? Bạn hãy kiểm tra lại thao tác của bạn xem sao nhé. Trong quá trình chạy lisp bạn hòan toàn có quyền lựa chọn kiểu truy bắt trên thanh công cụ của CAD cơ mà....
Hề hề hề,
Nếu vẫn thấy không khoái thì hãy thử cái của bác DoanVanHa xem sao nhé. Qua đó bạn sẽ hiểu được cần hay không cần việc thay đổi biến này.
Hề hề hề,...

Bác Bình!
Có lẽ bạn ấy nói chưa chính xác. Nhưng có thể do sơ ý mà bác osmode về 0 sớm quá.
Chứ cuối cùng thì nó vẫn trả về như cũ. Nhưng giữa chừng thì nó thay đổi, trong khi nó còn cần để chọn điểm.
  • 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.


#74 dunguss3581

dunguss3581

    biết lệnh rotate

  • Advance Member
  • PipPipPip
  • 139 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 13 May 2012 - 11:41 PM

:s_big: Đúng là mình cũng hiểu như bác Tuệ. Và đã làm cho bạn cái này: Thêm đỉnh vào Pline
Lệnh AVDV (add vertex divide-vì cái này giống như lệnh divide) : Thêm đỉnh với số lượng tuỳ ý vào Pline mà vẫn giữ nguyên đỉnh cũ. Tức là giữ nguyện hình dạnh Pline ban đầu cho bạn
Lệnh ADV : thêm đỉnh không nằm trên Pline (nó sẽ tự tìm cạnh gần điểm chọn nhất để thêm)
Lệnh IV : thêm đỉnh nhưng đỉnh này phải nằm trên Pline.

Chào các bác. Nay tìm lisp phục vụ công việc mình thấy lisp này hợp với công việc của mình cần nếu hiện màu xanh tại các nút như lisp "nbpl" của bác phamthanhbinh thì ok. nếu được bác nào có code lsp up lên cho em mót chút đỉnh thì tốt biết mấy. xin cảm ơn
  • 0

#75 namnhim

namnhim

    biết vẽ polygon

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

Đã gửi 14 May 2012 - 10:59 PM

không biết mục đích của bạn có phải tạo thêm các nút trên pline để nắn mềm bình độ không, nếu phải thì mình có đoạn code này có thể giúp bạn được:

====================================
SUA DUONG BINH DO:
====================================
(defun C:SS (/ Thoi chon3 chon Chon1 ChonC Chon1 ZC
S PTD PTC PL PTT DongMucGoc
DongMucCuoi X Y Z XT YT XC
YC Layer I D
)
(command "_layer" "m" "SUA" "c" "2" "" "")
(command "osmode" 512)
;(print " ! LOAI DUONG DONG MUC PHAI LA POLYLINE MOI SUA DUOC !")
;(print " ! De chuyen sang POLYLINE: dung ARGIC mo file VA EXPORT TO CAD !")
(setq PTD (getpoint "\nCHON DIEM DAU TIEN XUAT PHAT TU BINH DO"))
(command "osmode" 0)
(setq Chon (ssget PTD))
(setq Chon1 (ssname Chon 0))
(setq DongMucGoc (entget Chon1))
(setq Z (last (assoc 10 DongMucGoc)))
(setq PL '())
(setq X (car PTD)
Y (cadr PTD)
PTD (list X Y Z))
(setq PL (append PL (list PTD)))
(setq Layer (cdr (assoc 8 DongMucGoc)))
(setq DongMucGoc
(subst (cons 8 "SUA") (assoc 8 DongMucGoc) DongMucGoc) )
(entmod DongMucGoc)
(setq Thoi 0)
(setq PT1 PTD)
(command "_layer" "m" "PLSUA" "c" "3" "" "")
(while (= Thoi 0)
(if (= (setq PTT
(getpoint
"\nCHON DIEM TIEP THEO!!! bam CHUOT PHAI hoac ENTER truoc khi chon diem cuoi cung !!!")) nil)
(progn (setq Thoi 1)
(command "osmode" 512)) ;end progn
(progn
(setq XT (car PTT)
YT (cadr PTT)
PTT (list XT YT Z))
(command ".pline" PT1 PTT "")
(setq PL (append PL (list PTT)))
(setq PT1 PTT)) ; end progn
) ; end if
) ; end while
(setq PTC (getpoint "\nCHON DIEM CUOI CUNG LOI VAO BINH DO"))
(setq ChonC (ssget PTC))
(setq ChonC1 (ssname ChonC 0))
(setq DongMucCuoi (entget ChonC1))
(setq ZC (last (assoc 10 DongMucCuoi)))
(if (= ZC Z)
(setq X (car PTC)
Y (cadr PTC)
PTC (list X Y ZC))
(progn
(while (/= ZC Z)
(setq PTC
(getpoint
"\nBAN DA CHON KHONG DUNG DOI TUONG BAN DAU !!! HAY CHON LAI DIEM CUOI CUNG !!!"))
(setq ChonC (ssget PTC))
(setq ChonC1 (ssname ChonC 0))
(setq DongMucCuoi (entget ChonC1))
(setq ZC (last (assoc 10 DongMucCuoi)))) ; end while
(setq X (car PTC)
Y (cadr PTC)
PTC (list X Y ZC))
) ;end progn
) ; end if
(setq PL (append PL (list PTC)))
(command ".pline" PT1 PTC "")
(setq DongMucGoc
(subst (cons 8 Layer) (assoc 8 DongMucGoc) DongMucGoc) )
(entmod DongMucGoc)
(command "_layer" "m" Layer "c" "" "" "")
(command "_break" Chon PTD PTC "")
(setq Chon3 (ssget PTD))
(foreach PT PL
(setq C (ssget PT))
(setq i 0)
(while (<= i (- (sslength C) 1))
(setq D (ssname C i))
(if (/= D nil)
(setq Chon3 (ssadd D Chon3))
) ; end if
(setq i (+ i 1))
) ; end while
) ; end for PL
(command "_select" Chon Chon3 "")
(setq S (ssget "P"))
(command "_pedit" "m" S "" "j" "" "")
(command "-osnap" "End,Mid,Int,Perp")
(prompt "\nDA NAN BINH DO XONG!")(PRINC))

  • 0

#76 dunguss3581

dunguss3581

    biết lệnh rotate

  • Advance Member
  • PipPipPip
  • 139 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 15 May 2012 - 01:54 PM

không biết mục đích của bạn có phải tạo thêm các nút trên pline để nắn mềm bình độ không, nếu phải thì mình có đoạn code này có thể giúp bạn được:


====================================
SUA DUONG BINH DO:
====================================
(defun C:SS (/ Thoi chon3 chon Chon1 ChonC Chon1 ZC
S PTD PTC PL PTT DongMucGoc
DongMucCuoi X Y Z XT YT XC
YC Layer I D
)
(command "_layer" "m" "SUA" "c" "2" "" "")
(command "osmode" 512)
;(print " ! LOAI DUONG DONG MUC PHAI LA POLYLINE MOI SUA DUOC !")
;(print " ! De chuyen sang POLYLINE: dung ARGIC mo file VA EXPORT TO CAD !")
(setq PTD (getpoint "\nCHON DIEM DAU TIEN XUAT PHAT TU BINH DO"))
(command "osmode" 0)
(setq Chon (ssget PTD))
(setq Chon1 (ssname Chon 0))
(setq DongMucGoc (entget Chon1))
(setq Z (last (assoc 10 DongMucGoc)))
(setq PL '())
(setq X (car PTD)
Y (cadr PTD)
PTD (list X Y Z))
(setq PL (append PL (list PTD)))
(setq Layer (cdr (assoc 8 DongMucGoc)))
(setq DongMucGoc
(subst (cons 8 "SUA") (assoc 8 DongMucGoc) DongMucGoc) )
(entmod DongMucGoc)
(setq Thoi 0)
(setq PT1 PTD)
(command "_layer" "m" "PLSUA" "c" "3" "" "")
(while (= Thoi 0)
(if (= (setq PTT
(getpoint
"\nCHON DIEM TIEP THEO!!! bam CHUOT PHAI hoac ENTER truoc khi chon diem cuoi cung !!!")) nil)
(progn (setq Thoi 1)
(command "osmode" 512)) ;end progn
(progn
(setq XT (car PTT)
YT (cadr PTT)
PTT (list XT YT Z))
(command ".pline" PT1 PTT "")
(setq PL (append PL (list PTT)))
(setq PT1 PTT)) ; end progn
) ; end if
) ; end while
(setq PTC (getpoint "\nCHON DIEM CUOI CUNG LOI VAO BINH DO"))
(setq ChonC (ssget PTC))
(setq ChonC1 (ssname ChonC 0))
(setq DongMucCuoi (entget ChonC1))
(setq ZC (last (assoc 10 DongMucCuoi)))
(if (= ZC Z)
(setq X (car PTC)
Y (cadr PTC)
PTC (list X Y ZC))
(progn
(while (/= ZC Z)
(setq PTC
(getpoint
"\nBAN DA CHON KHONG DUNG DOI TUONG BAN DAU !!! HAY CHON LAI DIEM CUOI CUNG !!!"))
(setq ChonC (ssget PTC))
(setq ChonC1 (ssname ChonC 0))
(setq DongMucCuoi (entget ChonC1))
(setq ZC (last (assoc 10 DongMucCuoi)))) ; end while
(setq X (car PTC)
Y (cadr PTC)
PTC (list X Y ZC))
) ;end progn
) ; end if
(setq PL (append PL (list PTC)))
(command ".pline" PT1 PTC "")
(setq DongMucGoc
(subst (cons 8 Layer) (assoc 8 DongMucGoc) DongMucGoc) )
(entmod DongMucGoc)
(command "_layer" "m" Layer "c" "" "" "")
(command "_break" Chon PTD PTC "")
(setq Chon3 (ssget PTD))
(foreach PT PL
(setq C (ssget PT))
(setq i 0)
(while (<= i (- (sslength C) 1))
(setq D (ssname C i))
(if (/= D nil)
(setq Chon3 (ssadd D Chon3))
) ; end if
(setq i (+ i 1))
) ; end while
) ; end for PL
(command "_select" Chon Chon3 "")
(setq S (ssget "P"))
(command "_pedit" "m" S "" "j" "" "")
(command "-osnap" "End,Mid,Int,Perp")
(prompt "\nDA NAN BINH DO XONG!")(PRINC))

Lisp của bạn là vẽ pline mới và xóa cái cũ đi. mục đích của mình là vẽ đường bao xung quanh điểm đo (tập hợp các point trên bản vẽ). Từ đó xây dựng mô hình tam giác và chọn đường bao cho mô hình.
  • 0