Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#121 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 19 September 2009 - 01:29 PM

Lạ thiệt??? Tại sao cứ phải là Lisp mới được àh? Vậy thành ra không có Lisp thì AutoCAD không làm được àh?

Bạn nào cho mình bài toán làm 1 việc gì đó mà AutoCAD không làm được đi??? :cheers:

Chính bạn mới lạ. Nếu cad làm đc tất cả mọi việc thì cad bày ra lisp, ARX ... để làm gì
Ngay bản thân cad đời sau làm những cái đời trước còn thiếu hoặc chưa hoàn chỉnh, chính những cái mới này đc phát triển từ lisp, ARX ... Nói như bạn thì kg cần nâng cấp gì hết
  • 1

#122 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 19 September 2009 - 01:34 PM

tôi có lisp như sau:
(defun C:TLA (/ Text_app)
................................
)

(defun C:PLA (/ Point_app)
.............
)
tôi muốn kết hợp 2 lisp trên thành 1 lisp để công việc nhanh hơn,xin được giúp đở..cám ơn.. :cheers:

Chào kamezoko, Lisp này, Thiep đã gộp lại:
(defun C:PTLA (/ Text_app Point_app enlay obj n lay)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*layer* (vla-get-Layers ActDoc)
)
(vla-StartUndoMark ActDoc)
(setvar "Cmdecho" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "pointname")))
(setq lay (vla-add *layer* "pointname"))
(setq lay (vlax-ename->vla-object enlay))
)
(vla-put-color lay acGreen)
(if (not (setq enlay (tblobjname "layer" "point")))
(setq lay (vla-add *layer* "point"))
(setq lay (vlax-ename->vla-object enlay))
)
(vla-put-color lay acwhite)
(if (setq Text_app (ssget "X" '((0 . "*Text"))))
(progn
(setq n 0)
(repeat (sslength Text_app)
(setq obj (vlax-ename->vla-object (ssname Text_app n)))
(vla-put-layer obj "pointname")
(vla-put-color obj acbylayer)
(setq n (1+ n))
)
)
(prompt "\nHien tai, ban ve khong co Texts.")
)
(if (setq Point_app (ssget "X" '((0 . "*point"))))
(progn
(setq n 0)
(repeat (sslength Point_app)
(setq obj (vlax-ename->vla-object (ssname Point_app n)))
(vla-put-layer obj "point")
(vla-put-color obj acbylayer)
(setq n (1+ n))
)
)
(prompt "\nHien tai, ban ve khong co points.")
)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban thanh cong!")
(princ)
)

Chúc bạn thàng công!
  • 2

#123 kamezoko

kamezoko

    biết vẽ line

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

Đã gửi 19 September 2009 - 02:42 PM

Chào kamezoko, Lisp này, Thiep đã gộp lại:

(defun C:PTLA (/ Text_app Point_app enlay obj n lay)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*layer* (vla-get-Layers ActDoc)
)
(vla-StartUndoMark ActDoc)
(setvar "Cmdecho" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "pointname")))
(setq lay (vla-add *layer* "pointname"))
(setq lay (vlax-ename->vla-object enlay))
)
(vla-put-color lay acGreen)
(if (not (setq enlay (tblobjname "layer" "point")))
(setq lay (vla-add *layer* "point"))
(setq lay (vlax-ename->vla-object enlay))
)
(vla-put-color lay acwhite)
(if (setq Text_app (ssget "X" '((0 . "*Text"))))
(progn
(setq n 0)
(repeat (sslength Text_app)
(setq obj (vlax-ename->vla-object (ssname Text_app n)))
(vla-put-layer obj "pointname")
(vla-put-color obj acbylayer)
(setq n (1+ n))
)
)
(prompt "\nHien tai, ban ve khong co Texts.")
)
(if (setq Point_app (ssget "X" '((0 . "*point"))))
(progn
(setq n 0)
(repeat (sslength Point_app)
(setq obj (vlax-ename->vla-object (ssname Point_app n)))
(vla-put-layer obj "point")
(vla-put-color obj acbylayer)
(setq n (1+ n))
)
)
(prompt "\nHien tai, ban ve khong co points.")
)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban thanh cong!")
(princ)
)

Chúc bạn thàng công!

cám ơn Thiep rất nhiều... :cheers: :cheers:
  • 0

#124 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 19 September 2009 - 03:02 PM

.....
bài toán đánh số thứ tự của em như trên chỉ là để diễn đạt ý muốn của em thôi anh. anh có thể hiểu như thế này:
- Em có một tập hợp text, em muốn đánh số thứ tự vào các text đó
- nhưng em lười, ko muốn pick từng text một mà chỉ cần quét chuột qua tập hợp text bằng ssget một nhát là xong luôn
- Lisp sẽ đánh số thứ tự tăng dần vào các text theo quy luật: text có tọa độ X nhỏ hơn thì đánh trước, nếu trường hợp có 2 hay nhiều text có cùng tọa độ X thì tọa độ Y sẽ được xét đến, text có tọa độ Y lớn hơn sẽ đc đánh trước.
............

Bạn tham khảo Lisp này.
(defun c:sort (/ cmd ss lst data i)

(defun dxf (tag obj) (cdr (assoc tag obj)))

(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nChon cac Text can sap xep : ")
(if (setq ss (ssget (list (cons 0 "TEXT") )))
(progn
(setq lst (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
'(lambda (x y) (if (equal (car(setq x1 (dxf 10 x))) (car(setq y1 (dxf 10 y))))
(> (cadr x1) (cadr y1))
(< (car x1) (car y1))
))))
(setq i 1)
(foreach pt lst
(setq data (subst (cons 1 (itoa i)) (assoc 1 pt) pt)
i (1+ i))
(entmod data)
)
)
)
(setvar "cmdecho" cmd)
(princ)
)

  • 3

#125 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 19 September 2009 - 03:33 PM

Chào anh Thanh Bình :cheers:
Đúng là anh chưa hiểu ý em thật. bài toán đánh số thứ tự của em như trên chỉ là để diễn đạt ý muốn của em thôi anh. anh có thể hiểu như thế này:
- Em có một tập hợp text, em muốn đánh số thứ tự vào các text đó
- nhưng em lười, ko muốn pick từng text một mà chỉ cần quét chuột qua tập hợp text bằng ssget một nhát là xong luôn
- Lisp sẽ đánh số thứ tự tăng dần vào các text theo quy luật: text có tọa độ X nhỏ hơn thì đánh trước, nếu trường hợp có 2 hay nhiều text có cùng tọa độ X thì tọa độ Y sẽ được xét đến, text có tọa độ Y lớn hơn sẽ đc đánh trước.

Đây là đoạn code của em, anh chạy thử với 1 tập hợp text sẽ hiểu được ý em ngay thôi.

trong đó đoạn in đẩm là đoạn bỏ đi và cần xử lý để ghi giá trị (i+1) trực tiếp vào text. (đoạn này chính là đoạn em đang mắc) :cheers:

Đây chỉ là một ví dụ của em cho dễ hiểu, thực tế em cần sử dụng cho nhiều mục đích khác anh ạ.

Chào bác ThaiStreetz,
Bác thử dùng cái này thay vào cái vòng lặp While của bác xem có đúng ý bác không nhé.
(while (< i n)
(setq txt_ent (entget (nth i lst)))
txt_con (cdr (assoc 1 tex_ent))
txt_new (strcat (itoa (1+ i)) txt_con)
txt_ent (subst (cons 1 txt_new) (assoc 1 txt_ent) txt_ent)
); setq
(entmod (nth i lst))
(setq i (1+ i))
); While

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#126 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 19 September 2009 - 04:38 PM

Chào bác ThaiStreetz,
Bác thử dùng cái này thay vào cái vòng lặp While của bác xem có đúng ý bác không nhé.

OK rồi ạ. em cảm ơn anh Gia Bách và anh Thanh Bình nhé. đoạn code của anh Gia Bách rất gọn gàng :cheers:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#127 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 20 September 2009 - 09:52 AM

Các bác giúp em một lisp là thêm các đỉnh tại các vị trí giao nhau của các đường polyline, khi dùng lisp chọn một loạt các đường không chọn từng đường một.
đây là file: http://www.cadviet.c...nh_polyline.dwg
em cảm ơn trước nhé.
  • 0

#128 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 20 September 2009 - 08:53 PM

Các bác giúp em một lisp là thêm các đỉnh tại các vị trí giao nhau của các đường polyline, khi dùng lisp chọn một loạt các đường không chọn từng đường một.
đây là file: http://www.cadviet.c...nh_polyline.dwg
em cảm ơn trước nhé.

Lời đầu tiên, cho phép Tue_NV gửi lời cảm ơn tới anh gia_bach. Nhờ sự hướng dẫn của anh về addvertex method mà Tue_NV đã hoàn thành đoạn Code này để giúp cho bạn Tuynh

Chào Tuynh. Đây là Code mà Tue_NV đã hoàn thành. Bạn chạy thử và cho ý kiến nhé :

(defun GiaoDT (ent1 ent2)
(vl-load-com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendNone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)

)
;
(defun c:AddVertex (/ obj pt ParamPt i ss1 ss2 j sdc ent1 ent2)
(vl-load-com)
(prompt "\n Chon Polyline them Vertex : ")
(setq ss1 (ssget '((0 . "*POLYLINE"))))
(prompt "\n Chon Polyline giao voi Polyline them Vertex : ")
(setq ss2 (ssget '((0 . "*POLYLINE"))) i 0 j 0 sdc 0)

(while (< i (sslength ss1))
(setq ent1 (ssname ss1 i))
(setq obj (vlax-ename->vla-object ent1))
(setq j 0)

(while (< j (sslength ss2))

(setq ent2 (ssname ss2 j))

(if (/= (Giaodt ent1 ent2) nil)
(progn

(repeat (length (Giaodt ent1 ent2))
(setq pt (nth sdc (Giaodt ent1 ent2)))
(setq ParamPt (vlax-curve-getParamAtPoint obj pt))

(if (> (- ParamPt (fix ParamPt)) 0.001)
(vlax-invoke obj 'AddVertex (1+ (fix ParamPt)) (list (car pt) (cadr pt)))
)
(setq sdc (+ sdc 1))
)
(setq sdc 0)
);progn
);if

(setq j (1+ j))

);while

(setq i (1+ i))

);while

(princ)
)

Tuy nhiên, đoạn Code trên còn có 1 điểm chưa hoàn thiện là các PLINE có Arc thì thêm Vertex không được như ý muốn của user
Theo điểm Remark trong Addvertex method thì :

Remarks

The vertex specifies the endpoint for a new line segment. To add an arc segment, first create the line segment, and then add a "bulge" to the individual segment that is to become an arc. To add a bulge value to a segment, use the SetBulge method.
Diễn giải ra thì đúng như lời của anh Gia_bach nói

Chú ý : hàm Addvertex chỉ thêm 1 segment mới truớc vị trí Pt có kiểu là Đuờng thẳng (LINE segment).
Để thêm phần tử Cung tròn (ARC segment), truớc tiên thêm 1 line segment, sau đó add thuộc tính "bulge" (tạm dịch : độ lồi lõm của Curve) bằng hàm SetBulge : (vla-setBulge obj Index Value)


Tuy nhiên, với tham số Value trong SetBulge method thì thực sự là Tue_NV chưa hiểu .

Value
Double
The bulge value for the vertex at the given index.

tham số Index thì Tue_NV có thể hiểu giống như addvertex method

Anh giabach và mọi người có thể hỗ trợ thêm cho Tue_NV để hoàn thành code này cho trọn vẹn nhé.
Chân thành cảm ơn anh gia_bach và mọi người.
  • 1

#129 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 20 September 2009 - 10:27 PM

Lời đầu tiên, cho phép Tue_NV gửi lời cảm ơn tới anh gia_bach. Nhờ sự hướng dẫn của anh về addvertex method mà Tue_NV đã hoàn thành đoạn Code này để giúp cho bạn Tuynh

Chào Tuynh. Đây là Code mà Tue_NV đã hoàn thành. Bạn chạy thử và cho ý kiến nhé :


(defun GiaoDT (ent1 ent2)
(vl-load-com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendNone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)

)
;
(defun c:AddVertex (/ obj pt ParamPt i ss1 ss2 j sdc ent1 ent2)
(vl-load-com)
(prompt "\n Chon Polyline them Vertex : ")
(setq ss1 (ssget '((0 . "*POLYLINE"))))
(prompt "\n Chon Polyline giao voi Polyline them Vertex : ")
(setq ss2 (ssget '((0 . "*POLYLINE"))) i 0 j 0 sdc 0)

(while (< i (sslength ss1))
(setq ent1 (ssname ss1 i))
(setq obj (vlax-ename->vla-object ent1))
(setq j 0)

(while (< j (sslength ss2))

(setq ent2 (ssname ss2 j))

(if (/= (Giaodt ent1 ent2) nil)
(progn

(repeat (length (Giaodt ent1 ent2))
(setq pt (nth sdc (Giaodt ent1 ent2)))
(setq ParamPt (vlax-curve-getParamAtPoint obj pt))

(if (> (- ParamPt (fix ParamPt)) 0.001)
(vlax-invoke obj 'AddVertex (1+ (fix ParamPt)) (list (car pt) (cadr pt)))
)
(setq sdc (+ sdc 1))
)
(setq sdc 0)
);progn
);if

(setq j (1+ j))

);while

(setq i (1+ i))

);while

(princ)
)

Tuy nhiên, đoạn Code trên còn có 1 điểm chưa hoàn thiện là các PLINE có Arc thì thêm Vertex không được như ý muốn của user
Theo điểm Remark trong Addvertex method thì :

Remarks

The vertex specifies the endpoint for a new line segment. To add an arc segment, first create the line segment, and then add a "bulge" to the individual segment that is to become an arc. To add a bulge value to a segment, use the SetBulge method.
Diễn giải ra thì đúng như lời của anh Gia_bach nói
Tuy nhiên, với tham số Value trong SetBulge method thì thực sự là Tue_NV chưa hiểu .

Value
Double
The bulge value for the vertex at the given index.

tham số Index thì Tue_NV có thể hiểu giống như addvertex method

Anh giabach và mọi người có thể hỗ trợ thêm cho Tue_NV để hoàn thành code này cho trọn vẹn nhé.
Chân thành cảm ơn anh gia_bach và mọi người.

Cám ơn sự nhiệt tình của bạn Tuệ nhé, code của bạn cũng đã giúp đúng như ý tớ rồi không biết các pác còn có ý tưởng gì để code hay hơn. Mình đang làm với các đường polyline thì lisp cho kết quả tốt.
Thank you very much. :cheers:
  • 0

#130 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 21 September 2009 - 07:01 AM

Cám ơn sự nhiệt tình của bạn Tuệ nhé, code của bạn cũng đã giúp đúng như ý tớ rồi không biết các pác còn có ý tưởng gì để code hay hơn. Mình đang làm với các đường polyline thì lisp cho kết quả tốt.
Thank you very much. :cheers:

Chào Tuynh
Nếu tập chọn Chon Polyline them Vertex : trùng với tập chọn Chon Polyline giao voi Polyline them Vertex : thì kết quả toàn bộ Polyline sẽ được thêm Vertex tại điểm giao nhau đấy.

Command: addvertex
Chon Polyline them Vertex :
Select objects: Specify opposite corner: 3 found : Chọn đối tượng

Select objects: Enter

Chon Polyline giao voi Polyline them Vertex :
Select objects: p : Nhấn chữ P (previous)
3 found

Select objects:

-> toàn bộ Polyline sẽ được thêm Vertex tại điểm giao nhau.

Vấn đề Tue_NV đang gặp khó khăn là các PLINE có Arc thì thêm Vertex không được như ý muốn của user

Mình đang mong được sự hỗ trợ của mọi người để code trên thành công trọn vẹn. Thanks
  • 0

#131 k_malau

k_malau

    biết vẽ pline

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

Đã gửi 21 September 2009 - 10:30 AM

Em đang cần một Lít yêu cầu như sau:
- Em có các số là 2, 4, 6, 8, 10, 12, ...., XXXX. (từng số đó có thể là Mt hoặc Dt)
Em muốn chèn sau những con số đó là "PN", hay "P" hay "..."
Các Bác giúp em với. Thanks!
  • 0

#132 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 21 September 2009 - 11:37 AM

Em đang cần một Lít yêu cầu như sau:
- Em có các số là 2, 4, 6, 8, 10, 12, ...., XXXX. (từng số đó có thể là Mt hoặc Dt)
Em muốn chèn sau những con số đó là "PN", hay "P" hay "..."
Các Bác giúp em với. Thanks!

Chào bác K_malau,
Thực tình thì mình cũng muốn giúp bác lắm nhưng chửa biết giúp cách nào. Bác đặt ra cái yêu cầu mà mình đọc hoài không hiểu nên đành bó ...... chiếu.
Ý bác là thay tất cả các text số ở trên bằng một text mới hay là sao nhỉ?
Trên diễn đàn đã có kha khá lisp để có thể thay đổi giá trị của text, bác chịu khó tìm kiếm một chút rồi xem cái nào nó vừa ý mình thì xài.
Còn để viết riêng một cái cho bác thì bác phải nói rõ hơn mới được, đầu vào là gì, đầu ra là gì bác nhé. Chứ theo như bác nói thì cái đầu ra nó mông lung quá, khó mà viết nổi. Cái "..." của bác có mà giời hiểu bác ạ. Vả lại việc chọn là "P" hay "PN" nó phải có điều kiện chi chứ hay là hầm bà lằng xắng cấu, thằng nào cũng được.
Rất mong bác bớt chút thời gian để trình bày cho rõ cái bác cần chứ chớ có làm khổ cái đầu mọi người bác nha.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#133 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 21 September 2009 - 11:42 AM

Lời đầu tiên, cho phép Tue_NV gửi lời cảm ơn tới anh gia_bach. Nhờ sự hướng dẫn của anh về addvertex method mà Tue_NV đã hoàn thành đoạn Code này để giúp cho bạn Tuynh

Chào Tuynh. Đây là Code mà Tue_NV đã hoàn thành. Bạn chạy thử và cho ý kiến nhé :


(defun GiaoDT (ent1 ent2)
(vl-load-com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendNone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)

)
;
(defun c:AddVertex (/ obj pt ParamPt i ss1 ss2 j sdc ent1 ent2)
(vl-load-com)
(prompt "\n Chon Polyline them Vertex : ")
(setq ss1 (ssget '((0 . "*POLYLINE"))))
(prompt "\n Chon Polyline giao voi Polyline them Vertex : ")
(setq ss2 (ssget '((0 . "*POLYLINE"))) i 0 j 0 sdc 0)

(while (< i (sslength ss1))
(setq ent1 (ssname ss1 i))
(setq obj (vlax-ename->vla-object ent1))
(setq j 0)

(while (< j (sslength ss2))

(setq ent2 (ssname ss2 j))

(if (/= (Giaodt ent1 ent2) nil)
(progn

(repeat (length (Giaodt ent1 ent2))
(setq pt (nth sdc (Giaodt ent1 ent2)))
(setq ParamPt (vlax-curve-getParamAtPoint obj pt))

(if (> (- ParamPt (fix ParamPt)) 0.001)
(vlax-invoke obj 'AddVertex (1+ (fix ParamPt)) (list (car pt) (cadr pt)))
)
(setq sdc (+ sdc 1))
)
(setq sdc 0)
);progn
);if

(setq j (1+ j))

);while

(setq i (1+ i))

);while

(princ)
)

.........
Tuy nhiên, đoạn Code trên còn có 1 điểm chưa hoàn thiện là các PLINE có Arc thì thêm Vertex không được như ý muốn của user
Theo điểm Remark trong Addvertex method thì :

Remarks


tham số Index thì Tue_NV có thể hiểu giống như addvertex method

Anh giabach và mọi người có thể hỗ trợ thêm cho Tue_NV để hoàn thành code này cho trọn vẹn nhé.
Chân thành cảm ơn anh gia_bach và mọi người.

Chào Tue_NV, trước hết xin nói thêm Addvertex method chỉ hỗ trợ cho các đường kiểu LWPOLYLINE, còn POLYLINE thì phải xây dựng lại theo kiểu khác.
Còn Value trong mã (vla-setBulge obj Index Value) chính là độ cong của cung tròn. Muốn tìm độ cong này thì dùng hàm getbulge. Thiep đã gửi Tue_NV 1 ví dụ tìm xem 1 LWPolyline có arc nào không. Link ở đây:
http://www.cadviet.c...&...ost&p=72300
Như vậy, chỉ thêm đoạn mã sau:
(setq bul (vla-getbulge obj Index))
(if (/= bul 0)
(vla-setBulge obj (+ Index 1) bul))
  • 1

#134 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 21 September 2009 - 12:39 PM

Em đang cần một Lít yêu cầu như sau:
- Em có các số là 2, 4, 6, 8, 10, 12, ...., XXXX. (từng số đó có thể là Mt hoặc Dt)
Em muốn chèn sau những con số đó là "PN", hay "P" hay "..."
Các Bác giúp em với. Thanks!

http://www.cadviet.c...o...991&hl=text
Mình nghĩ Lisp của anh Duy chính là thứ bạn cần. lần sau bạn chịu khó tìm kiếm một chút bằng vài từ khóa khả dĩ trước đi nhé. Box này là cả một thư viện lisp rất lớn cho bạn rồi. nếu vấn đề của bạn chưa đc đề cập tới mọi người sẽ giúp bạn.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#135 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 21 September 2009 - 01:09 PM

Chào Tuynh
Nếu tập chọn Chon Polyline them Vertex : trùng với tập chọn Chon Polyline giao voi Polyline them Vertex : thì kết quả toàn bộ Polyline sẽ được thêm Vertex tại điểm giao nhau đấy.

Command: addvertex
Chon Polyline them Vertex :
Select objects: Specify opposite corner: 3 found : Chọn đối tượng

Select objects: Enter

Chon Polyline giao voi Polyline them Vertex :
Select objects: p : Nhấn chữ P (previous)
3 found

Select objects:

-> toàn bộ Polyline sẽ được thêm Vertex tại điểm giao nhau.

Vấn đề Tue_NV đang gặp khó khăn là các PLINE có Arc thì thêm Vertex không được như ý muốn của user

Mình đang mong được sự hỗ trợ của mọi người để code trên thành công trọn vẹn. Thanks

Chào Tuệ
Mình làm thử các đường polyline có arc thì lisp chạy không như ý muốn, mong các bác hoàn thành code này trọn vẹn nhé.
Chân thành cảm ơn bạn Tuệ và mọi người đã giúp đỡ.
  • 0

#136 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 21 September 2009 - 03:39 PM

Chào Tuệ
Mình làm thử các đường polyline có arc thì lisp chạy không như ý muốn, mong các bác hoàn thành code này trọn vẹn nhé.
Chân thành cảm ơn bạn Tuệ và mọi người đã giúp đỡ.

Về giá trị bulge
The bulge is the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline's vertex list.
A negative bulge value indicates that the arc goes clockwise from the selected vertex to the next vertex.
A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.

giá trị bulge tang của 1/4 góc chắn phần tử (segment).
- Nếu bulge >0 : cung tròn theo ngược chiều kim đồng hồ, ngược lại cùng chiều kim đồng hồ.
- Nếu bulge = 0 : phần tử là đuờng thẳng
- Nếu bulge = 1 : phần tử là đuờng tròn

Gửi bạn Lisp thêm các đỉnh tại các vị trí giao nhau giữa đuờng LWPOLYLINE với tất cả các đối tuợng khác cắt qua nó (bao gồm : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE).
Do không có thời gian test nhiều, nhờ các bạn kiểm tra dùm.
(defun c:AddVtx (/ doc vl ov ss)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark doc)
(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE
(prompt "\nChon Polyline them Vertex : ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(foreach pt (get_interpts_with_touching ent)
(AddVtx ent pt) ) ) )
(mapcar 'setvar vl ov) ; reset Sys Vars
(vla-EndUndoMark doc)
(princ)
)

(defun AddVtx (entPL pt / obj pObj pa a1 a2 p1 p2 ce bu)
;; Transform any angle (in radians) into its equivalent between 0 and 2*pi
(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
)
; get center
(defun get_center (ent param / ang1 ang2 pt1 pt2)
(setq ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.1 param)))
ang2 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.9 param)))
)
(if (or (/= ang1 ang2)
(/= ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.5 param))))
)
(progn
(setq pt1 (vlax-curve-getPointAtParam ent (+ 0.1 param))
pt2 (vlax-curve-getPointAtParam ent (+ 0.9 param)))
(inters pt1 (polar pt1 (- ang1 (/ pi 2)) 1.0) pt2 (polar pt2 (- ang2 (/ pi 2)) 1.0) nil)
)
)
)
;--- AddVtx --------
(setq obj (vlax-ename->vla-object entPL)
pObj t);PointAtObj
(or
(setq pa (vlax-curve-getParamAtPoint obj pt))
(setq pa (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt) )
pObj nil)
)
(if (> (- pa (setq pa (fix pa))) 0.001); bo qua t/hop diem Pt trung voi dinh cua PLINE
(progn
(if (and (setq ce (get_center obj pa)) pObj)
(progn
(setq p1 (vlax-curve-getPointAtParam obj pa)
p2 (vlax-curve-getPointAtParam obj (1+ pa)) )
(if (< pi (ang<2pi (- (angle pt p2) (angle p1 pt)))(* 2 pi))
(setq a1 (- (ang<2pi (- (angle ce p1) (angle ce pt))))
a2 (- (ang<2pi (- (angle ce pt) (angle ce p2)))) )
(setq a1 (ang<2pi (- (angle ce pt) (angle ce p1)))
a2 (ang<2pi (- (angle ce p2) (angle ce pt))) )
)
(setq bu (list (cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0)))) ;gia tri Bulge tai dinh truoc v/tri chen
(cons (1+ pa) (/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))) ;gia tri Bulge tai dinh moi chen
))
)
(setq bu nil)
)
(vlax-invoke obj 'AddVertex (1+ pa) (list (car pt) (cadr pt)));them dinh
(setq bu (mapcar '(lambda (x) (vla-setBulge obj (car x) (cdr x))) bu));cap nhat Bulge
)
)
)

(defun get_interpts_with_touching (ent / obj bl tr ss lst intpts)
;; return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new)
)
;------------ ss_interpts
(setq obj (vlax-ename->vla-object ent))
(vla-getBoundingBox obj 'bl 'tr)
(and
(setq bl (vlax-safearray->list bl)
tr (vlax-safearray->list tr))
(setq ss (ssget "_c" bl tr (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(setq lst_pt nil
lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(foreach intoObj lst
(if (setq intpts (vlax-invoke Obj 'IntersectWith intoObj acExtendNone))
(setq lst_pt (append (list->3pair intpts) lst_pt)) ))
)
lst_pt
)

  • 3

#137 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 21 September 2009 - 04:16 PM

Bài toán Thiệp đưa ra sẽ ứng dụng như thế nào trong thực tế?

ứng dụng như thế này:
1. Có 1 dòng sông, tôi đang tìm 1 vị trí trên dòng sông có đường kính rộng nhất để làm vũng quay tàu.
2. Vẽ đa giác ngoại tiếp 1 đường cong kín Spline
  • 1

#138 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 21 September 2009 - 05:11 PM

Về giá trị bulge
The bulge is the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline's vertex list.
A negative bulge value indicates that the arc goes clockwise from the selected vertex to the next vertex.
A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.

giá trị bulge tang của 1/4 góc chắn phần tử (segment).
- Nếu bulge >0 : cung tròn theo ngược chiều kim đồng hồ, ngược lại cùng chiều kim đồng hồ.
- Nếu bulge = 0 : phần tử là đuờng thẳng
- Nếu bulge = 1 : phần tử là đuờng tròn

Gửi bạn Lisp thêm các đỉnh tại các vị trí giao nhau giữa đuờng LWPOLYLINE với tất cả các đối tuợng khác cắt qua nó (bao gồm : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE).
Do không có thời gian test nhiều, nhờ các bạn kiểm tra dùm.

(defun c:AddVtx (/ doc vl ov ss)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark doc)
(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE
(prompt "\nChon Polyline them Vertex : ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(foreach pt (get_interpts_with_touching ent)
(AddVtx ent pt) ) ) )
(mapcar 'setvar vl ov) ; reset Sys Vars
(vla-EndUndoMark doc)
(princ)
)

(defun AddVtx (entPL pt / obj pObj pa a1 a2 p1 p2 ce bu)
;; Transform any angle (in radians) into its equivalent between 0 and 2*pi
(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
)
; get center
(defun get_center (ent param / ang1 ang2 pt1 pt2)
(setq ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.1 param)))
ang2 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.9 param)))
)
(if (or (/= ang1 ang2)
(/= ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.5 param))))
)
(progn
(setq pt1 (vlax-curve-getPointAtParam ent (+ 0.1 param))
pt2 (vlax-curve-getPointAtParam ent (+ 0.9 param)))
(inters pt1 (polar pt1 (- ang1 (/ pi 2)) 1.0) pt2 (polar pt2 (- ang2 (/ pi 2)) 1.0) nil)
)
)
)
;--- AddVtx --------
(setq obj (vlax-ename->vla-object entPL)
pObj t);PointAtObj
(or
(setq pa (vlax-curve-getParamAtPoint obj pt))
(setq pa (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt) )
pObj nil)
)
(if (> (- pa (setq pa (fix pa))) 0.001); bo qua t/hop diem Pt trung voi dinh cua PLINE
(progn
(if (and (setq ce (get_center obj pa)) pObj)
(progn
(setq p1 (vlax-curve-getPointAtParam obj pa)
p2 (vlax-curve-getPointAtParam obj (1+ pa)) )
(if (< pi (ang<2pi (- (angle pt p2) (angle p1 pt)))(* 2 pi))
(setq a1 (- (ang<2pi (- (angle ce p1) (angle ce pt))))
a2 (- (ang<2pi (- (angle ce pt) (angle ce p2)))) )
(setq a1 (ang<2pi (- (angle ce pt) (angle ce p1)))
a2 (ang<2pi (- (angle ce p2) (angle ce pt))) )
)
(setq bu (list (cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0)))) ;gia tri Bulge tai dinh truoc v/tri chen
(cons (1+ pa) (/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))) ;gia tri Bulge tai dinh moi chen
))
)
(setq bu nil)
)
(vlax-invoke obj 'AddVertex (1+ pa) (list (car pt) (cadr pt)));them dinh
(setq bu (mapcar '(lambda (x) (vla-setBulge obj (car x) (cdr x))) bu));cap nhat Bulge
)
)
)

