Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa]Đo chiều dài và ghi ra text


  • Please log in to reply
34 replies to this topic

#1 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 30 November 2011 - 06:41 PM

Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp cv.Khi chạy lisp yêu cầu chọn phương án nhập kết quả:
1-Chọn điểm để nhập kết quả thì e muốn text ra là Style hiện hành, chiều cao là 200 và text ghi ra sẽ có dạng L= ???
2-Chọn text để gán kết quả thì cũng có dạng như trên
Két thúc lệnh.
Thanhks các Pro nhiều!!

Lisp đó đây ạh!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=9681
(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)
)
;;;--------------------------------------------------------------------

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 November 2011 - 08:43 PM

Quick code lại :

(defun C:TL( / ss L e #h)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 1))
(setq
#h 200
L (strcat "L : "
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
)))
)
ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
txtObj (cond ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
(T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
)
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)

  • 2

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


#3 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 01 December 2011 - 06:13 PM

Quick code lại :


(defun C:TL( / ss L e #h)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 1))
(setq
#h 200
L (strcat "L : "
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
)))
)
ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
txtObj (cond ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
(T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
)
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)


Thanks bác Ketxu nhiều nha!Lisp chạy chuẩn rồi ạh!Bác cho e hỏi thêm vấn đề nhỏ này nữa nhé.Nếu mình muốn thêm đơn vị (mm) thì sẽ sửa như thế nào ạ.Xin bác chỉ giáo thêm!Chúc bác vui!
  • 1

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 December 2011 - 08:24 PM

Bạn tìm đến đoạn
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
)))


rồi thêm bất kỳ gì bạn muốn vào đằng sau dấu ))). Ví dụ trường hợp của bạn là
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
))) " mm"
  • 2

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


#5 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 01 December 2011 - 09:31 PM

Bạn tìm đến đoạn
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
)))

rồi thêm bất kỳ gì bạn muốn vào đằng sau dấu ))). Ví dụ trường hợp của bạn là
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
))) " mm"


Tuyệt!Hi vọng sẽ còn được bác ketxu và các pro giúp đỡ nhiều!
  • 0

#6 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 05 December 2011 - 10:30 AM

Quick code lại :


