Lisp ghi chiều dài đoạn thẳng theo Scale factor của Dimstyle hiện thời

[Thaistreetz 539]

Em đang rất cần 1 lisp để ghi chiều dài đoạn thẳng là line hoặc chiều dài đoạn gồm cả đoạn thẳng và đoạn cong nếu là polyline, cụ thể như sau:

- command: CD

- Chọn đối tượng là polyline hoặc line cần đo kích thước.

- Ghi kết quả : 2 lựa chọn: + lựa chọn 1: chọn 1 text có truớc và ghi kích thuớc vào text đó

+ lựa chọn 2: Enter và chon điểm để lisp ghi kích thuớc bằng 1 text mới theo textstyle hiện tại

Chú ý cái này dùm em: là kết quả đuợc ghi ra theo kết quả đo của Dimstyle hiện tại (tuỳ thuộc vào Scale Factor của Dimstyle đó)

 

Ps: Công việc trên có thể thực hiện thủ công đơn giản, nhưng vì những bản vẽ của em phải lập đi lập lại công việc này rất nhiều nên em muốn nhờ các mọi người trong diễn đàn viết giúp em cái lisp. trước khi lập toppic này em cũng đã cố gắng tìm kiếm trong diễn đàn xem có lisp nào tương tự nhưng không có (or em vẫn chưa thấy :undecided: )

Thanks!

[Tue_NV 3915]

Em đang rất cần 1 lisp để ghi chiều dài đoạn thẳng là line hoặc chiều dài đoạn gồm cả đoạn thẳng và đoạn cong nếu là polyline, cụ thể như sau:

- command: CD

- Chọn đối tượng là polyline hoặc line cần đo kích thước.

- Ghi kết quả : 2 lựa chọn: + lựa chọn 1: chọn 1 text có truớc và ghi kích thuớc vào text đó

+ lựa chọn 2: Enter và chon điểm để lisp ghi kích thuớc bằng 1 text mới theo textstyle hiện tại

Chú ý cái này dùm em: là kết quả đuợc ghi ra theo kết quả đo của Dimstyle hiện tại (tuỳ thuộc vào Scale Factor của Dimstyle đó)

 

Ps: Công việc trên có thể thực hiện thủ công đơn giản, nhưng vì những bản vẽ của em phải lập đi lập lại công việc này rất nhiều nên em muốn nhờ các mọi người trong diễn đàn viết giúp em cái lisp. trước khi lập toppic này em cũng đã cố gắng tìm kiếm trong diễn đàn xem có lisp nào tương tự nhưng không có (or em vẫn chưa thấy :undecided: )

Thanks!

Bạn có thể minh hoạ bằng file dwg và có thể nói rõ hơn cái điều bạn muốn được không?

[Thaistreetz 539]

Bạn có thể minh hoạ bằng file dwg và có thể nói rõ hơn cái điều bạn muốn được không?

 

VD minh hoạ của em đây. :undecided:

Em muốn dùng lisp này để thống kê chiều dài nhiều đoạn thẳng và đoạn cong ra bảng, hoặc có thể dùng nó để ghi chú thích chiều dài cho các đoạn thẳng, đoạn cong đó

[Tue_NV 3915]

VD minh hoạ của em đây. :undecided:

Em muốn dùng lisp này để thống kê chiều dài nhiều đoạn thẳng và đoạn cong ra bảng, hoặc có thể dùng nó để ghi chú thích chiều dài cho các đoạn thẳng, đoạn cong đó

Đây là đoạn Lisp của bác ssg, mình có chỉnh lại một chút cho phù hợp với yêu cầu thứ nhất của bạn.

Riêng yêu cầu 2 trong bản vẽ bạn ghi : thực hiện lệnh, chọn đối tuong cần đo và nếu không

chọn text để gán kết quả thì Enter và pick 1 điểm trên màn hình để xuất kết quả bằng số theo style text hiện thời.

Kết quả bằng số là kết quả gì vậy bạn ? bạn hãy nói rõ.

;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)


(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
;;;--------------------------------------------------------------------

[phamthanhbinh 3147]

VD minh hoạ của em đây. :undecided:

Em muốn dùng lisp này để thống kê chiều dài nhiều đoạn thẳng và đoạn cong ra bảng, hoặc có thể dùng nó để ghi chú thích chiều dài cho các đoạn thẳng, đoạn cong đó

Chào bạn Thaistreetz,

Bạn dùng thử cái này nha:

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

 

Đoạn lisp này mình chỉnh sửa lại từ cái lisp của bác SSG và bác Tue_nv do mình nghĩ có thể bác Tue_NV hiểu nhầm ý bạn. Bạn muốn lấy các độ dài của từng đoạn chứ không phải lấy tổng độ dài, vả lại bạn cũng muốn kết quả ghi theo tỷ lệ của dimstyle hiện tại chứ không phải là kết quả đo được nữa. Ở lisp này mình cũng để bạn chọn phương án nhap kết quả , nhưng bạn lưu ý là khi lisp hỏi bạn chỉ cần gõ 1 hoặc enter là đủ bạn nhé. Bạn xài thử xem nhé. Nếu có gì trục trặc xin báo lại vì mình cũng chưa kiểm nghiệm nó do chưa có thời gian bạn ạ. Thực ra mình cũng chưa ưng ý với lisp này do nếu như bạn chọn khá nhiều đối tượng thì việc nhớ được trật tự khi lựa chọn đối tượng không hề dễ. Theo ý mình thì nên mỗi lần chỉ chọn một đối tượng và sau khi chạy xong thi lisp sẽ hỏi bạn có muốn tiếp tục hay không, nếu có thì chọn đối tượng tiếp, còn nếu không thì kết thúc sẽ thuận lợi cho việc chỉnh sửa trên bản vẽ của bạn hơn.

Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.

Chúc bạn vui.

 

@ Bác Tue_NV: Mạn phép bác sửa lại chút xíu cái lisp của bác cho gần với yêu cầu của bạn Thaistreetz hơn. Mong bác không giận.

[Thaistreetz 539]

Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.

Chúc bạn vui.

Truớc tiên em rất cảm ơn bác Tue_NV và bạn phamthanhbinh vì đã nhiệt tình giúp đỡ em.

Lisp của bạn thật tuyệt vời bạn phamthanhbinh ạ. Nó chính xác là những gì mình cần. Thực ra khi bạn để chức năng chọn một lần nhiều đối tượng là một ý tưởng rất hay mà chính bản thân mình là người đặt vấn đề cũng không nghĩ tới. Dùng chức năng này để chọn cùng một lúc nhiều đối tuợng có cùng tính chất hay cùng một nhóm (một tập hợp các đường song song chẳng hạn), như thế việc nhớ thứ tự cũng không khó mà công việc sẽ đuợc giải quyết nhanh hơn rất nhiều. Mình rất thích ý tưởng này của bạn. Và Lisp của bạn như thế cũng không cần phải chỉnh thêm gì nữa rồi. Một lần nữa rất cảm ơn bạn đã nhiệt tình giúp đỡ. :undecided:

[huyhai 0]

Cảm ơn các bạn đã viết và tổng hợp những lisp cho anh em dùng.

[dragontalon0802 4]

Hi!

Em đang mò mẫm thì vớ được cái lisp này như chết đuối vớ được cọc!!!

Thanks các bác nhiều!!!!!!

[hoàngbìnhan 24]

Chức năng thứ 2 sao em làm không được nhỉ? Em dùng CAD 2007.

[funnyzui 1]

Chào bạn Thaistreetz,

Bạn dùng thử cái này nha:

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

 

Đoạn lisp này mình chỉnh sửa lại từ cái lisp của bác SSG và bác Tue_nv do mình nghĩ có thể bác Tue_NV hiểu nhầm ý bạn. Bạn muốn lấy các độ dài của từng đoạn chứ không phải lấy tổng độ dài, vả lại bạn cũng muốn kết quả ghi theo tỷ lệ của dimstyle hiện tại chứ không phải là kết quả đo được nữa. Ở lisp này mình cũng để bạn chọn phương án nhap kết quả , nhưng bạn lưu ý là khi lisp hỏi bạn chỉ cần gõ 1 hoặc enter là đủ bạn nhé. Bạn xài thử xem nhé. Nếu có gì trục trặc xin báo lại vì mình cũng chưa kiểm nghiệm nó do chưa có thời gian bạn ạ. Thực ra mình cũng chưa ưng ý với lisp này do nếu như bạn chọn khá nhiều đối tượng thì việc nhớ được trật tự khi lựa chọn đối tượng không hề dễ. Theo ý mình thì nên mỗi lần chỉ chọn một đối tượng và sau khi chạy xong thi lisp sẽ hỏi bạn có muốn tiếp tục hay không, nếu có thì chọn đối tượng tiếp, còn nếu không thì kết thúc sẽ thuận lợi cho việc chỉnh sửa trên bản vẽ của bạn hơn.

Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.

Chúc bạn vui.

 

@ Bác Tue_NV: Mạn phép bác sửa lại chút xíu cái lisp của bác cho gần với yêu cầu của bạn Thaistreetz hơn. Mong bác không giận.

 

Bác Tue_NV và bác phamthanhbinh có thể chỉnh sửa lisp này giúp funnyzui theo hướng: tính chiều dài từng đoạn thẳng mình pick rồi xuất ra file text (*.txt) được không? tất nhiên là theo thứ tự mình pick rồi.

[tski259 10]

Hi.Vào Cadviet mới học hỏi được nhiều điều.Nhưng có nhiều cái mình dựa vào đó để cải tiến thành của mình.Chứ sử dụng nguyên xi thì ko tiện cho lắm(Đối với bản thân mình).

;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
;;;--------------------------------------------------------------------

Lisp này có nhược điểm là ko tính được với tỉ lệ bản vẽ.Chỉ đúng với tỉ lệ 1/1.

 

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

Cái này tính đúng với tỉ lệ bản vẽ nhưng chỉ tính với 1 đường độc lập.Giả sử có đoạn kè gồm nhiều phân đoạn độc lập thì tính cũng ko tiện cho lắm.Mình xin cải tiến chút.Cái phần thay thế vào text có sẵn mình bỏ luôn.Có chi dùng lệnh Ma đưa về text mình cần được mà.Ko thì dùng lisp thay thế text để đưa vào bảng cũng được vậy.Mà cứ gõ liên tục thấy cũng ko tiện lắm nữa chứ.Có chi xin mọi người thứ lỗi nha.

;-----------------------tinh chieu dai duong thang theo ti le hien hanh ( tl )----------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(setq L1 (* k L))
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(command "text" p 2.5 "0" (rtos L1 2 2))
)
)
(ssdel e ss)
)
(princ)
)

[ketxu 2999]

Rất vui vì bạn đã điều chỉnh được những thứ có sẵn để phục vụ công việc của mình, mặc dù đoạn lisp hơi lộ cộ 1 chút, n hok sao..Chúc bạn có những thành công kế tiếp :)

[tski259 10]

Mình mới nc về autolisp thôi nên chưa hiểu rõ lắm.Chỉ toàn là chỉnh sửa của người khác sao cho phù hợp với công việc của mình ấy mà.Hi.Có gì bữa nào mình sẽ gửi lên những cái mình đã chỉnh sửa nha.Thấy tiện cho công việc thiết kế của mình thôi.Chúc cả nhà vui vẻ.

[843824 1]

Pro ơi - Sẵn cho thằng em nhờ luôn thế này ạ :

 

- A giúp e sữa lại lisp trên bổ sung thêm :

 

Khi chọn các đối tuợng để đo chiều dài ( ở đây nếu là các đuờng arc , pl ... theo các thứ tự không rõ ràng thì chắc khó )

 

Nên e chỉ nhờ là với đối tuợng các line thẳng và song song nhau ( nếu nâng cao đuợc nữa là nếu có xéo thì cũng không cắt nhau thôi )

Nhưng là chọn 1 lúc nhiều đối tuợng line .

Cách chọn : 1 là quét chuột từ trái qua phải hoặc từ trên xuống duới .

2 là click chọn các line muốn đo .

Lisp sẽ nhớ luôn thứ tự của các line này .

Nếu theo cách chọn 1 thì : Line đầu tiên bên trái hoặc trên cùng là 1 rồi tới 2 , 3 ...

2 thì : Đuơng nhiên là nhớ theo thứ tự click chọn

 

Sau đó xuất ra 1 table trong CAD có 2 cột : STT và Chiều dài .( Font VNI-Helve luôn cho sang )

Anh cho thêm nhập chiều cao text xuất ra trong table càng tốt ạ.

[tski259 10]

Pro ơi - Sẵn cho thằng em nhờ luôn thế này ạ :

 

- A giúp e sữa lại lisp trên bổ sung thêm :

 

Khi chọn các đối tuợng để đo chiều dài ( ở đây nếu là các đuờng arc , pl ... theo các thứ tự không rõ ràng thì chắc khó )

 

Nên e chỉ nhờ là với đối tuợng các line thẳng và song song nhau ( nếu nâng cao đuợc nữa là nếu có xéo thì cũng không cắt nhau thôi )

Nhưng là chọn 1 lúc nhiều đối tuợng line .

Cách chọn : 1 là quét chuột từ trái qua phải hoặc từ trên xuống duới .

2 là click chọn các line muốn đo .

Lisp sẽ nhớ luôn thứ tự của các line này .

Nếu theo cách chọn 1 thì : Line đầu tiên bên trái hoặc trên cùng là 1 rồi tới 2 , 3 ...

2 thì : Đuơng nhiên là nhớ theo thứ tự click chọn

 

Sau đó xuất ra 1 table trong CAD có 2 cột : STT và Chiều dài .( Font VNI-Helve luôn cho sang )

Anh cho thêm nhập chiều cao text xuất ra trong table càng tốt ạ.

 

Hi.Mình ko biết bạn nhờ như vậy có mục đích gì vây?.Mình ko nghĩ là nó có ứng dụng thực tế nó như thế nào nữa.Nếu nó có ứng dụng thực tế thì có lẽ sẽ ko thiếu người giúp bạn đâu.

[843824 1]

À - có ứng dụng thực tế chứ anh.

 

Công việc mỗi nguời mỗi khác mà.

Với lại mình dùng kết quả này làm đệm cho một vài thao tác khác nữa sau đó .

 

=> Để có đuợc kết quả có vẻ giải quyết nhanh 1 bài toán mình nghĩ ra .

Thanks pro đã quan tâm

[ketxu 2999]

Bạn thử dùng cái TCD này xem sao, độ lại từ tính Area của bác Đường Thái, mìn make từ lâu r, k biết code nó đâu nữa ^^

P/s : chỉ thực hiện đc theo cách chọn 2 thôi. Hồi trước mình chưa kiểm soát được thứ tự Selection, hay theo x, hay theo Y, nên để kích chọn là chắc ăn

TCD

[843824 1]

Ô - Thanks a ketxu .

Đáp ứng đuợc yêu cầu của e rồi . Thôi ráng click chọn vậy. Hà hà.

 

Sẵn tiện a quảng cáo - a cho e xin luôn cái lisp của pro Đuờng Thái luôn được không ?

Hà hà

[Thaistreetz 539]

topic của mình đây mà. cũng là bài viết thứ 2 trên cadviet của mình. hồi đó đuợc bác PhamThanhBinh viết cho cái lisp này mừng cả 1 ngày.

Mình sửa lại 1 chút lisp của bác Bình cho fù hợp với nhu cầu của bạn đây.