(defun get_interpts_with_touching (ent / obj bl tr ss lst intpts)
;; return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new)
)
;------------ ss_interpts
(setq obj (vlax-ename->vla-object ent))
(vla-getBoundingBox obj 'bl 'tr)
(and
(setq bl (vlax-safearray->list bl)
tr (vlax-safearray->list tr))
(setq ss (ssget "_c" bl tr (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(setq lst_pt nil
lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(foreach intoObj lst
(if (setq intpts (vlax-invoke Obj 'IntersectWith intoObj acExtendNone))
(setq lst_pt (append (list->3pair intpts) lst_pt)) ))
)
lst_pt
)

Do không có thời gian test nhiều, nhờ các bạn kiểm tra dùm.
Vâng em test rồi nhưng không dùng được, khi nào rảnh kiểm tra dùm hộ tớ nhé.
  • 0

#139 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2880 Bài viết
Điểm đánh giá: 1555 (rất tốt)

Đã gửi 21 September 2009 - 05:56 PM

ứng dụng như thế này:
1. Có 1 dòng sông, tôi đang tìm 1 vị trí trên dòng sông có đường kính rộng nhất để làm vũng quay tàu.
2. Vẽ đa giác ngoại tiếp 1 đường cong kín Spline


Baì 2: 2. Vẽ đa giác ngoại tiếp 1 đường cong kín Spline
Em vừa nghĩ ra lời giải.
Cảm ơn anh Thiếp. Em đưa vào câu đố :
  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#140 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2880 Bài viết
Điểm đánh giá: 1555 (rất tốt)

Đã gửi 21 September 2009 - 07:09 PM

Hà Anh ơi em biết rồi chỉ anh đi.
Pác Thiệp đang bắt anh trả lời. Hic hic.

Trang xin góp ý với ý kiến của riêng Trang như sau:
Nhưng nếu các bạn là những người master về CAD thì chúng ta nên chia sẻ kiến thức về định hướng.
Khả năng suy luận, đặt vấn đề.
Nếu các bạn đã là master mà các bạn chỉ áp dụng y chang cách là từ năm này qua năm khác,
việc làm đó sẽ làm chúng ta xa rời việc sáng tạo. Hãy sáng tạo hơn.
Hãy vì 1 diễn đàn CAD Viet Smart hơn.

Em cũng chỉ tình cờ nghĩ ra câu trả lời thôi anh a! Mong Thiêp và anh Trang hiểu và thông cảm em vì em ko đưa ra
câu trả lời ngay.Em đã đưa câu hỏi của anh Thiep vào bộ sưu tập câu đố của em rồi anh ạ!
Nhớ hồi đi học thầy dậy toán của em cũng thích đưa ra câu đố về toán. Thầy thường "câu giờ" và đợi đến cuối mỗi học
kỳ mới đưa ra lời giải!

Nếu rỗi thời gian anh Trang có thể vào đọc các bài viết của em trong đây:

Diễn đàn CADViet > AutoCAD > Mẹo sử dụng AutoCAD> Đố vui


http://www.cadviet.com/forum/index.php?sho...0&start=440


Chúc anh Trang vui khoẻ và gặp nhiều may mắn ngay sau khi đọc bài viết này!

Và cũng mong tất cả các bác trên diễn đàn hiểu và thông cảm em không phải là master đâu,
em cũng chỉ bám "càng" bác Phamthanhbinh mót khoai lang thôi các bác ạ!
Ai mua khoai ...nang ...lướng ... lóng đê!!!
  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”