(defun C:TL( / ss L e #h)
(vl-load-com)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(or ans (setq ans 1))
(setq
#h 200
L (strcat "L : "
(vl-princ-to-string (* (getvar "dimlfac") (apply '+
(mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
)))
)
ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
txtObj (cond ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
(T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
)
)
(vla-put-TextString txtObj L)
(vla-put-Height txtObj #h)
(princ)
)


Các bạn ơi giúp mình với: Có thể giúp mình chỉnh sửa lisp thống kê chiều dài và xuất ra text trên theo cách sau không?

- Khi Cick vào chọn đối tượng lần lượt và sau khi hoàn tất việc chọn đối tượng thì xuất chiều dài đối tượng đó ra bảng theo 2 cách: xuất trong CAD và xuất ra file excel với thứ tự sẽ được liệt kê từ đối tượng được chọn đầu tiên cho đến đối tượng được chọn cuối cùng.

Cám ơn các bạn nhiều!
  • 0

#7 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 05 December 2011 - 03:51 PM


Các bạn ơi giúp mình với: Có thể giúp mình chỉnh sửa lisp thống kê chiều dài và xuất ra text trên theo cách sau không?

- Khi Cick vào chọn đối tượng lần lượt và sau khi hoàn tất việc chọn đối tượng thì xuất chiều dài đối tượng đó ra bảng theo 2 cách: xuất trong CAD và xuất ra file excel với thứ tự sẽ được liệt kê từ đối tượng được chọn đầu tiên cho đến đối tượng được chọn cuối cùng.

Cám ơn các bạn nhiều!

Hề hề hề,
Làm theo yêu cầu của bạn chả khó lắm nhưng ......Tốt nhất là bạn gửi cái bảng mẫu mà bạn muốn thể hiện lên chứ nói xuông khó làm lắm. Tỷ như cái text trong lisp của bác Ketxu sẽ có chiều cao text là 200 mà bạn lại muốn cái text chỉ cao có 2 thì sao??? Lại còn mối tương quan giữa các dòng và cột trong bảng nữa, Text trong bảng bạn khoái là text hay mtext, font chữ là font gì ......
Túm lại là cứ gửi cái bảng mẫu lên để mọi người đỡ phải làm đi làm lại...
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.

#8 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 06 December 2011 - 01:49 PM

Hề hề hề,
Làm theo yêu cầu của bạn chả khó lắm nhưng ......Tốt nhất là bạn gửi cái bảng mẫu mà bạn muốn thể hiện lên chứ nói xuông khó làm lắm. Tỷ như cái text trong lisp của bác Ketxu sẽ có chiều cao text là 200 mà bạn lại muốn cái text chỉ cao có 2 thì sao??? Lại còn mối tương quan giữa các dòng và cột trong bảng nữa, Text trong bảng bạn khoái là text hay mtext, font chữ là font gì ......
Túm lại là cứ gửi cái bảng mẫu lên để mọi người đỡ phải làm đi làm lại...
Hề hề hề,

Mình cám ơn tất cả các bạn đã quan tâm, mình xin gửi file CAD thể hiện rõ yêu cầu
Các bạn xem như trong file mình đã viết nhé:
Link file yêu cầu: http://www.mediafire...l7furxc3t5wlgbc
Nhờ các cao thủ giúp viết lisp giúp

Thanks all!
  • 0

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 06 December 2011 - 07:52 PM

Mình cám ơn tất cả các bạn đã quan tâm, mình xin gửi file CAD thể hiện rõ yêu cầu Các bạn xem như trong file mình đã viết nhé: Link file yêu cầu: http://www.mediafire...l7furxc3t5wlgbc Nhờ các cao thủ giúp viết lisp giúp Thanks all!

Hề hề hề,
Không biết cái này đã vừa ý bạn chưa?? Cần nhắc lại để bạn nhớ là cái yêu cầu của bạn hoàn toàn khác với yêu cầu của bạn chủ thớt nên mình không thể cải chỉnh cái lisp của bác Ketxu cho bạn mà phải cấu trúc lại lisp mới. nếu bạn không post file dwg lên thì chắc hẳn sẽ có nhiều người lầm lẫn và sẽ phải làm đi làm lại mà vẫn không thể như ý bạn được. bạn hãy rút kinh nghiệm cho các lần post bài sau nhé.
Chúc bạn vui.
Đây là code:


(defun c:btk ( / plst e p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 n i obj els pa pf ps len txt fn fw ans)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq plst (list) i 0)
(alert "\n Chon cac doan can thong ke")
(setq e (entsel "\n Chon doan can thong ke"))
(While e
(setq plst (cons e plst)
e (entsel "\n Chon doan tiep theo")
)
)
(setq plst (reverse plst))
(setq p1 (getpoint "\n Chon diem dat bang thong ke")
p2 (polar p1 0 2.5)
p3 (polar p2 0 5.5)
p4 (polar p3 0 5.5)
p5 (polar p4 0 5.5)
n (length plst)
p6 (polar p1 (* 1.5 pi) (* (1+ n) 1.5))
p7 (polar p2 (* 1.5 pi) (* (1+ n) 1.5))
p8 (polar p3 (* 1.5 pi) (* (1+ n) 1.5))
p9 (polar p4 (* 1.5 pi) (* (1+ n) 1.5))
p10 (polar p5 (* 1.5 pi) (* (1+ n) 1.5))
)
(command "line" p1 p5 p10 p6 p1 "")
(command "line" p2 p7 "")
(command "line" p3 p8 "")
(command "line" p4 p9 "")
(styleset)
(command "text" "j" "mc" (list (+ (car p1) 1.25) (- (cadr p1) 0.75)) 0.3 0 "TT &#208;O\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI &#208;I\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U D&#192;I")
(command "text" "j" "mc" (list (+ (car p1) 9.5) (+ (cadr p1) 0.5 )) 0.5 0 "B\\U+1EA2NG XU\\U+1EA4T RA K\\U+1EBET QU\\U+1EA2")
(setq ans (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: "))
(if (= (strcase ans) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
)
)
(foreach a plst
(setq i (1+ i)
obj (vlax-ename->vla-object (car a))
els (entget (car a))
p0 (polar p1 (* 1.5 pi) 1.5)
p1 p0
)
(cond
( (or (= (cdr (assoc 0 els)) "LWPOLYLINE") (= (cdr (assoc 0 els)) "POLYLINE"))
(setq pa (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj (cadr a)))
pf (vlax-curve-getpointatparam obj (fix pa))
ps (vlax-curve-getpointatparam obj (1+ (fix pa)))
len (- (vlax-curve-getdistatpoint obj ps) (vlax-curve-getdistatpoint obj pf))
) )
( (= (cdr (assoc 0 els)) "LINE")
(setq pf (cdr (assoc 10 els))
ps (cdr (assoc 11 els))
len (distance pf ps)
) )
( (or (= (cdr (assoc 0 els)) "SPLINE") (= (cdr (assoc 0 els)) "ARC") )
(setq pf (vlax-curve-getstartpoint obj)
ps (vlax-curve-getendpoint obj)
len (vlax-curve-getdistatpoint obj ps)
) )
(T nil)
)
(setq txt (strcat (rtos i 2 0) "," "X=" (rtos (car pf) 2 4) " Y=" (rtos (cadr pf) 2 4) "," "X=" (rtos (car ps) 2 4) " Y=" (rtos (cadr ps) 2 4) "," (rtos len 2 4) "\n"))
(command "line" p0 (polar p0 0 19) "")
(command "text" "j" "mc" (list (+ (car p0) 1.25) (- (cadr p0) 0.75)) 0.2 0 (rtos i 2 0) )
(command "text" "j" "mc" (list (+ (car p0) 5.25) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car pf) 2 4) " Y=" (rtos (cadr pf) 2 4)) )
(command "text" "j" "mc" (list (+ (car p0) 10.75) (- (cadr p1) 0.75)) 0.2 0 (strcat "X=" (rtos (car ps) 2 4) " Y=" (rtos (cadr ps) 2 4)) )
(command "text" "j" "mc" (list (+ (car p0) 16.25) (- (cadr p1) 0.75)) 0.2 0 (rtos len 2 4))
(if (= (strcase ans) "Y")
(princ txt fw)
)
)
(if fw
(close fw)
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

(defun styleset ()
(setq stl (getvar "textstyle")
h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)
Hề hề hề.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 07 December 2011 - 01:45 PM
Sửa lỗi lisp theo góp ý của bác Giabach

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

#10 sumi

sumi

    biết lệnh array

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

Đã gửi 06 December 2011 - 10:08 PM

Hề hề hề,
Không biết cái này đã vừa ý bạn chưa?? Cần nhắc lại để bạn nhớ là cái yêu cầu của bạn hoàn toàn khác với yêu cầu của bạn chủ thớt nên mình không thể cải chỉnh cái lisp của bác Ketxu cho bạn mà phải cấu trúc lại lisp mới. nếu bạn không post file dwg lên thì chắc hẳn sẽ có nhiều người lầm lẫn và sẽ phải làm đi làm lại mà vẫn không thể như ý bạn được. bạn hãy rút kinh nghiệm cho các lần post bài sau nhé.
Chúc bạn vui.
Đây là code:

chào a!
e có load lisp về dùng thử thì nó bị lỗi: các text chồng chéo lên nhau, và ko nằm trong 2 cột của bảng kết quả
a hướng dẫn cak dùng dc ko a?
thanks!
  • 0
"Xin chào bạn. Đây là tổng đài tin nhắn. Ấn phím 1 để có 1 lời khen. Phím 2 cho một lời chúc tốt đẹp. Phím 3 cho 1 nụ hôn. Phím 4 cho 1 cuộc hẹn. Nếu muốn tất cả hãy bấm số của tôi"

#11 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 06 December 2011 - 10:57 PM

chào a!
e có load lisp về dùng thử thì nó bị lỗi: các text chồng chéo lên nhau, và ko nằm trong 2 cột của bảng kết quả
a hướng dẫn cak dùng dc ko a?
thanks!

Hề hề hề,'
bạn hãy gửi cái file của bạn lên để mình kiểm tra chứ nói vậy mình chưa thể xác định được là lỗi do đâu???/
Cách dùng lisp thì rất đơn giản, b5n chỉ cần apload lisp rồi gõ lệnh btk để chạy.
Lưu ý là trong lisp mình để chiều cao text là 0.3 theo cái bản vẽ mẫu của người yêu cầu. Nếu bạn thấy nó qua 1 lớn thì thu lại và ngược lại. chiều cao text này phù hợp với kích thước của cái bảng của người yêu cầu chứ chưa chắc đã phù hợp với bạn. Vậy bạn phải check chúng trước khi quyết định thay đổi nó.
Chúc bạn vui.
PS: Mình đã test với file mẫu của người yêu cầu thì thấy tốt bạ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.

#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 December 2011 - 11:09 PM

Bác Bình nhiệt tình quá. Trong code bác còn cho phép tính cả với từng đoạn 1 của 1 Pline (dù việc này chính chủ topic cũng chưa nghĩ tới) :) Tks bác.
E cũng đóng góp thêm cách add table. Rộng - cao trong bảng do người dùng tự quyết định

(defun c:btk ( / cao rong iText vla_table 2t e i length1 lstCol lst lstAll fw fn)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(vl-load-com)
(command "undo" "be")
(setq cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y)) hText (/ cao 6)
vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
2t (lambda(x)(rtos x 2 4))
i 1 lstAll ""
lstCol '(0 1 2 3))
(vla-SetTextHeight vla_table acDataRow hText)
(vla-SetTextHeight vla_table acTitleRow (* 1.2 hText))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(prompt "\nChon doan can thong ke")
(while (setq e (ssget "_+.:E:S" (list (cons 0 "LINE,*PLINE,ARC,*POLYLINE"))))
(setq
e (vlax-ename->vla-object (ssname e 0))
lst
(append
(list (itoa i))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getStartPoint e)))) " Y = " (2t (cadr st))))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getEndPoint e)))) " Y = " (2t (cadr st))))
(list (2t (length1 e)))
)
lstAll (strcat lstAll (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
(princ lstAll fw)
(close fw)
)
)
(command "undo" "end")
(princ)
)

  • 3

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


