Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1461 hoan2182

hoan2182

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2646 Bài viết
Điểm đánh giá: 832 (rất tốt)

Đã gửi 30 July 2010 - 02:28 PM

Hì hì hì,
http://www.cadviet.c...o_bc...sp.rarcủa mình không mở được file bạn gửi. Thật tiếc ....

Em chuyển nó về Cad2004:
http://www.cadviet.c...nh_vietlisp.rar
Hình như bác chỉ thích xe ô tô đời cao... con mẹc chả hạn... sao bác không thích "ô tô két" két đời cao??????????????????

Hề hề hề,
tại sao lại không yêu cái thằng Ô tô .... Mẹc ... nhỉ? Nó chả hơn ối thằng Auto Lisp ấy chứ....
Hề hề hề, ...


  • 2

Gió đưa cây cải về trời

Rau răm ở lại chịu lời đắng cay...


#1462 romeo1982

romeo1982

    biết lệnh mirror

  • Members
  • PipPipPip
  • 152 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 30 July 2010 - 02:36 PM

Hề hề hề,...
Vậy là vấn đề sẽ có chút phiền toái hơn do cái việc chọn các text trong vùng chọn. Nó rắc rối như sau:
1/- Bạn chỉ chọn các đối tượng là text hay cả các Mtext.
2/- Do vùng chọn không phải chỉ có một text nên việc sắp xếp trật tự các Text này như thế nào cho đúng ý bạn, giữa các Text sẽ là ký hiệu hay dấu hiệu gì???
3/- Do số lượng Text khác nhau nên độ rộng của cột sẽ chọn ra sao???
Bạn thử xem xét các vấn đề trên để có hướng giải quyết nhé.

OH, rất cám ơn bác đã nhắc nhở, thôi thì vầy cho chắc ăn: mình chọn các đối tương text (miễn text là lấy không phân biệt) nha bác, các text nằm trong vùng pick thì xuất ra cùng 1 hàng và cách nhau 1 dấu phẩy( text xuất ra là Dtext), còn độ rộng của cột thì sẽ chạy theo độ rộng của text, cái này cũng không quan trọng lắm vì sau khi làm xong thì mình chỉnh sửa cũng nhanh. Còn 1 cái này nữa mình đang đau đầu là trong bản vẽ này rất là nhìu font: TCVN, .SHX,VNI,.......nói chung là lộn tùng phèo mà mình thì thường xài VNI-AVO, không biết bác có ra tay đổi font trong khung mà mình tạo ra trong bản vẽ luôn được ko.Mong tin bác
  • 0

#1463 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 30 July 2010 - 06:42 PM

OH, rất cám ơn bác đã nhắc nhở, thôi thì vầy cho chắc ăn: mình chọn các đối tương text (miễn text là lấy không phân biệt) nha bác, các text nằm trong vùng pick thì xuất ra cùng 1 hàng và cách nhau 1 dấu phẩy( text xuất ra là Dtext), còn độ rộng của cột thì sẽ chạy theo độ rộng của text, cái này cũng không quan trọng lắm vì sau khi làm xong thì mình chỉnh sửa cũng nhanh. Còn 1 cái này nữa mình đang đau đầu là trong bản vẽ này rất là nhìu font: TCVN, .SHX,VNI,.......nói chung là lộn tùng phèo mà mình thì thường xài VNI-AVO, không biết bác có ra tay đổi font trong khung mà mình tạo ra trong bản vẽ luôn được ko.Mong tin bác

Hề hề hề,
Trong lúc chờ bác giả nhời mình đã làm đại cái này. Có nhẽ nó gần giống với cái bác cần. Nó chỉ chọn các text thôi, còn Mtext thì bỏ qua. Nếu bác muốn chọn cả Mtext thì cũng được nhưng phải chờ chút nữa để mình sửa lại. Bác xài thử coi sao rồi sửa tiếp nghen.
Cái vụ xử lý font thì mình cũng bí rị vì quả thực là nó quá rắc rối. Trong mã dxf của text chỉ có mã cho style chứ chưa thấy mã cho font, bởi vậy muốn xử nó lại phải mò vào thằng style, mà chửa rõ thằng này nó ra răng bác ạ.
Cách tốt nhất là bác cứ thiết kế lấy dăm thằng style thông dụn để xài thôi chứ làm nhiều style quá cũng dễ tẩu hỏa nhập ma lắm bác ạ.

