Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Lisp cắt, xoay Bình đồ


  • Please log in to reply
7 replies to this topic

#1 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 18 June 2011 - 09:30 AM

bác nào giúp em cái này với, công việc cắt tạo góc xoay bình đồ thường phải lặp lại rất nhiều lần.
thường em hay làm như này. kẽ một đường thẳng cắt ngang qua(hai đường) rồi cắt hai phân rời ra rồi lại chọn cái phần cần xoay và nhập góc để xoay.
xin nhờ các bác giúp em một cái lips
- khi gạch một đường thẳng cắt ngang qua thì tự động hai phần sẽ được cắt rời nhau
- chương trình sẽ hỏi bạn cần xoay bên trái hay phải(nhập vào)
- và sau do là nhập góc cần xoay
giúp em với nhé. chân thành cảm ơn
  • 0

#2 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 18 June 2011 - 11:24 PM

bác nào giúp em cái này với, công việc cắt tạo góc xoay bình đồ thường phải lặp lại rất nhiều lần.
thường em hay làm như này. kẽ một đường thẳng cắt ngang qua(hai đường) rồi cắt hai phân rời ra rồi lại chọn cái phần cần xoay và nhập góc để xoay.
xin nhờ các bác giúp em một cái lips
- khi gạch một đường thẳng cắt ngang qua thì tự động hai phần sẽ được cắt rời nhau
- chương trình sẽ hỏi bạn cần xoay bên trái hay phải(nhập vào)
- và sau do là nhập góc cần xoay
giúp em với nhé. chân thành cảm ơn
Đây là bản vẽ nhò các bác xem giúp
Em cần cái kết thúc như trrong bản vẽ.
Còn cách làm thì tuỳ theo ý các bác cũng được
http://www.cadviet.c...les/3/111_1.dwg
  • 0

#3 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 19 June 2011 - 06:22 PM

bác nào giúp em cái này với, công việc cắt tạo góc xoay bình đồ thường phải lặp lại rất nhiều lần.
thường em hay làm như này. kẽ một đường thẳng cắt ngang qua(hai đường) rồi cắt hai phân rời ra rồi lại chọn cái phần cần xoay và nhập góc để xoay.
xin nhờ các bác giúp em một cái lips
- khi gạch một đường thẳng cắt ngang qua thì tự động hai phần sẽ được cắt rời nhau
- chương trình sẽ hỏi bạn cần xoay bên trái hay phải(nhập vào)
- và sau do là nhập góc cần xoay
giúp em với nhé. chân thành cảm ơn
Đây là bản vẽ nhò các bác xem giúp
Em cần cái kết thúc như trrong bản vẽ.
Còn cách làm thì tuỳ theo ý các bác cũng được
http://www.cadviet.c...les/3/111_1.dwg

Hề hề hề,
Bạn dùng thử cái này coi có ưng ý không nhé. Có gì chưa ưng hãy post lên để mình xem lại.

(defun c:xbd (/ p0 pn en1 ssl ssp en2 en3 pc p p1 p2 pk plst ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en1 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pc (car (acet-geom-intersectwith en1 en2 0)))
(if pc
(command "break" en2 pc "@")
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en1 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pn) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(if (= (strcase ans) "A")
(command "rotate" ssq "" p0 gq)
(command "rotate" ssq "" pn gq)
)
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)

Chúc bạn vui

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 19 June 2011 - 09:58 PM
Chỉnh sửa lại code

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

#4 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 20 June 2011 - 08:48 AM

Hề hề hề,
Bạn dùng thử cái này coi có ưng ý không nhé. Có gì chưa ưng hãy post lên để mình xem lại.


(defun c:xbd (/ p0 pn en1 ssl ssp en2 en3 pc p p1 p2 pk plst ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en1 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pc (car (acet-geom-intersectwith en1 en2 0)))
(if pc
(command "break" en2 pc "@")
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en1 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pn) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(if (= (strcase ans) "A")
(command "rotate" ssq "" p0 gq)
(command "rotate" ssq "" pn gq)
)
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)

Chúc bạn vui