#13 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 06 December 2011 - 11:25 PM

Bác Bình nhiệt tình quá. Trong code bác còn cho phép tính cả với từng đoạn 1 của 1 Pline (dù việc này chính chủ topic cũng chưa nghĩ tới) :) Tks bác.
E cũng đóng góp thêm cách add table. Rộng - cao trong bảng do người dùng tự quyết định

Hề hề hề,
Hổng phải là hổng phải đâu, mình thấy trên bản vẽ của bạn ấy gửi lên có cả việc xác định chiều dài của một phân đoạn của pline nên mới phải mò mẫm đấy chứ, chả phải là mình sáng tạo chi đâu. Yêu cầu của bạn ấy thì mình cứ theo cái bản vẽ mẫu của bạn ấy mà mần thôi, cả line, spline và arc nữa . Vậy mới phải đẻ ra cái thằng cond bác ạ. Còn trúng hay trật thì phải chờ bạn ấy giả nhời mới rõ. (Có khi lại lòi ra mấy thằng cu lau nhau nữa ấy chứ)
Hề hề hề,
Bác cho hỏi thêm một tí là cái thằng vla_table này ở Cad2004 đã xài được chưa bác nhể. (mình vẫn kết thằng này, chửa bỏ được)
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#14 sumi

sumi

    biết lệnh array

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

