Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
14 replies to this topic

#1 auduongphuc

auduongphuc

    biết zoom

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

Đã gửi 02 December 2009 - 04:05 PM

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.c...iles/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)
  • 0

#2 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 03 December 2009 - 03:08 PM

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.c...iles/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)
)

  • 3

#3 thiep

thiep

    biết dimbaseline

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

Đã gửi 03 December 2009 - 03:18 PM

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.c...iles/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.c...&...ost&p=26682
  • 0

#4 auduongphuc

auduongphuc

    biết zoom

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

Đã gửi 07 December 2009 - 10:30 AM

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

#5 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 07 December 2009 - 10:48 AM

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

#6 auduongphuc

auduongphuc

    biết zoom

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

Đã gửi 07 December 2009 - 01:54 PM

Đừ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.
  • 0

#7 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 08 December 2009 - 09:16 AM

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

#8 auduongphuc

auduongphuc

    biết zoom

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

Đã gửi 08 December 2009 - 12:36 PM

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

#9 viennv

viennv

    biết zoom

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

Đã gửi 01 April 2011 - 04:31 PM

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. :(
  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 April 2011 - 05:50 PM

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)
)


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 t031285

t031285

    biết vẽ rectang

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

Đã gửi 07 July 2011 - 07:10 PM

Nhờ bác gia_bach và ketxu xem sửa giùm lisp nó bị như file đính kèm dưới.
http://www.cadviet.c...drawing1_72.dwg
Chân thành cảm ơn trước.
  • 0

#12 t031285

t031285

    biết vẽ rectang

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

Đã gửi 09 July 2011 - 06:54 AM

Nhờ bác gia_bach và ketxu xem sửa giùm lisp nó bị như file đính kèm dưới.
http://www.cadviet.c...drawing1_72.dwg
Chân thành cảm ơn trước.

Không bác nào giúp được e sao?Mong các bác xem và sửa giúp e với.Thanks
  • 0

#13 t031285

t031285

    biết vẽ rectang

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

Đã gửi 08 August 2011 - 08:04 PM

Nhờ bác gia_bach và ketxu xem sửa giùm lisp nó bị như file đính kèm dưới.
http://www.cadviet.c...drawing1_72.dwg
Chân thành cảm ơn trước.

Đã 1 tháng trôi qua mà không bác nào giúp được e sao?
  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 August 2011 - 09:21 PM

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ử ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#15 bicnv90

bicnv90

    Chưa sử dụng CAD

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

Đã gửi 17 June 2014 - 10:54 AM

năm 2011 chắc chưa có lệnh EXTRIM nhỉ các bác


  • 0