(defun c:tdt()
(setvar "cmdecho" 0)
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))

(setq k 0
tdt 0)
(setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P11 (list (+ (car PT)(* 22 h)) (cadr PT))
P2 (list (+ (car PT)(* 38 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P44 (list (car P11) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 19 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 30 h)) (- (cadr PT)(* 1.5 h)))
P88 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"pline" P11 P44 ""
"text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DiÖn tÝch (m2)"
"text" "m" P88 h 0 "Ten CT"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(setq k (+ 1 k))
;;;;;;;;;(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P1a (list (+ (car PT)(* 22 h)) (cadr PT))
P2 (list (+ (car PT)(* 38 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P4a (list (car P1a) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 30 h)) (- (cadr PT)(* 1.5 h)))
P8a (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P10a (list (car P1a) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
P13a (list (car P8a) (cadr P12))
);setq
(setq str "" i 0 )
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(setq elst (entget et))
(setq plst (list))
(foreach cod elst
(if (= (car cod) 10)
(setq plst (append plst (list(cdr cod))))))
(setq tt (ssget "CP" plst '(( 0 . "text"))))
(if (/= tt nil)
(progn
(setq n (sslength tt))
(while (< i n)
(setq str (strcat str (cdr(assoc 1 (entget(ssname tt i)))) " + ") i (1+ i)))
(setq m (strlen str))
(setq str (substr str 1 (- m 3)))))
(ssadd et ss)
(command "area" "e" "last")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (* (getvar "AREA") tl tl))
(setq tdt (+ dtcon tdt))
(command "erase" ss "")
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"pline" P1a P4a ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dtcon 2 2)
"text" "m" P8a h 0 str)

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"pline" P10a P4a ""
"text" "m" P12 h 0 "Tæng"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
)

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

#1464 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 31 July 2010 - 03:05 PM

Em chuyển nó về Cad2004:
http://www.cadviet.c...nh_vietlisp.rar
Hình như bác chỉ thích xe ô tô đời cao... con mẹc chả hạn... sao bác không thích "ô tô két" két đời cao??????????????????

Hề hề hề,....
Thích quá đi chứ lị, chỉ mỗi tội thiếu ..... xìn thôi.
Mới lị mấy đối tác quen tuyền xài cái ni nên ngại đổi cái mới họ sắc mắc mừ..... Dùng quen tay quen mắt rồi bây chừ đổi cái mới lại phải mò mẫm nên hì hì, cứ thế xài tiếp.
Mà nhân thể bác cho hỏi lươn là đang dùng Cad2004, cài thêm CAD2007 hay CAD2010 có bị xung khắc gì không??? Có thể xài song song cả hai hay ba "vớ dần" được không??? Bởi vì trong lúc chửa thân với thằng sau thì vẫn xài thằng trước được, và trong lúc học xài thằng sau thì thằng trước vẫn xài để tham khảo ấy mà.....
Hì hì hì, cái tội dốt nên hay sợ bóng sợ vía vậy, bác chớ giận mà tội ...... nghiệt. Hì hì hì,....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1465 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 31 July 2010 - 03:13 PM

Hề hề hề,....
Thích quá đi chứ lị, chỉ mỗi tội thiếu ..... xìn thôi.
Mới lị mấy đối tác quen tuyền xài cái ni nên ngại đổi cái mới họ sắc mắc mừ..... Dùng quen tay quen mắt rồi bây chừ đổi cái mới lại phải mò mẫm nên hì hì, cứ thế xài tiếp.
Mà nhân thể bác cho hỏi lươn là đang dùng Cad2004, cài thêm CAD2007 hay CAD2010 có bị xung khắc gì không??? Có thể xài song song cả hai hay ba "vớ dần" được không??? Bởi vì trong lúc chửa thân với thằng sau thì vẫn xài thằng trước được, và trong lúc học xài thằng sau thì thằng trước vẫn xài để tham khảo ấy mà.....
Hì hì hì, cái tội dốt nên hay sợ bóng sợ vía vậy, bác chớ giận mà tội ...... nghiệt. Hì hì hì,....

Không có xung khắc gì cả bác ạ. Mỗi cái tội là giúp cho bác biết được những cái mới mới mới và hay hay hay mà thôi.
Bác thích mà không sài thì... uổng lắm đó. Hì hì hì,.... :(
  • 2

#1466 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 31 July 2010 - 03:35 PM

OH, rất cám ơn bác đã nhắc nhở, thôi thì vầy cho chắc ăn: mình chọn các đối tương text (miễn text là lấy không phân biệt) nha bác, các text nằm trong vùng pick thì xuất ra cùng 1 hàng và cách nhau 1 dấu phẩy( text xuất ra là Dtext), còn độ rộng của cột thì sẽ chạy theo độ rộng của text, cái này cũng không quan trọng lắm vì sau khi làm xong thì mình chỉnh sửa cũng nhanh. Còn 1 cái này nữa mình đang đau đầu là trong bản vẽ này rất là nhìu font: TCVN, .SHX,VNI,.......nói chung là lộn tùng phèo mà mình thì thường xài VNI-AVO, không biết bác có ra tay đổi font trong khung mà mình tạo ra trong bản vẽ luôn được ko.Mong tin bác

Hề hề hề,....
Và cái ni xài cả cho thằng MTEXT nè. Tuy nhiên bác phải lưu ý vài cái lằng nhằng như sau:
1/- Với thằng Mtext thì cái giá trị text rút ra sẽ bao gồm cả các mã thể hiện định dạng của Text. Việc loại bỏ các mã này khỏi chuỗi text là một việc khá lôi thôi vì nó lắm loại quá. Vậy nên mình cứ cho bê nguyên xi cả các mã này vào các chuỗi kết quả. Sau khi chạy lisp, bác có thể kiểm tra lại và thấy cái gì chả cần thì xóa nó đi nha.
2/- Độ rộng cột Ten CT hiện tại có thể chưa phù hợp với yêu cầu của bác, xong bác hoàn toàn có thể điều chỉnh nó trong lisp. Khi điều chỉnh bác nhớ là phải điều chỉnh luôn cả các điểm đặt của text nha. Nếu bác ngại thì hãy cho biết độ rộng bác cần, mình sẽ điều chỉnh lại.
3/- Cũng có thể điều chỉnh độ rộng cột theo độ dài tối đa của chuỗi text, nhưng như vậy lisp sẽ phải thay đổi kha khá, phải xác định số ký tự tối đa của chuỗi trước khi vẽ bảng. Rồi dựa vào số ký tự này để xác định độ rộng của cột Ten CT. Hơi loằng ngoằng nhưng có thể được bác ạ, chỉ phải cái mình lười thôi. Hề hề hề,....

Của bác đây ạ:

(defun c:tdt()
(command "undo" "be")
(setvar "cmdecho" 0)
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))

(setq k 0
tdt 0)
(setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P11 (list (+ (car PT)(* 22 h)) (cadr PT))
P2 (list (+ (car PT)(* 38 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P44 (list (car P11) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 19 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 30 h)) (- (cadr PT)(* 1.5 h)))
P88 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"pline" P11 P44 ""
"text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DiÖn tÝch (m2)"
"text" "m" P88 h 0 "Ten CT"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(setq k (+ 1 k))
;;;;;;;;;(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P1a (list (+ (car PT)(* 22 h)) (cadr PT))
P2 (list (+ (car PT)(* 38 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P4a (list (car P1a) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 30 h)) (- (cadr PT)(* 1.5 h)))
P8a (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P10a (list (car P1a) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
P13a (list (car P8a) (cadr P12))
);setq
(setq str "" i 0 )
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(setq elst (entget et))
(setq plst (list))
(foreach cod elst
(if (= (car cod) 10)
(setq plst (append plst (list(cdr cod))))))
(setq tt (ssget "CP" plst '((0 . "TEXT,MTEXT"))))
(if (/= tt nil)
(progn
(setq n (sslength tt))
(while (< i n)
(setq els (entget(ssname tt i)))
(if (= (cdr(assoc 0 els)) "TEXT")
(setq str (strcat str (cdr(assoc 1 els)) " + "))
(if (= (cdr(assoc 0 els)) "MTEXT")
(progn
(foreach aa els
(if (= (car aa) 3)
(setq str (strcat str (cdr aa)))))
(setq str (strcat str (cdr (assoc 1 els)) " + ")))))
(setq i (1+ i)))
(setq m (strlen str))
(setq str (substr str 1 (- m 3)))))
(ssadd et ss)
(command "area" "e" "last")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (* (getvar "AREA") tl tl))
(setq tdt (+ dtcon tdt))
(command "erase" ss "")
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"pline" P1a P4a ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dtcon 2 2)
"text" "m" P8a h 0 str)

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"pline" P10a P4a ""
"text" "m" P12 h 0 "Tæng"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
(command "undo" "e")
(princ)
)

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

#1467 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 31 July 2010 - 04:38 PM

Dạ xin cảm ơn anh Phamthanhbinh …

http://www.mediafire...4o2x02oaluk91c4
Đây là file cad mà e nhờ các anh viết giúp lisp để xoay đối tượng theo phương tiếp tuyến của đường cong . các anh xem giúp nhé ( chỉ 33kb thôi )

Với các anh xem dùm em e cái lisp e xin là nhập cao độ z cho các đường polyline ở trang trước được không a . E có nói chi tiết về những yêu cầu của lisp này rồi.

Chào bạn 843824,
Mình đã xem bản vẽ và yêu cầu của bạn. Tuy nhiên yêu cầu chưa nói rõ là các điểm trên đường cong bạn chọn ra sao???
Theo như hình vẽ thì đó là phương pháp tuyến của đường cong chứ không phải tiếp tuyến, vậy bạn muốn phương nào???
Việc lựa chọn bên phải hay bên trái là chọn theo cả lố hay chọn cho từng đối tượng???
Thực ra cái lisp như yêu cầu của bạn đã có trên diễn đàn rồi, hình như là lisp rải cột điện chi chi đó, bạn hãy tìm kiếm và xài thử xem cần chỉnh sửa những gì. Khi đó post lên mọi người sẽ chỉnh giùm sẽ nhanh hơn là viết lại toàn bộ bạn ạ.
Bạn trả lời hết các câu hỏi trên mình mới có thể viết được vì mình không muốn phải làm đi làm lại nhiều lần....
Chúc bạn vui,..
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1468 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 01 August 2010 - 09:45 AM

Dạ xin cảm ơn anh Phamthanhbinh …

http://www.mediafire...4o2x02oaluk91c4
Đây là file cad mà e nhờ các anh viết giúp lisp để xoay đối tượng theo phương tiếp tuyến của đường cong . các anh xem giúp nhé ( chỉ 33kb thôi )

Với các anh xem dùm em e cái lisp e xin là nhập cao độ z cho các đường polyline ở trang trước được không a . E có nói chi tiết về những yêu cầu của lisp này rồi.

Chào bạn 843824,
Trong khi chờ đợi bạn trả lời, mình làm cái này để bạn xài thử. Nó yêu cầu bạn phải chọn block nguồn để copy, đường cong đích, chọn điểm thuộc đường cong, chọn hướng copy. Sau đó tiếp tục chọn điểm tiếp theo để copy hoặc enter để kết thúc.
Cách làm này hơi thủ công và không nhanh hơn làm tay bao nhiêu. Nhưng được cái là bạn có thể tùy chọn theo ý bạn mà không sợ trật chìa.

(defun c:ido ()
(vl-load-com)
(command "undo" "be")
(setq dt (car (entsel "\n Chon doi tuong goc"))
edt (entget dt)
bn (cdr (assoc 2 edt))
dg (cdr (assoc 10 edt))
dc (car (entsel "\n Chon duong chuan"))
edc (entget dc)
p0 (getpoint"\n Chon diem bat dau")
)
(while (/= p0 nil)
(if (equal (cdr (assoc 10 edc)) p0)
(setq a1 0)
(setq a1 (vlax-curve-getdistatpoint dc p0))
)
(setq par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
(if (> (cadr vtt) 0)
(setq gr (- 0 (/ pi 2)))
(setq gr (/ pi 2))
)
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(setq ans (getstring "\n Copy ve ben phai (y or n)?"))
(if (= ans "n")
(setq gd (+ gd 180))
)
(command "insert" bn "r" gd p0 "" "" )
(setq p0 (getpoint "\n Chon diem tiep theo hoac nhan Enter de ket thuc"))
)
(command "undo" "e")
(princ)
)

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

#1469 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 02 August 2010 - 10:03 AM

Giúp viết Lisp chuyển từ đối tượng rời rạc sang đối tượng Block có wipeout.
Minh có các đối tượng rời rạc: khung tên, bảng thống kê vật liệu, ô chú thích. Khi di chuyển vào bản vẽ nó hay bị trùng, và không che những phần nằm dưới nó.
Bác nào giúp e viết lisp, khi chọn các đối tượng: khung tên, bảng thống kê vật liệu, ô chú thích thì nó tự động vẽ 1 đường bao wipeout các đối tượng này, và wipe out này nằm dưới, sau đó block các đối tượng này gồm: khung tên, bảng thống kê vật liệu....


File bản vẽ mình đây
http://www.mediafire...eu9b0574smv7qs4
  • 0

#1470 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 02 August 2010 - 10:49 AM

Chào bạn 843824,
Trong khi chờ đợi bạn trả lời, mình làm cái này để bạn xài thử. Nó yêu cầu bạn phải chọn block nguồn để copy, đường cong đích, chọn điểm thuộc đường cong, chọn hướng copy. Sau đó tiếp tục chọn điểm tiếp theo để copy hoặc enter để kết thúc.
Cách làm này hơi thủ công và không nhanh hơn làm tay bao nhiêu. Nhưng được cái là bạn có thể tùy chọn theo ý bạn mà không sợ trật chìa.


................
(setq a1 (vlax-curve-getdistatpoint dc p0))

(setq par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
)
............

Chúc bạn vui.

Chào bác Bình :
Các hàm : vlax-curve-getdistatpoint, vlax-curve-getparamatdist, vlax-curve-getFirstderiv yêu cầu đối số là VLA-object .
bác quên gọi hàm vlax-ename->vla-object để đổi Curve qua VLA-object.
  • 1

#1471 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 02 August 2010 - 11:10 AM

Chào bác Bình :
Các hàm : vlax-curve-getdistatpoint, vlax-curve-getparamatdist, vlax-curve-getFirstderiv yêu cầu đối số là VLA-object .
bác quên gọi hàm vlax-ename->vla-object để đổi Curve qua VLA-object.

Các hàm loại này chấp nhận cả ename hoặc vla-object bác ạ
  • 2

#1472 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 02 August 2010 - 11:26 AM

Các hàm loại này chấp nhận cả ename hoặc vla-object bác ạ

ừ nhỉ . Bé cái nhầm. :(
thanks you!
  • 0

#1473 843824

843824

    biết vẽ circle

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

Đã gửi 02 August 2010 - 12:06 PM

Ủa sao kì vậy ta
Hôm qua e đã vào trả lời rồi mà sao bài mất tiêu rồi trời ….
 E thank các a đã giúp đỡ nhiều
- Em trả lời lại câu hỏi của a Binh
+ Em sorry hôm trước nói bậy là tiếp tuyến – thật ra là pháp tuyến mới đúng ( khùng hết sức )
+ Các điểm trên đường cong e lựa chọn tùy ý ( do e tự pick )
+ Chọn đối tượng bên trái/phải là chọn hết cả lố luôn
( nâng cao thêm thì trái/phải/sole 1 trái 1 phải … là cho cả lố hết )

- Em chưa chạy thử lisp a cho nhưng thấy đã ok với những yêu cầu rồi . chỉ có điều là làm thủ công lắm hì
- Vậy nếu có thể a viết giúp e nâng cao lên như vầy nhé :
1. Sau khi tạo block , copy block tới các điểm cần bố trí trên đường cong ( tự làm )
2. Gọi lisp
3. Lisp yêu cầu chọn các đối tượng cần quay ( chọn hết block )
4. Lisp yêu cầu chọn đường cong
5. Lisp hỏi quay ( trái/phải/so le )
6. Xuất kết quả là quay hết luôn cho e cả lố 1 lần
- THANK CÁC A NHIỀU NHIỀU --- CHÚC SỨC KHỎE CÁC ANH
  • 0

#1474 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 02 August 2010 - 04:06 PM

Giúp viết Lisp chuyển từ đối tượng rời rạc sang đối tượng Block có wipeout.
Minh có các đối tượng rời rạc: khung tên, bảng thống kê vật liệu, ô chú thích. Khi di chuyển vào bản vẽ nó hay bị trùng, và không che những phần nằm dưới nó.
Bác nào giúp e viết lisp, khi chọn các đối tượng: khung tên, bảng thống kê vật liệu, ô chú thích thì nó tự động vẽ 1 đường bao wipeout các đối tượng này, và wipe out này nằm dưới, sau đó block các đối tượng này gồm: khung tên, bảng thống kê vật liệu....
File bản vẽ mình đây http://www.mediafire.com/?eu9b0574smv7qs4


Có ai giúp e khôôôôôôôôôôôôôôôôôôôông
  • 0

#1475 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 02 August 2010 - 05:04 PM

Ủa sao kì vậy ta
Hôm qua e đã vào trả lời rồi mà sao bài mất tiêu rồi trời ….
 E thank các a đã giúp đỡ nhiều
- Em trả lời lại câu hỏi của a Binh
+ Em sorry hôm trước nói bậy là tiếp tuyến – thật ra là pháp tuyến mới đúng ( khùng hết sức )
+ Các điểm trên đường cong e lựa chọn tùy ý ( do e tự pick )
+ Chọn đối tượng bên trái/phải là chọn hết cả lố luôn
( nâng cao thêm thì trái/phải/sole 1 trái 1 phải … là cho cả lố hết )

- Em chưa chạy thử lisp a cho nhưng thấy đã ok với những yêu cầu rồi . chỉ có điều là làm thủ công lắm hì
- Vậy nếu có thể a viết giúp e nâng cao lên như vầy nhé :
1. Sau khi tạo block , copy block tới các điểm cần bố trí trên đường cong ( tự làm )
2. Gọi lisp
3. Lisp yêu cầu chọn các đối tượng cần quay ( chọn hết block )
4. Lisp yêu cầu chọn đường cong
5. Lisp hỏi quay ( trái/phải/so le )
6. Xuất kết quả là quay hết luôn cho e cả lố 1 lần
- THANK CÁC A NHIỀU NHIỀU --- CHÚC SỨC KHỎE CÁC ANH

Chào bạn 843824,
Bạn dùng thử cái này nhé.
Lisp này yêu cầu bạn phải tự copy các block về đúng các vị trí nằm trên đường cong đã chọn. Nếu vì lý do gì đó mà cái điểm đặt của block không thuộc vào đường cong là nó sẽ chạy sai liền đó. Việc này cũng không phải hoàn toàn dễ, bạn hãy lưu ý.
Lisp này sẽ quay cái block đi một góc để trở thành trùng phương pháp tuyến của block với điều kiện góc đặt ban đầu của block phải là 0.0. Còn nếu block đã bị quay rồi (mã dxf 50 khác 0.0) thì bạn sẽ phải trừ đi cái góc quay trước của block.
Bạn cứ thử với hai trường hợp mà bạn đã post sẽ hiểu rõ hơn.
Tuy nó không hẳn như bạn yêu cầu nhưng mình nghĩ nó đáp ứng được yêu cầu của bạn nếu bạn sử dụng tốt nó. Để làm đúng như yêu cầu của bạn không phải không được nhưng nó sẽ không đáp ứng được khi việc thay đổi bên copy không phải là 1-1 liên tục. Hơn nữa do các điểm trên đường cong của bạn luôn có các phương pháp tuyến khác nhau nên không thể quay tất cả các block chỉ trong một phép quay mà vẫn bắt buộc phải quay mỗi block một nhát quay bạn ạ. Vậy nên mình mới chọn cách làm như vầy. Hề hề hề, có thể chưa hay nhưng đảm bảo xài được bạn ạ......

(defun c:idoc ()
(vl-load-com)
(command "undo" "be")
(alert "\n Chon cac block quay phai")
(setq ssb (ssget '((0 . "Insert"))))
(if (/= ssb nil)
(progn
(setq n (sslength ssb)
i 0
dc (car (entsel "\n Chon duong chuan"))
)
(While (< i n)
(setq enam (ssname ssb i)
elst (entget enam)
enp (cdr(assoc 10 elst))
a1 (vlax-curve-getdistatpoint dc enp)
par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
(if (> (cadr vtt) 0)
(setq gr (- 0 (/ pi 2)))
(setq gr (/ pi 2))
)
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(command "rotate" enam "" enp gd )
(setq i (1+ i))
)
)
)
(alert "\n Chon cac block quay trai")
(setq ssb (ssget '((0 . "Insert"))))
(if (/= ssb nil)
(progn
(setq n (sslength ssb)
i 0
dc (car (entsel "\n Chon duong chuan"))
)
(While (< i n)
(setq enam (ssname ssb i)
elst (entget enam)
enp (cdr(assoc 10 elst))
a1 (vlax-curve-getdistatpoint dc enp)
par (vlax-curve-getparamatdist dc a1)
vtt (vlax-curve-getFirstderiv dc par)
)
(if (/= (car vtt) 0)
(setq gr (atan (/ (cadr vtt) (car vtt))))
(if (> (cadr vtt) 0)
(setq gr (- 0 (/ pi 2)))
(setq gr (/ pi 2))
)
)
(if (> (car vtt) 0)
(setq gr (+ pi gr))
)
(setq gd (/ (* gr 180) pi))
(setq gd (+ 180 gd))
(command "rotate" enam "" enp gd )
(setq i (1+ i))
)
)
)
(command "undo" "e")
(princ)
)

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

#1476 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 02 August 2010 - 06:43 PM

Có ai giúp e khôôôôôôôôôôôôôôôôôôôông

Không :(
Vì làm như bạn thì thà làm 1 cái khung tên là block luôn có phải hơn không? các text cần thay đổi ở mỗi bản vẽ thì dùng đối tượng att, các vị trí cần che thì đưa luôn wipeout vào.
tương tự, các blok ghi chú cũng vậy
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#1477 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 02 August 2010 - 07:13 PM

Có ai giúp e khôôôôôôôôôôôôôôôôôôôông

Hề hề hề,
Đúng như bác ThaiStreetz đã nói, bạn đang làm một việc giống như "mua đường" vậy. Tuy nhiên có thể bạn khoái vì nhiều lý do nên mình cho bạn vay ít xìn để thuận tiện cho cái việc mua này nhé...

(defun c:blwipe ()
(command "undo" "be")
(setq en (car (entsel "\n Chon polyline khep kin"))
elst (entget en)
ptls (list)
)
(foreach ls elst
(if (= (car ls) 10)
(setq ptls (append ptls (list (cdr ls))))))
(setq ss (ssget "CP" ptls))
(command "wipeout" "" en "n")
(setq enw (entlast))
(command "draworder" enw "" "b")
(setq ss (ssadd enw ss))
(command "block" (getstring "\ Nhap ten block: ") (getpoint "\n Chon diem goc block") ss "")
(command "undo" "e")
(princ)
)

Nhớ là bạn phải tạo trước một polyline kín cho cái vùng bạn lấy làm block nhé. Có vậy mới có cái cho bạn chạy lisp, bằng không nó dễ ngoẻo lắm. Hề hề hề.....
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1478 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 02 August 2010 - 07:30 PM

Không :(
Vì làm như bạn thì thà làm 1 cái khung tên là block luôn có phải hơn không? các text cần thay đổi ở mỗi bản vẽ thì dùng đối tượng att, các vị trí cần che thì đưa luôn wipeout vào.
tương tự, các blok ghi chú cũng vậy



Nếu làm mỗi khung tên thì e nói làm gì, như ở trên e đã nói, ứng dụng cho: khung tên, bảng thống kê, các bảng ghi chú......Nói tóm lại là nhiều thứ, cần phải "front" trước các đối tượng khác
  • 0

#1479 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 02 August 2010 - 07:42 PM

Hề hề hề,
Đúng như bác ThaiStreetz đã nói, bạn đang làm một việc giống như "mua đường" vậy. Tuy nhiên có thể bạn khoái vì nhiều lý do nên mình cho bạn vay ít xìn để thuận tiện cho cái việc mua này nhé...

Nhớ là bạn phải tạo trước một polyline kín cho cái vùng bạn lấy làm block nhé. Có vậy mới có cái cho bạn chạy lisp, bằng không nó dễ ngoẻo lắm. Hề hề hề.....
Chúc bạn vui.



Như e đã nói, e muốn k chỉ ứng dụng là khung tên (att) mà còn bảng thống kê vật liệu, bảng ghi chú......
Như vậy lisp của bác không cần chọn các đối tượng, chỉ cần chọn polyline kín, nó tự hiểu những đối tượng nào nằm trong polyline là nó tự động chọn luôn đúng k bác.
Cám ơn bác nhiều.
  • 0

#1480 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 02 August 2010 - 08:07 PM

Hề hề hề,
Đúng như bác ThaiStreetz đã nói, bạn đang làm một việc giống như "mua đường" vậy. Tuy nhiên có thể bạn khoái vì nhiều lý do nên mình cho bạn vay ít xìn để thuận tiện cho cái việc mua này nhé...


(defun c:blwipe ()
(command "undo" "be")
(setq en (car (entsel "\n Chon polyline khep kin"))
elst (entget en)
ptls (list)
)
(foreach ls elst
(if (= (car ls) 10)
(setq ptls (append ptls (list (cdr ls))))))
(setq ss (ssget "CP" ptls))
(command "wipeout" "" en "n")
(setq enw (entlast))
(command "draworder" enw "" "b")
(setq ss (ssadd enw ss))
(command "block" (getstring "\ Nhap ten block: ") (getpoint "\n Chon diem goc block") ss "")
(command "undo" "e")
(princ)
)

Nhớ là bạn phải tạo trước một polyline kín cho cái vùng bạn lấy làm block nhé. Có vậy mới có cái cho bạn chạy lisp, bằng không nó dễ ngoẻo lắm. Hề hề hề.....
Chúc bạn vui.

Với lisp này bác có thể tham khảo thêm hàm (ACET-GEOM-SS-EXTENTS-FAST (ssget)) sẽ hay hơn đó bác. ta sẽ không cần thiết phải vẽ đường pline bao
hàm ACET-GEOM-SS-EXTENTS-FAST được hiểu đầy đủ như sau:
là hàm rút gọn của hàm ACET-GEOM-SS-EXTENTS. Trả về tọa độ góc trái bên dưới và góc phải bên trên của 1 tập hợp đối tượng chọn bằng (ssget)
Tham số: là tập hợp chọn bằng (ssget)
Cú pháp: (ACET-GEOM-SS-EXTENTS-FAST ss)

  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD