Chuyển đến nội dung
Diễn đàn CADViet
metavn

[Yêu cầu] Nhờ viết lisp dim kích thước các pline và xuất ra file cel

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

Nhờ các bác viết dùm lisp như này:
- Lisp 1: ghi kích thước theo dimstyle hiện hành
Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.
Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.
- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel
Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.
VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....
Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm
 
http://www.cadviet.com/upfiles/3/83908_cotthep_1.rar
Mong các bác giúp đỡ, em xin cám ơn trước.
 
P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.
Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 
Hoặc lisp này thì lại chỉ tính được line:

 

(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
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(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)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(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 "" "" "" "" ""))
)                  

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

Có bác nào ghé qua giúp em với ạ

Hề hề hề,

Dùng thử hai cái lisp dưới đây xem đã ưng ý chưa nhé. Trúng trật hạ hồi phân giải.

http://www.cadviet.com/upfiles/3/5194_ghisolieuchieudai.lsp

http://www.cadviet.com/upfiles/3/5194_dimarclength.lsp

  • Vote tăng 1

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

Hề hề hề,

Dùng thử hai cái lisp dưới đây xem đã ưng ý chưa nhé. Trúng trật hạ hồi phân giải.

http://www.cadviet.com/upfiles/3/5194_ghisolieuchieudai.lsp

http://www.cadviet.com/upfiles/3/5194_dimarclength.lsp

 

Thanks bác nhiều, lisp đúng ý em rồi nhưng nhờ bác sửa 1 chút là để kích thước ghi ra làm tròn không còn số sau dấu phẩy ạ.

VD: kích thước 199.73 thì làm tròn thành 200

Với lại xin bác thêm 1 lisp nữa là sửa lisp ghisolieuchieudai thành lisp chọn line, pline tính chiều dài và ghi ra file cel luôn, không chọn text để điền giá trị nữa.

Lisp của bác giúp em rất nhiều trong công việc, 1 lần nữa cám ơn bác đã nhiệt tình giúp đỡ :wub:

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

Thanks bác nhiều, lisp đúng ý em rồi nhưng nhờ bác sửa 1 chút là để kích thước ghi ra làm tròn không còn số sau dấu phẩy ạ.

VD: kích thước 199.73 thì làm tròn thành 200

Với lại xin bác thêm 1 lisp nữa là sửa lisp ghisolieuchieudai thành lisp chọn line, pline tính chiều dài và ghi ra file cel luôn, không chọn text để điền giá trị nữa.

Lisp của bác giúp em rất nhiều trong công việc, 1 lần nữa cám ơn bác đã nhiệt tình giúp đỡ :wub:

Hề hề hề,

Những vấn đề bạn nêu ra hoàn toàn bạn có thể tự sửa được mà.

1/- Về việc làm tròn số giá trị đo, bạn chỉ cần mở lisp dimarclength ra và thay thế sồ 2 cuối cùng trong đoạn code :

..... (rtos alen 2 2).... thành ....... (rtos alen 2 0).....

2/- Về lisp ghi chiều dài bạn mở lisp đó ra và xóa bỏ các dòng code sau:

(setq txt (car (entsel "\n Chon text can ghi bo xung gia tri chieu dai polyline"))

         etxt (entget txt)

         etxt (subst (cons 1 (strcat (cdr (assoc 1 etxt)) " " (rtos len 2 2))) (assoc 1 etxt) etxt)  )

(entmod etxt)

Sau đó save nó lại với tên mới tỷ như metavn1.lsp chẳng hạn 

Vậy là bạn có thêm một lisp mới theo yêu cầu mà chả phải mất công gì nhiều.

Nếu bạn cũng muốn giá trị ghi lại được làm tròn số tới phần nguyên thì bạn hãy sửa thêm một tí. Thay .....(rtos len 2 2).... thành ....(rtos len 2 0)....

 

Chúc bạn vui và sớm có được sản phẩm lisp đầu tay của mình.

 

  • Like 1
  • Vote tăng 1

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

Hề hề hề,

Những vấn đề bạn nêu ra hoàn toàn bạn có thể tự sửa được mà.

1/- Về việc làm tròn số giá trị đo, bạn chỉ cần mở lisp dimarclength ra và thay thế sồ 2 cuối cùng trong đoạn code :

..... (rtos alen 2 2).... thành ....... (rtos alen 2 0).....

2/- Về lisp ghi chiều dài bạn mở lisp đó ra và xóa bỏ các dòng code sau:

(setq txt (car (entsel "\n Chon text can ghi bo xung gia tri chieu dai polyline"))

         etxt (entget txt)

         etxt (subst (cons 1 (strcat (cdr (assoc 1 etxt)) " " (rtos len 2 2))) (assoc 1 etxt) etxt)  )

(entmod etxt)

Sau đó save nó lại với tên mới tỷ như metavn1.lsp chẳng hạn 

Vậy là bạn có thêm một lisp mới theo yêu cầu mà chả phải mất công gì nhiều.

Nếu bạn cũng muốn giá trị ghi lại được làm tròn số tới phần nguyên thì bạn hãy sửa thêm một tí. Thay .....(rtos len 2 2).... thành ....(rtos len 2 0)....

 

Chúc bạn vui và sớm có được sản phẩm lisp đầu tay của mình.

 

 

Okie rồi bác ơi, em sửa theo ý bác là được lisp đúng ý rồi.

Nhưng bác cho em hỏi ở lisp đo polyline khi dim arc thì lúc đầu nó đo bán kính, nếu click lần nữa vào arc thì nó đo chiều dài cung, nhưng đường đo bán kính lại bị mất, bác chỉ cho em cách sửa lisp để giữ lại cả đường đo bán kính với.

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

Okie rồi bác ơi, em sửa theo ý bác là được lisp đúng ý rồi.

Nhưng bác cho em hỏi ở lisp đo polyline khi dim arc thì lúc đầu nó đo bán kính, nếu click lần nữa vào arc thì nó đo chiều dài cung, nhưng đường đo bán kính lại bị mất, bác chỉ cho em cách sửa lisp để giữ lại cả đường đo bán kính với.

Hề hề hề,

Muốn giữ lại bán kính nào có khó chi đâu, nhưng chỉ sợ nó rối bản vẽ bởi có nhiều cung có cùng bàn kinh. Vậy có nên không nhỉ???

Chi bằng bạn cứ nhòm vào hình và lực chọn cung nào cần thiết thì ghi thêm bán kinh vào đó, có mật mấy hồi đâu.

Còn nếu bạn vẫn muốn giữ lại bán kính thì có nhẽ bạn lại phải làm một bước phụ là xóa các bán kinh thừa đi. (mà cái số cần xóa lại thường nhiều hơn số cần ghi vào). Ây da lợi hay hại có nhẽ còn phải cãi nhau to.

Để giữ lại cái bán kinh đã dỉmadius này bạn chỉ cần vô hiệu hóa dòng code (command "erase" e1 "") trong hàm con (darl ...) là được. Cách vô hiệu hóa dòng code này có nhiều, nhưng đơn giản nhất là bạn thêm vào phía trước dòng code 1 hay vài dấu ; (chấm phẩy) hoặc là xóa béng nó đi.

Xóa đi thì khi cần khôi phục lại sẽ mất công nhớ và gõ lại. Nhưng nếu sử dụng dấu ; thì khi cần phôi phục chỉ cần xóa các dấu ; này là ok.

Vậy tùy bạn lựa chọn cách dùng sao cho nó thuận tiện nhất cho công việc của bạn.

  • Vote tăng 1

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

Hề hề hề,

Muốn giữ lại bán kính nào có khó chi đâu, nhưng chỉ sợ nó rối bản vẽ bởi có nhiều cung có cùng bàn kinh. Vậy có nên không nhỉ???

Chi bằng bạn cứ nhòm vào hình và lực chọn cung nào cần thiết thì ghi thêm bán kinh vào đó, có mật mấy hồi đâu.

Còn nếu bạn vẫn muốn giữ lại bán kính thì có nhẽ bạn lại phải làm một bước phụ là xóa các bán kinh thừa đi. (mà cái số cần xóa lại thường nhiều hơn số cần ghi vào). Ây da lợi hay hại có nhẽ còn phải cãi nhau to.

Để giữ lại cái bán kinh đã dỉmadius này bạn chỉ cần vô hiệu hóa dòng code (command "erase" e1 "") trong hàm con (darl ...) là được. Cách vô hiệu hóa dòng code này có nhiều, nhưng đơn giản nhất là bạn thêm vào phía trước dòng code 1 hay vài dấu ; (chấm phẩy) hoặc là xóa béng nó đi.

Xóa đi thì khi cần khôi phục lại sẽ mất công nhớ và gõ lại. Nhưng nếu sử dụng dấu ; thì khi cần phôi phục chỉ cần xóa các dấu ; này là ok.

Vậy tùy bạn lựa chọn cách dùng sao cho nó thuận tiện nhất cho công việc của bạn.

 

Yêu cầu công việc của em là phải thể hiện cả bán kinh uốn thép (theo tiêu chuẩn) và chiều dài cung tròn (để tính chiều dài thanh thép) nên phải ghi cả 2 bác à :D

Em đã sửa lại lisp được rồi, hơi tham 1 tí làm phiền bác lần nữa là giúp em lisp đo 2 điểm bất kỳ trên đường polyline:

Đề bài là có mặt bằng tuyến như trên file đính kèm, em muốn dim kích thước từ đuôi mố M1 đến đuôi mố M2, nhưng vấn đề ở đây là tuyến lại có mấy đường cong nên trước tới giờ em làm cách thủ công là offset đường tim ra rồi điền text vào, nếu chỉ có 1 đường cong thì có thể dùng dim angle như 2 mố trụ gần nhau em vẫn dim bằng cách này (nhưng dim xong em toàn phải sửa tay giá trị chiều dài vào).

Nhờ bác viết hộ lisp:

+ lisp 1: chọn đường polyline, click vào 2 điểm trên đường polyline, chọn điểm đặt đường dim sẽ ra được đường kích thước như trong file đính kèm. lisp này dùng để đo chiều dài tổng.

+ lisp 2: nhờ bác hướng dẫn em viết lisp chọn đường polyline, chọn 2 đường thẳng cắt qua đường pline đó kết quả ra đường kích thước như dim angle nhưng giá trị không phải là góc mà là khoảng cách 2 điểm đó theo đường pline. Như trong file của em là đường đo giữa M1 và T1 đấy ạ.

Em có hướng là tạo đường dim angle bằng hàm command

(command "dimangular")

sau đó gán giá trị khoảng cách giữa 2 điểm được chọn vào, còn giá trị này được tính khi chọn pline, chọn 2 đường thẳng cắt qua pline đó, cad sẽ tìm đến 2 điểm giao cắt và tính khoảng cách của 2 điểm này, nhưng hàm tìm điểm giao cắt em chưa tìm ra.

Em có thấy hàm getdist tính khoảng cách giữa 2 điểm nhưng nó là tính khoảng cách theo đường thẳng nối 2 điểm chứ không phải khoảng cách theo đường polyline, không biết có dùng được hàm này không bác.

Bác giúp em đưa ra mấy hàm cần thiết để tạo được lisp này nhé, hy vọng em sẽ tự viết được 1 lisp hoàn chỉnh.

http://www.cadviet.com/upfiles/3/83908_mat_bang.dwg

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

Yêu cầu công việc của em là phải thể hiện cả bán kinh uốn thép (theo tiêu chuẩn) và chiều dài cung tròn (để tính chiều dài thanh thép) nên phải ghi cả 2 bác à :D

Em đã sửa lại lisp được rồi, hơi tham 1 tí làm phiền bác lần nữa là giúp em lisp đo 2 điểm bất kỳ trên đường polyline:

Đề bài là có mặt bằng tuyến như trên file đính kèm, em muốn dim kích thước từ đuôi mố M1 đến đuôi mố M2, nhưng vấn đề ở đây là tuyến lại có mấy đường cong nên trước tới giờ em làm cách thủ công là offset đường tim ra rồi điền text vào, nếu chỉ có 1 đường cong thì có thể dùng dim angle như 2 mố trụ gần nhau em vẫn dim bằng cách này (nhưng dim xong em toàn phải sửa tay giá trị chiều dài vào).

Nhờ bác viết hộ lisp:

+ lisp 1: chọn đường polyline, click vào 2 điểm trên đường polyline, chọn điểm đặt đường dim sẽ ra được đường kích thước như trong file đính kèm. lisp này dùng để đo chiều dài tổng.

+ lisp 2: nhờ bác hướng dẫn em viết lisp chọn đường polyline, chọn 2 đường thẳng cắt qua đường pline đó kết quả ra đường kích thước như dim angle nhưng giá trị không phải là góc mà là khoảng cách 2 điểm đó theo đường pline. Như trong file của em là đường đo giữa M1 và T1 đấy ạ.

Em có hướng là tạo đường dim angle bằng hàm command

(command "dimangular")

sau đó gán giá trị khoảng cách giữa 2 điểm được chọn vào, còn giá trị này được tính khi chọn pline, chọn 2 đường thẳng cắt qua pline đó, cad sẽ tìm đến 2 điểm giao cắt và tính khoảng cách của 2 điểm này, nhưng hàm tìm điểm giao cắt em chưa tìm ra.

Em có thấy hàm getdist tính khoảng cách giữa 2 điểm nhưng nó là tính khoảng cách theo đường thẳng nối 2 điểm chứ không phải khoảng cách theo đường polyline, không biết có dùng được hàm này không bác.

Bác giúp em đưa ra mấy hàm cần thiết để tạo được lisp này nhé, hy vọng em sẽ tự viết được 1 lisp hoàn chỉnh.

http://www.cadviet.com/upfiles/3/83908_mat_bang.dwg

Hề hề hề,

Xin có một vài ý kiến như sau:

1/- Để lấy chiều dài của một đoạn pline được xác định bởi hai điểm p1, p2 cho trước trên pline cho trước e, bạn có thể sử dụng hàm sau đây:

(setq len (abs (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))))

2/- Việc bạn muốn đường kích thước lại vừa cong vừa thẳng theo như pline là không dễ nếu như muốn sử dụng lệnh dim. Vì vậy bạn có thể sử dụng lệnh ofset để tạo đường này với khoảng cách do bạn chọn. Sau đó dùng lện pline để vẽ cái mũi lên cho nó .... oai.

3/- Việc bạn muốn sử dụng lện dimangular để ghi kích thước length này thì nên nhớ rằng đường kích thước sẽ là một cung tròn chứ không hoàn toàn song song với pline như bạn muốn đâu. nếu dùng dimangular thì bạ tham khảo cái lisp mình gửi bạn sẽ rõ cách dùng nó và cách thay thề già trị chiều dài đoạn pline vào giá trị góc đo của dim.

Hy vọng bạn sẽ thành công với cái lisp này.

  • Vote tăng 1

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

Hề hề hề,

Xin có một vài ý kiến như sau:

1/- Để lấy chiều dài của một đoạn pline được xác định bởi hai điểm p1, p2 cho trước trên pline cho trước e, bạn có thể sử dụng hàm sau đây:

(setq len (abs (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))))

2/- Việc bạn muốn đường kích thước lại vừa cong vừa thẳng theo như pline là không dễ nếu như muốn sử dụng lệnh dim. Vì vậy bạn có thể sử dụng lệnh ofset để tạo đường này với khoảng cách do bạn chọn. Sau đó dùng lện pline để vẽ cái mũi lên cho nó .... oai.

3/- Việc bạn muốn sử dụng lện dimangular để ghi kích thước length này thì nên nhớ rằng đường kích thước sẽ là một cung tròn chứ không hoàn toàn song song với pline như bạn muốn đâu. nếu dùng dimangular thì bạ tham khảo cái lisp mình gửi bạn sẽ rõ cách dùng nó và cách thay thề già trị chiều dài đoạn pline vào giá trị góc đo của dim.

Hy vọng bạn sẽ thành công với cái lisp này.

 

Em vừa đăng kí lớp học của bác ketxu, chắc phải học bài bản mới viết được, chứ mày mò vậy lâu quá :D

Thanks bác đã nhiệt tình giúp đỡ, hy vọng sẽ sớm hoàn thành lisp này trả bài cho bác he he

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

Em vừa đăng kí lớp học của bác ketxu, chắc phải học bài bản mới viết được, chứ mày mò vậy lâu quá :D

Thanks bác đã nhiệt tình giúp đỡ, hy vọng sẽ sớm hoàn thành lisp này trả bài cho bác he he

Hề hề hề,

Vậy ư, thế thì chôm luôn cái này về học thử coi có thấm không hè???

http://www.cadviet.com/upfiles/3/5194_dimpara.lsp

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

Nhờ các bạn giúp mình viết lisp rải đối tượng có kèm theo text (trong đó text gồm chữ và số), số tăng dần, chữ không không thay đổi . Xin cảm ơn.

Hề hề hề,

Cái ni trên diễn đàn có rồi, bạn chịu khó tìm kiếm về xài coi đã ưng ý chưa nhé.

Nếu chưa thì hãy post nói rõ cái chỗ chưa ưng và cái bạn ưng để mọi người sửa lại. Như vậy tốt hơn nhiều là việc làm lại một lisp mới mà chả biết có đúng ý bạn hay không.

  • Vote tăng 1

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

Mình có file này muốn xuất ra file excel với 2 cột là STT và Khoảng cách được không ạ?

Ví dụ:

STT          Khoảng cách

1.1          0

1.2          61

1.3          66

1.4          60

1.5          52

......

Xin các bác trong diễn đàn giúp đỡ ạ.

Trân trọng cảm ơn.

File: http://www.cadviet.com/upfiles/3/2883_s.dwg

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

Mình là người mới nên cũng không rành cho lắm :D , nhờ các bạn giúp mình,mình tìm hoài chẳng thấy nên up file này xin mọi người chỉ dẫn :D

Chỉnh sửa theo nguyenthanhtanthinh

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

Hề hề hề,

Dùng thử hai cái lisp dưới đây xem đã ưng ý chưa nhé. Trúng trật hạ hồi phân giải.

http://www.cadviet.com/upfiles/3/5194_ghisolieuchieudai.lsp

http://www.cadviet.com/upfiles/3/5194_dimarclength.lsp

Anh cho em hỏi xíu ở cái lisp dùng lệnh dimpo thì text xuất ra theo từng đoạn đường pline, giờ em muốn đo 1 phát chỉ xuất hiện duy nhất 1 text thể hiện kích thước cả được pline đó thì như nào ạ?

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

Em chào các bác ạ, các bác có thể viết giúp em 1 lisp được không ạ , em có hình vẽ như bên dưới em muốn nhờ các bác xuất ra tọa độ giúp em và quan trọng nhất là có góc xoay của C như e đã vẽ mong các bac giúp đỡ ạ

Em cảm ơn ạ

http://www.mediafire.com/download/r47ksafwn9xrz5d/vidu.dwg

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

Hề hề hề,

Dùng thử hai cái lisp dưới đây xem đã ưng ý chưa nhé. Trúng trật hạ hồi phân giải.

http://www.cadviet.com/upfiles/3/5194_ghisolieuchieudai.lsp

http://www.cadviet.com/upfiles/3/5194_dimarclength.lsp

 

Bạn ơi cho mình xin cái 2 cái lisp trên với nhé: ongoal01@gmail.com

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

Cho mình xin 2 lisp trên luôn nha, mình không tải được, email là duchuy.eng@gmail.com<br /><br /><a data-cke-saved-href="undefined" href="undefined">http://www.cadviet.c...ieuchieudai.lsp</a><br /><a data-cke-saved-href="undefined" href="undefined">http://www.cadviet.c...imarclength.lsp</a>

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

Em đang học ,,đang đọc tới phần sửa của bác 

phamthanhbinh

  thì bị ngắt quảng.Cho cho em xin 2 lisp nha ,mail ngohoangstm@gmail.com .thanks bác nhiều.

 http://www.cadviet.c...ieuchieudai.lsp  5194_ghisolieuchieudai.lsp

