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

[phamthanhbinh 3.146]

Xin lỗi e spam chút xíu :

Các anh ơi … có ai xem giúp e cái lisp e xin ở trên với ạ.

 

Với thêm nếu cái đó chưa thể viết ngay được các a cho e xin cái lisp như vầy :

- Input : có đường cong bất kì và 1 block

- Các a giúp e viết cái lisp nào mà sau khi e copy cái block đó đến các điểm trên đường cong thì block đó sẽ tự động quay theo phương tiếp tuyến với đường cong tại điểm đó.

Nếu có thể : nâng cao lên : hỏi xem quay block đó về bên trái hay bên phải của đường cong

 

Thank các a rất nhiều – vì hiện giờ e phải copy rất nhiều cái như vậy và quay từng cái theo phương tiếp tuyến . Hoặc có cách nào khác ko cần lisp xin các a chỉ dạy ạ.

Chào bạn 843824,

Cái vụ lisp copy, move , rotate đối tượng này trên diễn đàn có hà rầm lisp rồi bạn ạ, bạn chịu khó tìm kiếm và đọc một chút có thể sẽ có được cái mà bạn cần. Bằng không nếu như bạn có thể thì hãy cải tạo chúng theo hướng bạn cần, nếu có khó khăn trong việc này thì hãy post lên cái chỗ khó ấy mọi người sẽ góp ý. Còn nếu bạn muốn viết lisp cho riêng yêu cầu của bạn thì phải có bản vẽ cụ thể thể hiện tình trạng trước và sau khi dùng lisp, khi đó may ra mới có người có thể giúp bạn được. Nói khơi khơi kiểu này e rằng bạn phải chờ đến Tết Công gô vì chả ai hiểu bạn cần thế nào. Hì hục làm xong bạn lại bảo chả phải cái ấy thì ....... hoặc giả bạn lại đẻ ra thêm vài cái muốn nữa thì ......

[Phiphi- 176]

Thank you.

[tdkhoa 0]

Nhờ các bạn viết dùm mình lip đưa các toạ độ GPS lên bản đồ được không ạ. Mình mới tập làm quen với CAD nên không biết gì, thấy mấy anh bạn làm về bản đồ có lip đó nhưng xin họ không cho.

[romeo1982 19]

Nhờ bác nào sửa dùm cái líp này giúp mình với:

 

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

P2 (list (+ (car PT)(* 22 h)) (cadr PT))

P3 (list (car PT) (- (cadr PT)(* 3 h)))

P4 (list (car P1) (cadr P3))

P5 (list (car P2) (cadr P3))

P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))

P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

);setq

(command "pline" PT P2 P5 P3 "C"

"pline" P1 P4 ""

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

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

P2 (list (+ (car PT)(* 22 h)) (cadr PT))

P3 (list (car PT) (- (cadr PT)(* 3 h)))

P4 (list (car P1) (cadr P3))

P5 (list (car P2) (cadr P3))

P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

P9 (list (car PT) (- (cadr P3)(* 3 h)))

P10 (list (car P1) (cadr P9))

P11 (list (car P2) (cadr P9))

P12 (list (car P7) (- (cadr P3)(* 1.5 h)))

P13 (list (car P8) (cadr P12))

);setq

(command "CECOLOR" 4 "-boundary" pt1 "" )

(setvar "CECOLOR" lacol)

(setq et (entlast))

(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 "pline" PT P2 P5 P3 "C"

"pline" P1 P4 ""

"text" "m" P7 h 0 (rtos k 2 0)

"text" "m" P8 h 0 (rtos dtcon 2 2))

 

(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 ""

"text" "m" P12 h 0 "Tæng"

"text" "m" P13 h 0 (rtos tdt 2 2)

);command

(setvar "OSMODE" laos)

(setvar "cmdecho" 1)

)

 

Líp xài rất tốt nhưng mình muốn thệm 1 cột nữa ở giữa đặt là TÊN CT, sau khi pick xong tất cả text trong vùng pick sẽ được thể hiện trong cột này .Chú ý là tất cả text đều xài DT, nếu có 2 DT khác nhau trong cùng 1 vùng pick thì để 2 DT ngang nhau đừng nối lại nhé, vì công việc của mình phải thống kê hàng ngàn cái như vậy nên rất mong các cao thủ giúp đỡ, cám ơn

[phamthanhbinh 3.146]

Nhờ bác nào sửa dùm cái líp này giúp mình với:

Líp xài rất tốt nhưng mình muốn thệm 1 cột nữa ở giữa đặt là TÊN CT, sau khi pick xong tất cả text trong vùng pick sẽ được thể hiện trong cột này .Chú ý là tất cả text đều xài DT, nếu có 2 DT khác nhau trong cùng 1 vùng pick thì để 2 DT ngang nhau đừng nối lại nhé, vì công việc của mình phải thống kê hàng ngàn cái như vậy nên rất mong các cao thủ giúp đỡ, cám ơn

