Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
auduongphuc

[Ỵêu cầu] Lisp Trim đối tượng

Bởi auduongphuc , trong AutoLisp

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

auduongphuc    1

auduongphuc
Đã đăng

Không biết trên diễn đàn có chưa, nhưng mình tìm hoài mà không có. nên nhờ các cao thủ ra tay làm giúp . mình nghĩ chắc cũng nhanh.

có các đường thẳng giao nhau, ( giống như cái lan can tay vịn) giờ mình muốn trim các đoạn thẳng giao nhau ở bên trong( hoặc bên ngoài). nếu ngồi trim từng cái theo lệnh CAD thì thấy hơi lâu. mong các cao thủ làm giúp. Xin cảm ơn rất nhiều.

mình gửi kèm theo file để xem cho dễ hiểu.

 

http://www.cadviet.com/upfiles/2/mh_1.dwg

 

xin nói thêm là cách trim của mình là: crosing window, có thể quét toàn bộ đối tượng. và mất đi những phần mình muốn ( bên trong hoặc bên ngoài)

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    1562

gia_bach
Đã đăng
Không biết trên diễn đàn có chưa, nhưng mình tìm hoài mà không có. nên nhờ các cao thủ ra tay làm giúp . mình nghĩ chắc cũng nhanh.

có các đường thẳng giao nhau, ( giống như cái lan can tay vịn) giờ mình muốn trim các đoạn thẳng giao nhau ở bên trong( hoặc bên ngoài). nếu ngồi trim từng cái theo lệnh CAD thì thấy hơi lâu. mong các cao thủ làm giúp. Xin cảm ơn rất nhiều.

mình gửi kèm theo file để xem cho dễ hiểu.

 

http://www.cadviet.com/upfiles/2/mh_1.dwg

 

xin nói thêm là cách trim của mình là: crosing window, có thể quét toàn bộ đối tượng. và mất đi những phần mình muốn ( bên trong hoặc bên ngoài)

Bạn chạy thử Lisp này. 