Đã gửi 07 December 2011 - 12:05 AM

Hề hề hề,'
bạn hãy gửi cái file của bạn lên để mình kiểm tra chứ nói vậy mình chưa thể xác định được là lỗi do đâu???/
Cách dùng lisp thì rất đơn giản, b5n chỉ cần apload lisp rồi gõ lệnh btk để chạy.
Lưu ý là trong lisp mình để chiều cao text là 0.3 theo cái bản vẽ mẫu của người yêu cầu. Nếu bạn thấy nó qua 1 lớn thì thu lại và ngược lại. chiều cao text này phù hợp với kích thước của cái bảng của người yêu cầu chứ chưa chắc đã phù hợp với bạn. Vậy bạn phải check chúng trước khi quyết định thay đổi nó.
Chúc bạn vui.
PS: Mình đã test với file mẫu của người yêu cầu thì thấy tốt bạn ạ.


e đã thử trên file của bạn yêu cầu nhưng vẫn bị lỗi vậy. e gửi lại a file bị lỗi đó. a xem giúp e nhé. tại e thấy hay hay nên dùng thử, hihi
http://www.mediafire...0hwf0j0dfvdsw6c
thanks!
  • 1
"Xin chào bạn. Đây là tổng đài tin nhắn. Ấn phím 1 để có 1 lời khen. Phím 2 cho một lời chúc tốt đẹp. Phím 3 cho 1 nụ hôn. Phím 4 cho 1 cuộc hẹn. Nếu muốn tất cả hãy bấm số của tôi"