Chào bạn romeo1982,

Việc bổ sung cột TEN CT vào trong đoạn lisp trên không khó nhưng mình chưa hiểu bạn sẽ dùng cột này làm gì??? Bạn chưa hề cho biết cái bạn sẽ ghi cái gì vào trong cột này khi bạn chọn một vùng cần lấy diện tích.

Việc bạn nói trong một vùng có hai diện tích nghĩa là sao, mình chưa hiểu vì theo như lisp bạn post thì khi bạn pick điểm vào một vùng kín nào đó lisp sẽ tự tạo ra một boundary duy nhất, và lấy diện tích của vùng được boundary này. Do vậy nó phải là duy nhất chứ sao lại có hai diện tích được???

Mong bạn trả lời rõ mới có thể giúp bạn được....

Tốt nhất bạn nên pót một bản vẽ thể hiện cái bạn đã có và cái bạn cần sẽ dễ hiểu hơn bạn ạ.

[romeo1982 19]

Chào bạn romeo1982,

Việc bổ sung cột TEN CT vào trong đoạn lisp trên không khó nhưng mình chưa hiểu bạn sẽ dùng cột này làm gì??? Bạn chưa hề cho biết cái bạn sẽ ghi cái gì vào trong cột này khi bạn chọn một vùng cần lấy diện tích.

Việc bạn nói trong một vùng có hai diện tích nghĩa là sao, mình chưa hiểu vì theo như lisp bạn post thì khi bạn pick điểm vào một vùng kín nào đó lisp sẽ tự tạo ra một boundary duy nhất, và lấy diện tích của vùng được boundary này. Do vậy nó phải là duy nhất chứ sao lại có hai diện tích được???

Mong bạn trả lời rõ mới có thể giúp bạn được....

Tốt nhất bạn nên pót một bản vẽ thể hiện cái bạn đã có và cái bạn cần sẽ dễ hiểu hơn bạn ạ.

Trước hết cám ơn bác đã quan tâm, mình xin lỗi vì đã đánh lộn làm bác ko hiểu, DT là DText đó bác ah, có nghĩa là trong vùng pick có thể có từ 2 text trở lên thì mình lấy luôn 2 text đó, còn text nằm nữa trong nữa ngoài vùng pick thì lấy luôn nha bác. Chúc bác luôn vui khỏe

[romeo1982 19]

Trước hết cám ơn bác đã quan tâm, mình xin lỗi vì đã đánh lộn làm bác ko hiểu, DT là DText đó bác ah, có nghĩa là trong vùng pick có thể có từ 2 text trở lên thì mình lấy luôn 2 text đó, còn text nằm nữa trong nữa ngoài vùng pick thì lấy luôn nha bác. Chúc bác luôn vui khỏe

Quên, cái cột mới làm sẽ ghi những cái text trong vùng pick

[843824 1]

Dạ xin cảm ơn anh Phamthanhbinh …

 

http://www.mediafire.com/?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.

[phamthanhbinh 3.146]

Quên, cái cột mới làm sẽ ghi những cái text trong vùng pick

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é.

[phamthanhbinh 3.146]

Dạ xin cảm ơn anh Phamthanhbinh …

 

http://www.mediafire.com/?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.

Hì hì hì,

Cad2004 của mình không mở được file bạn gửi. Thật tiếc ....

[hoan2182 842]

Hì hì hì,

http://www.cadviet.com/upfiles/3/nho_b%E1c...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.com/upfiles/3/nho_b%E1c...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ề, ...

[romeo1982 19]

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

[phamthanhbinh 3.146]

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/"))
caot1 (getreal (strcat "\nCao text : ")))
(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 (	(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.

[phamthanhbinh 3.146]

Em chuyển nó về Cad2004:

http://www.cadviet.com/upfiles/3/nho_b%E1c...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ì,....

[Tue_NV 3.912]

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ì,.... :(

[phamthanhbinh 3.146]

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/"))
caot1 (getreal (strcat "\nCao text : ")))
(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 ((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)
)

[phamthanhbinh 3.146]

Dạ xin cảm ơn anh Phamthanhbinh …

 

http://www.mediafire.com/?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,..

[phamthanhbinh 3.146]

Dạ xin cảm ơn anh Phamthanhbinh …

 

http://www.mediafire.com/?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.

[Sony2007 86]

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

[gia_bach 1.549]

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.

[nataca 554]

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 ạ

[gia_bach 1.549]

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!

[843824 1]

Ủ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

[Sony2007 86]

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

[phamthanhbinh 3.146]

Ủ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 (      (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 (      (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,