(vl-load-com)
(defun C:TRIMIT (/ bit iPts lstObj lstPts lstPtsObj lstPtsPa obj pts ss)
 (command "undo" "be")
 (setq ss (ssget (list (cons 0 "*LINE,ARC"))))
 (initget "T N")
 (setq bit (getkword "\nTrim cac doan giao nhau o ben Trong hay ben Ngoai : " ) )
 (setq lstObj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
 (foreach obj lstObj
   (foreach e (vl-remove obj lstObj)
     (setq iPts (vlax-Invoke e "IntersectWith" obj 0))
     (if (= (vl-list-length iPts) 3 )
(setq lstPtsPa (cons (cons (vlax-curve-getParamAtPoint obj iPts) iPts) lstPtsPa) ) )
     );foreach
   (if lstPtsPa
     (setq lstPtsPa (vl-sort lstPtsPa '(lambda (x y) (> (car x) (car y))))
    lstPts (append (mapcar 'cdr lstPtsPa) (list(vlax-curve-getStartPoint obj))) ))
   (if (= bit "N")
     (setq lstPts (append (list(vlax-curve-getEndPoint obj)) lstPts) )   )
   (setq lstPtsObj (cons (cons obj lstPts) lstPtsObj)
  lstPtsPa nil   )
   );foreach
 (foreach PtsObj lstPtsObj
   (setq obj (vlax-vla-object->ename (car PtsObj)) Pts (cdr PtsObj))
   (repeat (/ (length (cdr PtsObj)) 2)
     (command "._break" obj "_non" (car Pts) "_non" (cadr Pts) )      
     (setq Pts (cddr Pts))  )
 );foreach
 (command "undo" "e")
 (princ)
)

  • Like 1
  • Vote tăng 3

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

thiep    367

thiep
Đã đăng
Không biết trên diễn đàn có chưa, nhưng mình tìm hoài mà không có. nên nhờ các cao thủ ra tay làm giúp . mình nghĩ chắc cũng nhanh.

có các đường thẳng giao nhau, ( giống như cái lan can tay vịn) giờ mình muốn trim các đoạn thẳng giao nhau ở bên trong( hoặc bên ngoài). nếu ngồi trim từng cái theo lệnh CAD thì thấy hơi lâu. mong các cao thủ làm giúp. Xin cảm ơn rất nhiều.

mình gửi kèm theo file để xem cho dễ hiểu.

 

http://www.cadviet.com/upfiles/2/mh_1.dwg

 

xin nói thêm là cách trim của mình là: crosing window, có thể quét toàn bộ đối tượng. và mất đi những phần mình muốn ( bên trong hoặc bên ngoài)

Chào bạn auduongphuc,

với yêu cầu của bạn, Công cụ ToolPac có thể làm được 1 phần yêu cầu của bạn. Lệnh là OCI (cleanup intersections)

Thiep vẫn chưa cài được bộ công cụ này, Bạn vào đây và hỏi thêm bạn KHIEMHAO:

http://www.cadviet.com/forum/index.php?s=&...ost&p=26682

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

auduongphuc    1

auduongphuc
Đã đăng
Bạn chạy thử Lisp này.
(vl-load-com)
(defun C:TRIMIT (/ bit iPts lstObj lstPts lstPtsObj lstPtsPa obj pts ss)
 (command "undo" "be")
 (setq ss (ssget (list (cons 0 "*LINE,ARC"))))
 (initget "T N")
 (setq bit (getkword "\nTrim cac doan giao nhau o ben Trong hay ben Ngoai : " ) )
 (setq lstObj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
 (foreach obj lstObj
   (foreach e (vl-remove obj lstObj)
     (setq iPts (vlax-Invoke e "IntersectWith" obj 0))
     (if (= (vl-list-length iPts) 3 )
(setq lstPtsPa (cons (cons (vlax-curve-getParamAtPoint obj iPts) iPts) lstPtsPa) ) )
     );foreach
   (if lstPtsPa
     (setq lstPtsPa (vl-sort lstPtsPa '(lambda (x y) (> (car x) (car y))))
    lstPts (append (mapcar 'cdr lstPtsPa) (list(vlax-curve-getStartPoint obj))) ))
   (if (= bit "N")
     (setq lstPts (append (list(vlax-curve-getEndPoint obj)) lstPts) )   )
   (setq lstPtsObj (cons (cons obj lstPts) lstPtsObj)
  lstPtsPa nil   )
   );foreach
 (foreach PtsObj lstPtsObj
   (setq obj (vlax-vla-object->ename (car PtsObj)) Pts (cdr PtsObj))
   (repeat (/ (length (cdr PtsObj)) 2)
     (command "._break" obj "_non" (car Pts) "_non" (cadr Pts) )      
     (setq Pts (cddr Pts))  )
 );foreach
 (command "undo" "e")
 (princ)
)

Cảm ơn Lisp của bạn nhiều lắm. Nhưng thực sự thì mình không chạy được nó. mình thực hiện lệnh xong, tới đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? tới đây thì không làm sao chọn được nữa, vì đánh cái gì nó cũng không chịu. enter thì báo error, bad function. mong bạn xem lại và hướng dẫn cho mình cách thực hiện. Cảm ơn rất nhiều

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    1562

gia_bach
Đã đăng
Cảm ơn Lisp của bạn nhiều lắm. Nhưng thực sự thì mình không chạy được nó. mình thực hiện lệnh xong, tới đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? tới đây thì không làm sao chọn được nữa, vì đánh cái gì nó cũng không chịu. enter thì báo error, bad function. mong bạn xem lại và hướng dẫn cho mình cách thực hiện. Cảm ơn rất nhiều

Đừng dowload bằng cách click vào Download lisp file.

(chức năng này của diễn đàn đang bị lỗi)

Bạn copy toàn bộ text trong mục CODEBOX và luu thành file *.lsp.

 

tới đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? tới đây thì không làm sao chọn được nữa,

- nếu bạn muốn Trim bên trong : gõ T hoặc t

- nếu bạn muốn Trim bên ngoài : gõ N hoặc n

 

Chúc bạn thành cô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

auduongphuc    1

auduongphuc
Đã đăng
Đừng dowload bằng cách click vào Download lisp file.

(chức năng này của diễn đàn đang bị lỗi)

Bạn copy toàn bộ text trong mục CODEBOX và luu thành file *.lsp.

 

tới đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? tới đây thì không làm sao chọn được nữa,

- nếu bạn muốn Trim bên trong : gõ T hoặc t

- nếu bạn muốn Trim bên ngoài : gõ N hoặc n

 

Chúc bạn thành công.

Mình đã làm đúng như cách bạn hướng dẫn. Nhưng không được. copy đoạn code về rồi save lại.khi mình load nó thì nó báo "error: misplaced dot on input" không thực hiện lệnh được. còn "download lisp file" thì chạy được. nhưng đến đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? mình cũng gõ "T" & "N" thi bao lỗi

 

"Trim cac doan giao nhau o ben Trong hay ben Ngoai : t ; error: bad function: nil" đây là dòng báo lỗi khi mình thực hiện lệnh

mong bạn xem lại lần nữa giúp mình. cảm ơn bạn nhiều lắ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

gia_bach    1562

gia_bach
Đã đăng
Mình đã làm đúng như cách bạn hướng dẫn. Nhưng không được. copy đoạn code về rồi save lại.khi mình load nó thì nó báo "error: misplaced dot on input" không thực hiện lệnh được. còn "download lisp file" thì chạy được. nhưng đến đoạn nó hỏi mình "Trim bên trong hay bên ngoài"? mình cũng gõ "T" & "N" thi bao lỗi

 

"Trim cac doan giao nhau o ben Trong hay ben Ngoai : t ; error: bad function: nil" đây là dòng báo lỗi khi mình thực hiện lệnh

mong bạn xem lại lần nữa giúp mình. cảm ơn bạn nhiều lắm.

Vì không biết nội dung đoạn code bạn copy như thế nào ? -> không thể giúp gì hơn đuợc!

 

Trở lại file LISP trimit.lsp down từ "download lisp file" :

tìm và thay thế "\'" bằng "'"

tuơng đưong với việc xóa kí tự "\"

save file.

thực hiện lại lệnh LOAD ....

Chúc bạn may mắn.

  • 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

auduongphuc    1

auduongphuc
Đã đăng
Vì không biết nội dung đoạn code bạn copy như thế nào ? -> không thể giúp gì hơn đuợc!

 

Trở lại file LISP trimit.lsp down từ "download lisp file" :

tìm và thay thế "\'" bằng "'"

tuơng đưong với việc xóa kí tự "\"

save file.

thực hiện lại lệnh LOAD ....

Chúc bạn may mắn.

Mình đã sửa lại giống như bạn nói, và đã làm được, tuy còn một số cái chưa vừa ý( nếu mình chọn nhiều giống như cái lan can cầu thang thì có cái được có cái không), nhưng không sao.cảm ơn bạn rất nhiều.

THANK'S

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

ketxu    3023

ketxu
Đã đăng

Tình hình là e copy lisp của bác về chạy thì nó báo : too many arguments. Bác nào có cách khắc phục không chỉ em với. :(

Nguyên văn code :

 

(defun C:TRIMIT (/ bit iPts lstObj lstPts lstPtsObj lstPtsPa obj pts ss)

(vl-load-com)

(command "undo" "be")

(setq ss (ssget (list (cons 0 "*LINE,ARC"))))

(initget "T N")

(setq bit (getkword "\nTrim cac doan giao nhau o ben Trong hay ben Ngoai <T N >: " ) )

(setq lstObj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))

(foreach obj lstObj

(foreach e (vl-remove obj lstObj)

(setq iPts (vlax-Invoke e "IntersectWith" obj 0))

(if (= (vl-list-length iPts) 3 )

(setq lstPtsPa (cons (cons (vlax-curve-getParamAtPoint obj iPts) iPts) lstPtsPa) ) )

);foreach

(if lstPtsPa

(setq lstPtsPa (vl-sort lstPtsPa '(lambda (x y) (> (car x) (car y))))

lstPts (append (mapcar 'cdr lstPtsPa) (list(vlax-curve-getStartPoint obj))) ))

(if (= bit "N")

(setq lstPts (append (list(vlax-curve-getEndPoint obj)) lstPts) ) )

(setq lstPtsObj (cons (cons obj lstPts) lstPtsObj)

lstPtsPa nil )

);foreach

(foreach PtsObj lstPtsObj

(setq obj (vlax-vla-object->ename (car PtsObj)) Pts (cdr PtsObj))

(repeat (/ (length (cdr PtsObj)) 2)

(command "._break" obj "_non" (car Pts) "_non" (cadr Pts) )

(setq Pts (cddr Pts))

)

);foreach

(command "undo" "e")

(princ)

)

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

ketxu    3023

ketxu
Đã đăng

Thực chất mình không hiểu được nguyên lý làm việc của lisp bạn yêu cầu, chỉ qua 1 hình. Không có quy luật nào hình thành sau 1 phép thử ^^

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×