(defun C:TL( / Length1 SSdelete MakePoint GET-M2P MakeText
HT I K LST LST1 LSTL LSTP OSMLAST OTHLAST PT PT0 PT1 SS SSMOVE SSNX SSP TBSS)
(vl-load-com)
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst))
(defun SSdelete (SS / )	(setq SS (acet-ss-to-list SS))(foreach SSN SS (entdel SSN)))
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun GET-M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end
(defun MakePoint (point layer color)
(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbPoint")(cons 10 point))))
(setq lst '() lst1 '() lstL '() k (getvar "dimlfac") ssmove (ssadd))
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))) i 0)
(repeat (sslength ss)
(if (= 1 (car (setq ssnx (car(ssnamex ss i)))))
(if lst1(progn
(setq ssp (ssadd))
(foreach ssn lst1	(setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))
(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)
(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(< (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(> (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))) ;;; cot
(setq lst (append (list (cadr ssnx)) lst1) lst1 '()))
(setq lst (append (list (cadr ssnx)) lst)))
(setq lst1 (append (list (cadr ssnx)) lst1)))
(setq i (1+ i)))
(if lst1 (progn
(setq ssp (ssadd))
(foreach ssn lst1	(setq ssp(ssadd(MakePoint(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS ssn)))(cadr lstp))nil 250)ssp)))
(setq tbss (ACET-GEOM-SS-EXTENTS-FAST ssp))(ssdelete ssp)
(if (>(abs(-(car(car tbss))(car(cadr tbss))))(abs(-(cadr(car tbss))(cadr(cadr tbss)))))
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(> (car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(car (get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp))))))) ;;; hang
(setq lst1 (vl-sort lst1 '(lambda (e1 e2)
(< (cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e1)))(cadr lstp)))
(cadr(get-m2p(car(setq lstp(ACET-GEOM-EXTENTS e2)))(cadr lstp)))))))))) ;;; cot
(if (setq lst(append lst1 lst)) (progn
(setq ht (getreal "nhap chieu cao text: ") pt (cadr (grread 't 15 0)) pt0 pt i 0)	
(foreach ll (reverse lst)
(setq ssmove (ssadd (maketext pt (itoa(setq i (1+ i))) ht 0 "C" nil nil nil nil) ssmove)
ssmove (ssadd (maketext (polar pt 0 (* 5 ht)) (rtos (* k(length1 ll)) 2 3) ht 0 "R" nil nil nil nil) ssmove)
pt (list (car pt) (- (cadr pt) (* 1.5 ht)))))
(acet-ss-redraw ssmove 2)
(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
(if (setq pt1 (acet-ss-drag-move ssmove pt0 "\nChon diem dat bang"))
(progn (vl-cmdf "move" ssmove "" pt0 pt1) (setvar "orthomode" OTHLAST))
(ssdelete ssmove))))
(print "free lisp from cadviet.com") (princ))

Bạn chú ý:

- sau khi gõ lệnh bạn có thể chon theo cả 2 cách như bạn yêu cầu. nghĩa là bạn có thể chọn kiểu như thế này: ...chọn 1 tập hợp -> rồi pick...pick -> rồi lại chọn tập hợp -> rồi lại pick pick...rồi...rồi...

- Chương trình sẽ tự nhận diện tập hợp đối tượng của bạn, nhóm đối tượng nào chọn trước, nhóm đối tượng nào chọn sau, các phần tử trong 1 tập hợp là hàng hay là cột để tự sắp xếp theo X hoặc Y.

- mình ngại kẻ bảng nên kết quả nhìn hơi xấu. thôi, cái này bạn tự làm đê.

@Ketxu: ai lại dich tên tớ thế <_<. dịch là Thái bụi cậu ạ :lol:

[ketxu 2999]

Hề hề ^^ E dịch thế nghe cho nó Ái ^^ ..Bác xem thế nào add luôn hàm maketext vào giúp bạn ấy nữa đi ^^

[Thaistreetz 539]

đã edit. cảm ơn ketxu đã test hộ tớ

[843824 1]

Ô - thanks các pro trước hé .

 

Giờ e chưa về tới nhà nên chưa test đc - Nhưng mà chắc ok rồi đây . Hà hà.

[trieubb 5]

 

Chào bạn Thaistreetz,

Bạn dùng thử cái này nha:

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

Đoạn lisp này mình chỉnh sửa lại từ cái lisp của bác SSG và bác Tue_nv do mình nghĩ có thể bác Tue_NV hiểu nhầm ý bạn. Bạn muốn lấy các độ dài của từng đoạn chứ không phải lấy tổng độ dài, vả lại bạn cũng muốn kết quả ghi theo tỷ lệ của dimstyle hiện tại chứ không phải là kết quả đo được nữa. Ở lisp này mình cũng để bạn chọn phương án nhap kết quả , nhưng bạn lưu ý là khi lisp hỏi bạn chỉ cần gõ 1 hoặc enter là đủ bạn nhé. Bạn xài thử xem nhé. Nếu có gì trục trặc xin báo lại vì mình cũng chưa kiểm nghiệm nó do chưa có thời gian bạn ạ. Thực ra mình cũng chưa ưng ý với lisp này do nếu như bạn chọn khá nhiều đối tượng thì việc nhớ được trật tự khi lựa chọn đối tượng không hề dễ. Theo ý mình thì nên mỗi lần chỉ chọn một đối tượng và sau khi chạy xong thi lisp sẽ hỏi bạn có muốn tiếp tục hay không, nếu có thì chọn đối tượng tiếp, còn nếu không thì kết thúc sẽ thuận lợi cho việc chỉnh sửa trên bản vẽ của bạn hơn.

Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.

Chúc bạn vui.

 

@ Bác Tue_NV: Mạn phép bác sửa lại chút xíu cái lisp của bác cho gần với yêu cầu của bạn Thaistreetz hơn. Mong bác không giận.

Bác viết thêm là thể hiện thứ tự các đoạn cần điền chiều dài (theo thứ tự mà lisp nhận được) chứ không biết đâu mà ghi chiều dài được bác ạ. Mong bác giúp đỡ

[unbroken 0]

Bác tue viết lisp đó gần hợp với cái mà em cần. ai đó có thể sửa 1 chút đi giúp em được không. em muốn text hiển thị nằng trên đoạn thẳng được pick bởi 2 điểm.Với tỷ lệ chiểu cao text như dimension hiện tại.( còn nếu giá trị của text mà được như tỷ lệ scale của dim hiện tại thì càng tốt)!!

[thienthantk103 0]

 

Đây là đoạn Lisp của bác ssg, mình có chỉnh lại một chút cho phù hợp với yêu cầu thứ nhất của bạn.

Riêng yêu cầu 2 trong bản vẽ bạn ghi : thực hiện lệnh, chọn đối tuong cần đo và nếu không

chọn text để gán kết quả thì Enter và pick 1 điểm trên màn hình để xuất kết quả bằng số theo style text hiện thời.

Kết quả bằng số là kết quả gì vậy bạn ? bạn hãy nói rõ.

;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)


(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
;;;--------------------------------------------------------------------

Cái lisp này có thể thêm phần đổi màu chữ của text được chọn không ạ.

Xin cảm ơn