bác chỉnh giúp em chỗ này tý
-chọn phía cần xoay thì nhờ bác chỉnh giúp chọn bên trái hay phải.
- bác cho em hỏi cái chưong trình hỏi "chọn điểm tiếp theo" bác có thể chỉnh giúp em những cái gì còn lại phía cần xoay sẽ được chọn hết (phía trái và phía phải.
- anh có thể chỉnh cho chương trình chọn điểm quay do người dùng chọn và sau đó sẽ đến chọn góc quay, quay theo chiều ngược kim đồng hồ
- trong quá trình quay em muốn giữ lại đường em vẽ để cắt ra hai phần (trong chương trình quay luôn cả đường cắt luôn).lúc em vẽ đường này là em vè hai đường chương trình sẽ chọn một đường đễ xoay và một đường giữ lại.
giúp giùm em với nhé. cảm ơn anh rất nhiều
  • 0

#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 20 June 2011 - 02:30 PM

bác chỉnh giúp em chỗ này tý
-chọn phía cần xoay thì nhờ bác chỉnh giúp chọn bên trái hay phải.
- bác cho em hỏi cái chưong trình hỏi "chọn điểm tiếp theo" bác có thể chỉnh giúp em những cái gì còn lại phía cần xoay sẽ được chọn hết (phía trái và phía phải.
- anh có thể chỉnh cho chương trình chọn điểm quay do người dùng chọn và sau đó sẽ đến chọn góc quay, quay theo chiều ngược kim đồng hồ
- trong quá trình quay em muốn giữ lại đường em vẽ để cắt ra hai phần (trong chương trình quay luôn cả đường cắt luôn).lúc em vẽ đường này là em vè hai đường chương trình sẽ chọn một đường đễ xoay và một đường giữ lại.
giúp giùm em với nhé. cảm ơn anh rất nhiều

Hề hề hề,
1/- Yêu cầu chọn phía cần xoay mình không chỉnh sửa gì vì xét thấy không cần thiết. Nếu muốn bạn hãy tự sửa.
2/- Mình chưa có cách khác để chọn tất cả các đối tượng ở một phía của đường cắt. Nếu muốn bạn hãy chờ các bác khác ra tay.
3/- Chỉ cần đổi dòng code (setq ans (getstring "\n Chon tam quay < A or B >: ")) lên trước dòng code (setq gq (getreal "\n Nhap goc quay theo do: "))
4/- Bổ sung thêm code copy đường cắt rồi xoay chung một lần.

Và đây là cái lisp mình đã chỉnh sửa theo nội dung như trên:

(defun c:xbd (/ p0 pn en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pc (car (acet-geom-intersectwith en0 en2 0)))
(if pc
(command "break" en2 pc "@")
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pk) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)



Hy vọng bạn không giận.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 20 June 2011 - 03:18 PM

Hề hề hề,
1/- Yêu cầu chọn phía cần xoay mình không chỉnh sửa gì vì xét thấy không cần thiết. Nếu muốn bạn hãy tự sửa.
2/- Mình chưa có cách khác để chọn tất cả các đối tượng ở một phía của đường cắt. Nếu muốn bạn hãy chờ các bác khác ra tay.
3/- Chỉ cần đổi dòng code (setq ans (getstring "\n Chon tam quay < A or B >: ")) lên trước dòng code (setq gq (getreal "\n Nhap goc quay theo do: "))
4/- Bổ sung thêm code copy đường cắt rồi xoay chung một lần.

Và đây là cái lisp mình đã chỉnh sửa theo nội dung như trên:


(defun c:xbd (/ p0 pn en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pc (car (acet-geom-intersectwith en0 en2 0)))
(if pc
(command "break" en2 pc "@")
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pk) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)



Hy vọng bạn không giận.

bác xem giúp em bản vẽ http://www.cadviet.c...es/3/1111_2.dwg
-đây là lý do em nhờ bác chỉnh cho nó chọn hết tất cả những cái mà phía cắt. cái này cắt vẫn còn xót
-khi mà chương trình yêu cầu chọn hướng cần xoay sau đó là nhấn điểm tiếp theo. nếu như e nhấn một đoạn nào đó ma f không nằm trong cái tam giác đó thì nó se không xoay.
rất móng bác phamthanhbinh và các bác trên diễn đàn giúp để hoàn thiện
chân thành cảm ơn
  • 0

#7 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 20 June 2011 - 03:56 PM

bác xem giúp em bản vẽ http://www.cadviet.c...es/3/1111_2.dwg
-đây là lý do em nhờ bác chỉnh cho nó chọn hết tất cả những cái mà phía cắt. cái này cắt vẫn còn xót
-khi mà chương trình yêu cầu chọn hướng cần xoay sau đó là nhấn điểm tiếp theo. nếu như e nhấn một đoạn nào đó ma f không nằm trong cái tam giác đó thì nó se không xoay.
rất móng bác phamthanhbinh và các bác trên diễn đàn giúp để hoàn thiện
chân thành cảm ơn

Hề hề hề,
Trước hết cám ơn bạn đã dùng lisp do mình viết.
Thứ nữa là việc còn lại một số đối tượng không xoay như bản vẽ bạn post là do các polyline của bạn khá phức tạp. Nó có thể có nhiều giao điểm với đường cắt chứ không phải chỉ có một giao điểm. Do vậy mình đã không xét tới trường hợp này. Để mình xét thêm rồi nếu được sẽ bổ sung sau.
Bạn cần lưu ý thêm với vái lisp của mình là khi lisp yêu cầu bạn Chon điểm tiếp theo thì bạn cứ việc chọn liên tục sao cho cái polyline mà bạn thấy nó tạo ra bao kín hoặc cắt qua các đối tượng bạn cần xoay. Khi bạn không chọn nữa nó sẽ tự động khép kín lại. Tất cả các đối tượng nằm trong hoặc trên polyline này sẽ được chọn với điều kiện toàn bộ vùng chọn đều thấy được trên màn hình.
Một lần nữa cám ơn phản hồi của bạn.

Đây là lisp mình đã bổ sung để đảm bảo cắt sạch các polyline. Bạn dùng thử xem sao nhé. Mình đả thử với bản vẽ 111_2 bạn gửi thì thấy ngon lành. Các trường hợp khác mong bạn test thêm.


(defun c:xbd (/ p0 pn en en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst pls ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pls (acet-geom-intersectwith en0 en2 0))
(setq en en2)
(if pls
(foreach pc pls
(command "break" en pc "@")
(setq en (entlast))
)
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pk) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)


Hy vọng bạn vừa ý. Chú ý khi chọn điểm tạo polyline sao cho phù hợp với ý bạn nhé.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 20 June 2011 - 05:10 PM
Bổ sung lisp đã sửa

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

#8 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 20 June 2011 - 06:08 PM

Hề hề hề,
Trước hết cám ơn bạn đã dùng lisp do mình viết.
Thứ nữa là việc còn lại một số đối tượng không xoay như bản vẽ bạn post là do các polyline của bạn khá phức tạp. Nó có thể có nhiều giao điểm với đường cắt chứ không phải chỉ có một giao điểm. Do vậy mình đã không xét tới trường hợp này. Để mình xét thêm rồi nếu được sẽ bổ sung sau.
Bạn cần lưu ý thêm với vái lisp của mình là khi lisp yêu cầu bạn Chon điểm tiếp theo thì bạn cứ việc chọn liên tục sao cho cái polyline mà bạn thấy nó tạo ra bao kín hoặc cắt qua các đối tượng bạn cần xoay. Khi bạn không chọn nữa nó sẽ tự động khép kín lại. Tất cả các đối tượng nằm trong hoặc trên polyline này sẽ được chọn với điều kiện toàn bộ vùng chọn đều thấy được trên màn hình.
Một lần nữa cám ơn phản hồi của bạn.

Đây là lisp mình đã bổ sung để đảm bảo cắt sạch các polyline. Bạn dùng thử xem sao nhé. Mình đả thử với bản vẽ 111_2 bạn gửi thì thấy ngon lành. Các trường hợp khác mong bạn test thêm.



(defun c:xbd (/ p0 pn en en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst pls ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pls (acet-geom-intersectwith en0 en2 0))
(setq en en2)
(if pls
(foreach pc pls
(command "break" en pc "@")
(setq en (entlast))
)
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pk) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)


Hy vọng bạn vừa ý. Chú ý khi chọn điểm tạo polyline sao cho phù hợp với ý bạn nhé.

bác phamthanhbinh ơi. lần này thì quá tuyệt rồi bác ơi. em không còn ý kiến gì nữa.Chỉ có thể nói là chân thành cảm ơn bác. Xin chúc bác sức khoẻ và mọi người trên diễn đàn như ý
  • 0