http://www.cadviet.c...imarclength.lsp  5194_dimarclength.lsp

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

Bác PhamThanhBinh ơi, em có đường 1 pline gồm n đoạn em muốn tick vào pline thì sẽ xuất chiều dài của n đoạn đó sang Exel được không ạ? Nhờ Bác viết giúp cho cái lisp nhé. Cảm ơn Bác.

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

Bác PhamThanhBinh ơi, em có đường 1 pline gồm n đoạn em muốn tick vào pline thì sẽ xuất chiều dài của n đoạn đó sang Exel được không ạ? Nhờ Bác viết giúp cho cái lisp nhé. Cảm ơn Bác.

 Tặng bạn. Lệnh xcd, line hay pline đều ok.

(defun c:xcd ( / tapchon fn dt m )
	(setq	tapchon (ssget '((-4 . "<OR")
                         (0 . "LINE")
						 (-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
						 (-4 . "OR>")))
			fn	(getfiled "Chon Noi Luu File" (getvar "dwgprefix") "csv" 1)
			fn	(open fn "w")
	)
	(repeat (sslength tapchon)
			(setq	dt (ssname tapchon 0)
					tapchon (ssdel dt tapchon)
					dt	(entget dt)
					dt	(vl-remove-if-not
										'(lambda (x) (or (= (car x) 10) (= (car x) 11) ) ) dt
						)
					m	0
			)
			(repeat	(1- (length dt) )
					(setq	chieudai (distance (cdr (nth m dt)) (cdr (nth (+ m 1) dt)))
							m	(1+ m)
					)
					(write-line (rtos chieudai 2 3) fn)			
			)
	)
	(close fn)
	(princ)	
)

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

 

 Tặng bạn. Lệnh xcd, line hay pline đều ok.

(defun c:xcd ( / tapchon fn dt m )
	(setq	tapchon (ssget '((-4 . "<OR")
                         (0 . "LINE")
						 (-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
						 (-4 . "OR>")))
			fn	(getfiled "Chon Noi Luu File" (getvar "dwgprefix") "csv" 1)
			fn	(open fn "w")
	)
	(repeat (sslength tapchon)
			(setq	dt (ssname tapchon 0)
					tapchon (ssdel dt tapchon)
					dt	(entget dt)
					dt	(vl-remove-if-not
										'(lambda (x) (or (= (car x) 10) (= (car x) 11) ) ) dt
						)
					m	0
			)
			(repeat	(1- (length dt) )
					(setq	chieudai (distance (cdr (nth m dt)) (cdr (nth (+ m 1) dt)))
							m	(1+ m)
					)
					(write-line (rtos chieudai 2 3) fn)			
			)
	)
	(close fn)
	(princ)	
)

Giup em sua lai cho nay la chieu dai day cung di bac,em xuat no ra khoang cach điểm đầu và điểm cuối của cung bác ạ.

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

 

Nhờ các bác viết dùm lisp như này:

- Lisp 1: ghi kích thước theo dimstyle hiện hành

Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.

Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.

- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel

Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.

VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....

Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm

 

http://www.cadviet.com/upfiles/3/83908_cotthep_1.rar

Mong các bác giúp đỡ, em xin cám ơn trước.

 

P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.

Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 

Hoặc lisp này thì lại chỉ tính được line:

(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
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(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)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(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 "" "" "" "" ""))
)                  

 

 

Nhờ các bác viết dùm lisp như này:

- Lisp 1: ghi kích thước theo dimstyle hiện hành

Có các thanh thép là các đường pline, line như trong file đính kèm (phần "ban đầu"), em muốn đo các kích thước của các thanh thép đó như phần "Dùng lisp" có cả kích thước chiều dài cung tròn, kích thước bán kính cung tròn, góc nghiêng.

Chú ý là thanh X3 đo kích thước cung tròn bằng lệnh 'dar' thì không đẹp, các bác có thể viết lisp thay thế bằng lệnh đo góc 'dan' mà giá trị ghi vẫn là chiều dài cung đó được ko.

