Lisp thêm đỉnh pline tại giao điểm của pline và các line khác

[thanhlong.hygt 9]

Bác xem giúp e với ạ. Trường hợp đường 2d polyline trong bản vẽ này  http://www.cadviet.com/upfiles/3/116735_file_lodi.dwg  thì lệnh trên báo lỗi

 

 

báo lỗi trên cad2005

"

Command: ii undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: be
Command:
Chon pline muon them dinh
Nhap ten layer chua cac line can tim giao cat voi pline

Chon line giao cat mau
Select objects: Specify opposite corner: 21 found

Select objects:  break Select object:
Specify first break point:
Specify second break point:
At least one break point must be on polyline.*Invalid*

"

[phamthanhbinh 3.146]

Bác xem giúp e với ạ. Trường hợp đường 2d polyline trong bản vẽ này  http://www.cadviet.com/upfiles/3/116735_file_lodi.dwg  thì lệnh trên báo lỗi

 

 

báo lỗi trên cad2005

"

Command: ii undo Enter the number of operations to undo or

[Auto/Control/BEgin/End/Mark/Back] <1>: be

Command:

Chon pline muon them dinh

Nhap ten layer chua cac line can tim giao cat voi pline

Chon line giao cat mau

Select objects: Specify opposite corner: 21 found

Select objects:  break Select object:

Specify first break point:

Specify second break point:

At least one break point must be on polyline.*Invalid*

"

Hề hề hề,

Lỗi là do bạn không đọc kỹ hướng dẫn sử dụng trước khi dùng thuốc đây mà.

Nó bị lỗi là hoàn toàn đúng vì đường polyline của bạn tạo ra là lwpolyline.

Mình đã nói ngay từ đầu là lisp này chỉ chạy đúng với bản vẽ có cấu trúc đường polyline đ1ung như file bạn gửi, tức là nó phải là POLYLINE chứ không phải LWPOLYLINE.

Mình cũng đã giải thích về vấn đề này rồi mà.

Đường lwpolyline khi break sẽ chỉ tạo ra một polyline mới còn phần đầu của nó vẫn giữ nguyên tên gọi cũ. Do vậy khi dùng hàm (entnext ...) để lấy các đối tượng tạo ra sau đối tượng cuối cùng trên bản vẽ thì nó sẽ khôing lấy được phần lwpolyline này và như vậy nó chỉ có thể tạo được các đỉnh cho polyline mới tạo ra mà thôi. rất không may cho bạn là line cần tìm giao cắt đầu tiên lại nằm ở phía cuối của đường polyline. Vì vậy bạn chỉ có thể tạo được một đỉnh mà thôi. Sau đó lisp sẽ không tìm được các giao cắt nữa. và báo lỗi.

Còn đường polyline có cấu trúc như bản vẽ bạn gửi thì khi break sẽ tạo ra hai đối tượng mới và khi dùng hàm entnext sẽ lấy được cả hai đối tượng mới này để joint lại thành một đối tượng mới bạn ạ.

Với đường polyline là lwpolyline bạn phải sử dụng một cấu trúc lisp khác chứ không dùng chung với líp này được.

Nếu muốn dùng chung thì mình phải học mót thêm nhiều nhiều nữa đã mới hy vọng có thể sửa được.

Vì vậy có hai cách tùy bạn lựa chọin trong khi chờ đợi.

1/- với lwpolyline, bạn dùng lisp của bác ketxu. với Polyline có thể dùng lisp của mình.

2/- Ghep hai lisp này vào một file và khi dùng thì tùy loại polyline mà chọn lệnh.

[ndtnv 481]

Lisp này chỉ dùng cho lwpolyline, vì vậy bạn dùng lệnh convert của CAD để chuyển thành lwpolyline

 