#15 sumi

sumi

    biết lệnh array

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

Đã gửi 07 December 2011 - 12:13 AM

Bác Bình nhiệt tình quá. Trong code bác còn cho phép tính cả với từng đoạn 1 của 1 Pline (dù việc này chính chủ topic cũng chưa nghĩ tới) :) Tks bác.
E cũng đóng góp thêm cách add table. Rộng - cao trong bảng do người dùng tự quyết định


(defun c:btk ( / cao rong iText vla_table 2t e i length1 lstCol lst lstAll fw fn)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(vl-load-com)
(command "undo" "be")
(setq cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y))
vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
2t vl-princ-to-string
i 1 lstAll ""
lstCol '(0 1 2 3))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(while (setq e (entsel "\nChon doan can thong ke"))
(setq
e (vlax-ename->vla-object (car e))
lst
(append
(list (2t i))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getStartPoint e)))) " Y = " (2t (cadr st))))
(list (strcat "X = " (2t (car (setq st (vlax-curve-getEndPoint e)))) " Y = " (2t (cadr st))))
(list (2t (length1 e)))
)
lstAll (strcat lstAll (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
(setq fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
(princ "BANG XUAT TOA DO RA FILE CSV \n" fw)
(princ lstAll fw)
)
)
(close fw)
(command "undo" "end")
)

lisp này e chạy tốt, nhưng cho e hỏi là sửa cái tiêu đề của bảng thành chữ có dấu như lisp của a phamthanhbinh như thế nào vậy a?
thanks!
  • 0
"Xin chào bạn. Đây là tổng đài tin nhắn. Ấn phím 1 để có 1 lời khen. Phím 2 cho một lời chúc tốt đẹp. Phím 3 cho 1 nụ hôn. Phím 4 cho 1 cuộc hẹn. Nếu muốn tất cả hãy bấm số của tôi"

#16 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 07 December 2011 - 09:13 AM

..........
e có load lisp về dùng thử thì nó bị lỗi: các text chồng chéo lên nhau, và ko nằm trong 2 cột của bảng kết quả
...........

Bác Bình bổ sung thêm bật-tắt bắt điểm là OK.

...
Bác cho hỏi thêm một tí là cái thằng vla_table này ở Cad2004 đã xài được chưa bác nhể.

bác vẫn chuộng đồ cổ !
- cái thằng vla_table này đã-đang-và (có thể là) sẽ không xài được trên Cad2004 đâu.

...........
E cũng đóng góp thêm cách add table. Rộng - cao trong bảng do người dùng tự quyết định
....................