- Lisp 2: Tính chiều dài và điền vào text, xuất sang cel

Cụ thể là pick vào từng thanh một sẽ tính chiều dài thanh đó (có thể là line hoặc pline) rồi pick vào từng text sẽ điền giá trị chiều dài thanh đó vào phần cuối của text.

VD: pick vào hình vẽ thanh X1 sẽ hiện lên command "điền giá trị vào text" rồi pick vào text "x1-d25, l=" sẽ thành "x1-d25, l=4545", sau đó hiện lên command "chọn thanh tiếp theo" pick vào thanh x2 rồi pick vào text "x2-d16, l=" v.v.....

Kết thúc bằng lệnh enter sẽ xuất chiều dài các thanh vừa pick sang file excel với giá trị chiều dài các thanh nằm trên 1 cột như file đính kèm

 

http://www.cadviet.com/upfiles/3/83908_cotthep_1.rar

Mong các bác giúp đỡ, em xin cám ơn trước.

 

P/S: Em cũng tìm mấy hôm trên diễn đàn về lisp tính chiều dài pline và xuất sang excel thì chưa tìm được lisp đúng ý.

Lisp này thì tính chiều dài từng phần trong pline mà ko tính tổng, lại ko tính liên tục các pline được, nhờ các bác sửa giúp em

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43033
(defun c:p2E(/ i ent ss lstV pt_lst nb)
; Polyline Vertex Length to Excel
; @ gia_bach
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
    (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i))) 
		  nb (strcat "Pline " (rtos (- (sslength ss) i) 2 0)) 
		  lstV (append (list(list nb))(pll ent)))
	(foreach pt lstV
	  (setq pt_lst (append pt_lst (list pt)))
	))	  
      (if (vlax-get-or-create-object "Excel.Application")
	(WriteToExcel pt_lst)
	(WriteToCSV pt_lst) )))
  (princ))

(defun WriteToExcel (lst_data / col row x xlApp xlCells)
  (setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
		  (vlax-get-property
		    (vlax-get-property
		      (vlax-invoke-method
			(vlax-get-property xlApp "Workbooks")
			"Add")
		      "Sheets")
		    "Item" 1)
		  "Cells"))
  (setq row 3)
  (foreach pt lst_data
    (setq col 3)
    (foreach coor pt
      (vlax-put-property xlCells 'Item row col coor)
      (setq col (1+ col)))
    (setq row (1+ row)) )
  (vla-put-visible xlApp :vlax-true)
  (mapcar
    (function (lambda (x)
		(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))
    (list xlCells xlApp))
  (gc) (gc) )

(defun WriteToCSV (lst_data / fl)  
  (if (setq fl (getfiled "Output File" "" "csv" 1))
    (if (setq fl (open fl "w"))
      (progn
	(foreach pt lst_data 
	  (write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl) )
	(close fl) ) ) )
  (princ))
  
  
  
  (defun pll ( e / j)         
  (setq j (1- (vlax-curve-getStartParam e)) lst '())
  (while (<= (setq j (1+ j)) (vlax-curve-getEndParam e))
    (setq lst
        (cons 
          (list (- (vlax-curve-getDistatParam e j)
             (if (zerop j) 0
             (vlax-curve-getDistatParam e (1- j)))))
		lst
		)
	)
  )
	(setq lst (cdr (reverse lst)))
	lst
)

 

Hoặc lisp này thì lại chỉ tính được line:

(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
        (princ (strcat " 1 found. " (rtos (1+ i) 2 0) "total"))
        (setq plst (cons e plst)
                  e (entsel "\n Chon doan tiep theo")
                  i (1+ i)
        )
)
(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)
                  (princ " TT doan , Tu diem , Toi diem , Chieu dai \n" fw)
   )
)
(setq i 0)
(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 "" "" "" "" ""))
)                  

Mình muốn lấy chiều dài đường polyline sau khi vẽ trên cad chuyển đến ô cell mà con trỏ hiện hành trong file excel mình đang mở sẵn rồi chứ không phải là book mới thì làm sao bạn?? thanks

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×