(defun AppendLs (ls e)(append (if ls ls nil) (list e)))
(defun ObjInters (o1 o2 id / g ps n)
    (setq    g    (vlax-invoke o1 'IntersectWith o2 id)    ps '())
    (while g (setq    ps (AppendLs ps (list (car g) (cadr g) (caddr g))) g (cdddr g))    )    ps
)
(defun Bulge (p1 p2 r / a)
    (setq a (/ (distance p1 p2) 2 r))
    (setq a (/ (atan (/ a (sqrt (- 1 (* a a))))) 2))
    (/ (sin a) (cos a))
)

(defun C:II ( / b fz i l li lp lq ls n ob om p p1 p2 r ss) ; Insert vertex at intersections
    (setq i 0 fz 0.1) ; sai so giao diem lech so voi dinh pline
    (princ "Chon pline:")    (setq ss (ssget ":S") ob (vlax-ename->vla-object (ssname ss 0)) )
    (princ "Chon cac duong giao:")
    (setq ls (mapcar 'vlax-ename->vla-object
                                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*LINE")(8 . "ENTCOC"))))))))
    (foreach o ls
        (setq p (car(ObjInters ob o acExtendNone)) lp (AppendLs lp p))    
        (setq lq (AppendLs lq (vlax-curve-getParamAtPoint ob (vlax-curve-getClosestPointTo ob p)))))
    (setq li (vl-sort-i lq '>) )
    (foreach i li
        (setq n (fix (nth i lq)) p (nth i lp))
        (setq p1 (vlax-curve-getPointAtParam ob n) p2 (vlax-curve-getPointAtParam ob (1+ n)))
        (if (and  (< fz (distance p p1)) (< fz (distance p p2)))
            (progn
                (setq b (vlax-invoke Ob 'GetBulge n))
                (vlax-invoke Ob 'AddVertex (1+ n) (list (car p)(cadr p)))
                (if (/= b 0)
                    (progn
                        (setq r (/ (distance p1 p2) 2 (sin (* 2 (atan b)))))
                        (vlax-invoke Ob 'SetBulge n (Bulge p p1 r))
                        (vlax-invoke Ob 'SetBulge (1+ n) (Bulge p p2 r))))
            )
        ))

)

[thanhlong.hygt 9]

 

Lisp này chỉ dùng cho lwpolyline, vì vậy bạn dùng lệnh convert của CAD để chuyển thành lwpolyline

 

(defun AppendLs (ls e)(append (if ls ls nil) (list e)))
(defun ObjInters (o1 o2 id / g ps n)
    (setq    g    (vlax-invoke o1 'IntersectWith o2 id)    ps '())
    (while g (setq    ps (AppendLs ps (list (car g) (cadr g) (caddr g))) g (cdddr g))    )    ps
)
(defun Bulge (p1 p2 r / a)
    (setq a (/ (distance p1 p2) 2 r))
    (setq a (/ (atan (/ a (sqrt (- 1 (* a a))))) 2))
    (/ (sin a) (cos a))
)

(defun C:II ( / b fz i l li lp lq ls n ob om p p1 p2 r ss) ; Insert vertex at intersections
    (setq i 0 fz 0.1) ; sai so giao diem lech so voi dinh pline
    (princ "Chon pline:")    (setq ss (ssget ":S") ob (vlax-ename->vla-object (ssname ss 0)) )
    (princ "Chon cac duong giao:")
    (setq ls (mapcar 'vlax-ename->vla-object
                                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*LINE")(8 . "ENTCOC"))))))))
    (foreach o ls
        (setq p (car(ObjInters ob o acExtendNone)) lp (AppendLs lp p))    
        (setq lq (AppendLs lq (vlax-curve-getParamAtPoint ob (vlax-curve-getClosestPointTo ob p)))))
    (setq li (vl-sort-i lq '>) )
    (foreach i li
        (setq n (fix (nth i lq)) p (nth i lp))
        (setq p1 (vlax-curve-getPointAtParam ob n) p2 (vlax-curve-getPointAtParam ob (1+ n)))
        (if (and  (< fz (distance p p1)) (< fz (distance p p2)))
            (progn
                (setq b (vlax-invoke Ob 'GetBulge n))
                (vlax-invoke Ob 'AddVertex (1+ n) (list (car p)(cadr p)))
                (if (/= b 0)
                    (progn
                        (setq r (/ (distance p1 p2) 2 (sin (* 2 (atan b)))))
                        (vlax-invoke Ob 'SetBulge n (Bulge p p1 r))
                        (vlax-invoke Ob 'SetBulge (1+ n) (Bulge p p2 r))))
            )
        ))

)

Thank bác ạ. mấy hôm nay e ít thời gian quá nên giờ mới vào thank các bác được

[phamthanhbinh 3.146]

Thank bác ạ. mấy hôm nay e ít thời gian quá nên giờ mới vào thank các bác được

Hề hề hề,

Gửi bạn lisp mình đã thử sửa để có thể làm việc với lwpolyline. Theo một vài mẫu test mà bạn gửi lên và mình tự bịa thì có vẻ ổn. Son bạnn nên check kỹ lưỡng hơn trước khi dùng nhé.

http://www.cadviet.com/upfiles/3/5194_addvertexpolyline_2.lsp

[huaductiep 2]

Bác có thể giúp em add thêm point tại các điểm giao của đường cong thuộc lớp "TK" & "TL" với đường line "mcn" không ah? chứ líp trên em thử chưa dc :(

 

 

File cad http://www.cadviet.com/upfiles/5/64997_add_vertex.dwg

[unbroken 0]

Hề hề hề,

Gửi bạn lisp mình đã thử sửa để có thể làm việc với lwpolyline. Theo một vài mẫu test mà bạn gửi lên và mình tự bịa thì có vẻ ổn. Son bạnn nên check kỹ lưỡng hơn trước khi dùng nhé.

http://www.cadviet.com/upfiles/3/5194_addvertexpolyline_2.lsp

Bác cho em hỏi. em dùng lisp bác mà k được. Bình thường em vẽ ra toàn lwpline. Có cách nào để em trèn được điểm tại các giao đó không bác