Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
victor85

[Yêu cầu] Nhờ viết lisp chèn nhanh point vào End_point đối tượng

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

victor85    10

Mình có nhu cầu sử dụng nhiều tình huống là chèn nhanh các đối tượng point của cad vào các điểm end_point của đối tượng. Từ đối tượng point chèn vào mình có thể xử lý được nhiều tình huống kế tiếp với các lisp khác của cadviet. 

Vậy nên kính mong các bác viết dùm mình lisp chèn nhanh point cụ thể như sau:

+lisp add_point_object:

Chọn đối tượng

Đầu vào các loại đối tượng vẽ (line, arc, circle, ellipse, polyline, ray)

Kết quả là các point được add thêm vào tại các vị trí end_point của các đối tượng đầu vào ạ.

Mình xin chân thành cảm ơn các bác trước ạ. 

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
victor85    10

À cái đó thì có circle thì không có endpoint thôi; cái này mình bị nhầm lẫn. Còn ellipse thì trong trường hợp nó bị cắt thành cung ellipse thì nó vẫn có end point. Còn ray thì luôn có 1 end point 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
quocmanh04tt    385

Đây bạn (bạn tự kiểm soát enpoint và startpoint nhé!):

(defun c:APO (/ i ss ent obj S-point E-point I-point add_point_object ename)
(defun add_point_object (obj)
(setq obj (vlax-ename->vla-object ent)
S-point (vlax-curve-getstartpoint obj)
E-point (vlax-curve-getendpoint obj))
(cond ((eq ename "ARC") (setq I-point S-point))
((eq ename "RAY") (setq I-point S-point))
(t (setq I-point E-point)))
(entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 I-point))))
;; main
(if (setq i 0
ss (ssget "_:L" '((0 . "*LINE,ARC,ELLIPSE,RAY,CIRCLE")))
n (sslength ss))
(progn (while (< i n)
(setq ent (ssname ss i)
ename (cdr (assoc 0 (entget ent))))
(add_point_object obj)
(setq i (1+ i)))))
(princ))
  • 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
victor85    10

Mình xin cảm ơn bác quocmanh04tt nhé. Lisp chạy ổn rồi nhưng chưa đúng ý diễn tả mình lắm. Cái mình mong muốn là end_point là cả start và end point giống như trong chế độ bắt điểm end point thôi ấy. Bác chỉnh thêm 1 chút dùm mình được 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
quocmanh04tt    385

Mình xin cảm ơn bác quocmanh04tt nhé. Lisp chạy ổn rồi nhưng chưa đúng ý diễn tả mình lắm. Cái mình mong muốn là end_point là cả start và end point giống như trong chế độ bắt điểm end point thôi ấy. Bác chỉnh thêm 1 chút dùm mình được không ạ?

Ôi... Cái End_point... Của bạn đây:

(defun c:APO (/ i ss ent obj S-point E-point add_point_object ename)

(defun add_point_object (obj / make_po)

(defun make_po (point)

(entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 point))))

(setq obj (vlax-ename->vla-object ent)

S-point (vlax-curve-getstartpoint obj)

E-point (vlax-curve-getendpoint obj))

(cond ((or (eq ename "CIRCLE") (eq ename "ELLIPSE") (eq ename "RAY")) (make_po S-point))

(t (make_po E-point) (make_po S-point))))

;; main

(if (setq i 0

ss (ssget "_:L" '((0 . "*LINE,ARC,ELLIPSE,RAY,CIRCLE")))

n (sslength ss))

(progn (while (< i n)

(setq ent (ssname ss i)

ename (cdr (assoc 0 (entget ent))))

(add_point_object obj)

(setq i (1+ i)))))

(princ))

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
gia_bach    1.442

Ôi... Cái End_point... Của bạn đây:

(defun c:APO (/ i ss ent obj S-point E-point add_point_object ename)

(defun add_point_object (obj / make_po)

(defun make_po (point)

(entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 point))))

(setq obj (vlax-ename->vla-object ent)

S-point (vlax-curve-getstartpoint obj)

E-point (vlax-curve-getendpoint obj))

(cond ((or (eq ename "CIRCLE") (eq ename "ELLIPSE") (eq ename "RAY")) (make_po S-point))

(t (make_po E-point) (make_po S-point))))

;; main

(if (setq i 0

ss (ssget "_:L" '((0 . "*LINE,ARC,ELLIPSE,RAY,CIRCLE")))

n (sslength ss))

(progn (while (< i n)

(setq ent (ssname ss i)

ename (cdr (assoc 0 (entget ent))))

(add_point_object obj)

(setq i (1+ i)))))

(princ))

Lisp chạy ổn, 

nhưng cách viết và sử dụng hàm con (tên biến) trông như đánh đố đấy nhỉ ???

  • 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
quocmanh04tt    385

Chú ý thêm trường hợp ellipse hở (ellipse bị break hoặc vẽ arc ellipse).

 

 

Chú ý thêm trường hợp ellipse hở (ellipse bị break hoặc vẽ arc ellipse).

Cám ơn bác, em không để ý. Nên dùng cách gì để lấy thêm trường hợp này ạ?

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
quocmanh04tt    385

Sửa lại và xin các bác cho ý kiến.

(defun c:APO (/ i ss ent obj S-point E-point add_point_object ename)

(defun add_point_object (obj / make_po)

(defun make_po (point)

(entmakex

(list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 point) (cons 62 1))))

(setq obj (vlax-ename->vla-object ent)

S-point (vlax-curve-getstartpoint obj)

E-point (vlax-curve-getendpoint obj))

(cond ((or (eq ename "CIRCLE") (eq ename "RAY")) (make_po S-point))

((or(eq ename "ELLIPSE") (eq ename "LWPOLYLINE"))

(if (and(eq (car S-point) (car E-point))(eq (cadr S-point) (cadr E-point)))

(make_po S-point)

(progn (make_po S-point) (make_po E-point))))

(t (make_po E-point) (make_po S-point))))

;; main

(if (setq i 0

ss (ssget "_:L" '((0 . "*LINE,ARC,ELLIPSE,RAY,CIRCLE")))

n (sslength ss))

(progn (while (< i n)

(setq ent (ssname ss i)

ename (cdr (assoc 0 (entget ent))))

(add_point_object obj)

(setq i (1+ i)))))

(princ))

Chỉnh sửa theo quocmanh04tt
  • 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  

×