Cám ơn Ket về 1 Ý tưởng hay.
Một chút góp ý :
1- để chắc chắn đối tuợng có start-end point, thay (entsel "...") bằng
+ (ssget "_:S" (list (cons 0 "*LINE,ARC")))
+ hay (ssget "_+.:E:S" (list (cons 0 "*LINE,ARC")))

2- thay vl-princ-to-string bằng rtos để hiển thị đúng số số lẻ
3- bổ sung vla-setTextHeight cho phù hợp với k/t bảng

(hình như Ket copy phần ghi ra file của bác Bình nên cùng có lỗi khi user chọn không ghi ra file : (close fw) )
  • 2

#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 09:38 AM

Bác Bình bổ sung thêm bật-tắt bắt điểm là OK.

bác vẫn chuộng đồ cổ !
- cái thằng vla_table này đã-đang-và (có thể là) sẽ không xài được trên Cad2004 đâu.
Cám ơn Ket về 1 Ý tưởng hay.
Một chút góp ý :
1- để chắc chắn đối tuợng có start-end point, thay (entsel "...") bằng
+ (ssget "_:S" (list (cons 0 "*LINE,ARC")))
+ hay (ssget "_+.:E:S" (list (cons 0 "*LINE,ARC")))

2- thay vl-princ-to-string bằng rtos để hiển thị đúng số số lẻ
3- bổ sung vla-setTextHeight cho phù hợp với k/t bảng

(hình như Ket copy phần ghi ra file của bác Bình nên cùng có lỗi khi user chọn không ghi ra file : (close fw) )

Hế, lâu lâu mới thấy bác gia_bach xuất chiêu.E quick code lại nên k có tất cả các thao tác bắt lỗi, người dùng phải cẩn trọng th.
2,3 Chính xác luôn bác ạ. Cái 2 thì còn hỏi người dùng, cái 3 thì chắc lấy bằng 0,6 cao là đủ ^^
1 thì vẫn phải loại MLine ra bác nhỉ ^^
Phần ghi file thì xài luôn của bác Bình, e cũng hơi ngớ ngẩn, chỗ đấy đáng lẽ phải ở trong progn ^^

P/s : e sửa luôn code bên trên
  • 0

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


#18 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 09:54 AM

lisp này e chạy tốt, nhưng cho e hỏi là sửa cái tiêu đề của bảng thành chữ có dấu như lisp của a phamthanhbinh như thế nào vậy a?
thanks!

Còn phụ thuộc Table Style bạn hay dùng loại bảng mã chữ nào ?
  • 0

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


#19 sumi

sumi

    biết lệnh array

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

Đã gửi 07 December 2011 - 10:22 AM

e hay dùng mã Vni. Nếu dc thì a chỉ cak e sửa lại, e cũng mún nó hoàn chỉnh 1 tý theo ý mình vì thấy cái này hay hay, hihi
p/s: có phải a ketxu có tham gia bên Hanviquan ko a?
  • 0
"Xin chào bạn. Đây là tổng đài tin nhắn. Ấn phím 1 để có 1 lời khen. Phím 2 cho một lời chúc tốt đẹp. Phím 3 cho 1 nụ hôn. Phím 4 cho 1 cuộc hẹn. Nếu muốn tất cả hãy bấm số của tôi"

#20 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 11:00 AM

Cách 1 : tổng quát nhất : bạn cứ dùng lisp bình thường, tạo bảng rồi kích sửa text trong bảng theo ý bạn. Nhớ là lisp tạo bảng theo TableStyle hiện hành, có thể bạn phải vào để sửa tablestyle theo ý bạn (chỉnh font thành loại VNI)
Cách 2 : Bạn để ý dòng .. "TT" "FROM" "TO" "LENGTH" .., "BANG THONG KE" ...sửa nó theo cách của bạn.
CHú ý cách này thì k chơi sửa thẳng Unicode nhé, lisp k chơi với unicode ở trong code. Để dùng được với text Unicode thì phải xử lý thêm 1 bước nữa ^^
P/s ::)
  • 0

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