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

Tháng 11 30, 2011

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

Tháng 11 30, 2011

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

Tháng 12 1, 2011

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!

Tháng 12 1, 2011

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"

Tháng 12 1, 2011

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!

Tháng 12 5, 2011

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!

Tháng 12 5, 2011

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ề,

Tháng 12 6, 2011

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!

Tháng 12 6, 2011

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  ÐO\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  DÀ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ề.

Chỉnh sửa Tháng 12 7, 2011 theo phamthanhbinh
Sửa lỗi lisp theo góp ý của bác Giabach

Tháng 12 6, 2011

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!

Tháng 12 6, 2011

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

Tháng 12 6, 2011

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

Tháng 12 6, 2011

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)

Tháng 12 6, 2011

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.com/?0hwf0j0dfvdsw6c

thanks!

Tháng 12 6, 2011

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!

Tháng 12 7, 2011

..........

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

Tháng 12 7, 2011

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

Tháng 12 7, 2011

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 ?

Tháng 12 7, 2011

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?

Tháng 12 7, 2011

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

Tháng 12 7, 2011

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!

Hề hề hề,

Gửi lại bạn cái mình test trên bản vẽ bạn đưa.

http://www.cadviet.com/upfiles/3/5194_file_yeu_cau_1_1.dwg

http://www.cadviet.c...e_yeu_cau_1.zip

Bạn đã sử dụng lisp như thế nào???

Qua các bài của các bác mình mới phát hiện ra lỗi của lisp, nhưng không phải cái lỗi mà bạn nói. Mình đã sửa và bổ sung lại lisp ở bài post trước.

Chỉnh sửa Tháng 12 7, 2011 theo phamthanhbinh
Bồ sung file upload

Tháng 12 7, 2011

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 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  ÐO\\U+1EA0N" )
(command "text" "j" "mc" (list (+ (car p2) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EEA  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p3) 2.75) (- (cadr p1) 0.75)) 0.3 0 "T\\U+1EDAI  ÐI\\U+1EC2M" )
(command "text" "j" "mc" (list (+ (car p4) 2.75) (- (cadr p1) 0.75)) 0.3 0 "CHI\\U+1EC0U  DÀ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)
  	)
)
(close fw)
(command "undo" "e")
(princ)
)

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

Hề hề hề.

Cám ơn anh rất nhiều, Lisp này em dùng thử thấy có một số điểm đó là điểm thứ 11 tọa độ bị lỗi , nhờ anh kiểm tra giúp em với nhé. Thanks you very much

Nhưng khi bắt điểm theo thứ tự đoạn D1->D2->D3->D4->D5->D6->D7->D8->D9->D10->D11->D12->D13 thì bị lỗi đoạn thứ 11 (tức là D11 theo hình vẽ) . Còn khi bắt điểm theo thứ tự không lần lượt theo cách chọn đoạn D1->D2->D3->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 7 (cũng tức là D11 theo hình vẽ), và bảng xuất ra bị xô lệch như của bạn sumi gặp phải.

Anh có thể xem lại một chút không?

Theo em thấy hình như khi chọn đoạn gặp đường cung tròn ở chỗ này thì có vẻ tọa độ bị sai ạ.

Tháng 12 7, 2011

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

Cám ơn bạn ketxu nữa, Hôm trước bạn nói bận mà vẫn để tâm giúp mình! Lisp của bạn xuất ra kết quả rất nhanh chóng, nhưng khi bắt điểm theo thứ tự đoạn D1->D2->D3->D4->D5->D6->D7->D8->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 11 (tức là D11 theo hình vẽ) như của bác Pham Thanh Binh ( không biết bác ấy có phải tên chính xác là Phạm Thanh Bình không?). còn khi bắt điểm theo thứ tự không lần lượt theo cách chọn đoạn D1->D2->D3->D9->D10->D11->D12->D13 thì cũng bị lỗi đoạn thứ 7 (cũng tức là D11 theo hình vẽ) Bạn có thể xem lại một chút không?

Tháng 12 7, 2011

Lỗi khi bắt điểm là lỗi gì nhỉ ???

Nếu so với tọa độ trong yêu cầu của bạn thì nó ngược lại (from <-> to).

Nhưng cái này thì bạn phải tự trách mình thôi.Bạn yêu cầu Lisp lấy tọa độ đầu - cuối của 1 đoạn, và lisp sẽ lấy tọa độ theo quá trình bạn vẽ. Như với đoạn 11, bạn vẽ từ điểm (40.8 35.48) đến điểm (41.3 33.14) thì đương nhiên kết quả thu về sẽ là như thế (đầu - cuối). Còn trong ý niệm của bạn, bạn lại muốn ngược lại, mà cái này thì Máy móc không thể hiểu được ý niệm đó (vì các đoạn của bạn ở đây là hoàn toàn riêng rẽ).

Trừ khi bạn gán cho cuối đoạn 10 là đầu đoạn 11, như vậy, yêu cầu hoàn toàn khác với đề bài ban đầu, hoặc giả trong trường hợp tổng quát, nó không phù hợp (ví dụ đoạn từ D8 -> D9)

Tháng 12 7, 2011

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ề hề hề,

cám ơn sự chỉ dẫn của bác giabach,

Đúng là mình chưa test khi user trả lời no, Khi đó làm gì co fw mà đóng nó. Bởi vậy nên bị lỗi và mình đã bổ sung thành (if fw (close fw)) chắc là ổn bác nhể.

Cái thằng osnap này lắm lúc cũng phiền với nó ra phết bác nhể. Mình sẽ rút kinh nghiệm để lần sau đỡ mắc lỗi hơn.

Chúc bác khỏe và vui.

Đăng nhập

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

Các bài được khuyến nghị

draftsman38751 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

draftsman38751 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

draftsman38751 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phuongkq 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phuongkq 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

sumi 55

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

sumi 55

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

sumi 55

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.549

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

sumi 55

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984