Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
tacongthang

Nhờ viết LISP xuất dữ liệu ra file excel

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

tacongthang    11

Chào mọi người,

 

Lâu lắm rồi không lên diễn đàn, không biết giờ nhờ viết LISP có còn được không? tại mình không biết gì về lập trình cả.

Mình muốn nhờ các cao thủ giúp dùm 1 lisp với yêu cầu như sau:

-Lisp cho chọn đối tượng bằng cách quét chuột chọn đối tượng hay nhóm đối tượng

-chỉ chọn đối tượng là các multiline

-thống kê và xuất ra file excel gồm 2 cột, với mỗi dòng là thông tin tên layer của multiline và chiều dài của multiline

 

Xin cám ơn

  • Vote giảm 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
nhoclangbat    382

- hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;=================================================================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=======================================================================
(defun c:kko (/ ss ds_ent ds_laydis layer dis info)
(prompt "Quet chon cac Multiline ")
(setq ss (ssget '( (0 . "MLINE"))))
(if ss 
	(progn 
		(setq ds_ent (ss2ent ss))
			(foreach k ds_ent
				(setq info (entget k))
				(setq layer (acet-dxf 8 info))
				(setq dis (add_mline info))
				(setq ds_laydis (append ds_laydis (list (list layer dis))))
			)
		)
)
(xls ds_laydis '("LAYER" "CHIEU DAI") nil "Thong ke")
;(princ ds_laydis)
(princ)
)
;==============================================================================================================================================
(vl-load-com)
(defun xls (Data-list	   header	  Colhide	 Name_list
	    /		   *aplexcel*	  *books-colection*
	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
	    *sheet-collection*		  col		 iz_listo
	    row		   cell		  cols
	   )
  (defun Letter	(N / Res TMP)
    (setq Res "")
    (while (> N 0)
      (setq TMP	(rem N 26)
	    TMP	(if (zerop TMP)
		  (setq	N   (1- N)
			TMP 26
		  )
		  TMP
		)
	    Res	(strcat (chr (+ 64 TMP)) Res)
	    N	(/ N 26)
      )
    )
    Res
  )
  (if (null Name_list)
    (setq Name_list "")
  )
  (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
    )
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
    )
  )
  (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
  (setq	Name_list (if (= Name_list "")
		    (vl-filename-base (getvar "DWGNAME"))
		    (strcat (vl-filename-base (getvar "DWGNAME"))
			    "&"
			    Name_list
		    )
		  )
	col	  0
	cols	  nil
  )
  (if (> (strlen Name_list) 26)
    (setq Name_list
	   (strcat (substr Name_list 1 10)
		   "..."
		   (substr Name_list (- (strlen Name_list) 13) 14)
	   )
    )
  )
  (vlax-for sh *Sheet-Collection*
    (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
  )
  (setq row Name_list)
  (while (member (strcase row) cols)
    (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
  )
  (setq Name_list row)
  (vlax-put-property *Sheet#1* 'Name Name_list)
  (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
  (vlax-put-property
    *AplExcel*
    "UseSystemSeparators"
    :vlax-false
  ) ;_?? ???????????? ????????? ?????????
  (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
  (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
  (vla-put-visible *AplExcel* :vlax-true)
  (setq	row 1
	col 1
  )
  (if (null header)
    (setq header '("X" "Y" "Z"))
  )
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (nth (1- col) header))
    )
    (setq col (1+ col))
  )
  (setq	row 2
	col 1
  )
  (repeat (length Data-list)
    (setq iz_listo (car Data-list))
    (repeat (length iz_listo)
      (vlax-put-property
	*excell-cells*
	"Item"
	row
	col
	(vl-princ-to-string (car iz_listo))
      )
      (setq iz_listo (cdr iz_listo)
	    col	     (1+ col)
      )
    )
    (setq Data-list (cdr Data-list))
    (setq col 1
	  row (1+ row)
    )
  )
  (setq	col (1+ (length header))
	row (1+ row)
  )
  (setq	cell (vlax-variant-value
	       (vlax-invoke-method
		 *Sheet#1*
		 "Evaluate"
		 (strcat "A1:" (letter col) (itoa row))
	       )
	     )
  ) ;_ end of setq
  (setq cols (vlax-get-property cell 'Columns))
  (vlax-invoke-method cols 'Autofit)
  (vlax-release-object cols)
  (vlax-release-object cell)
  (foreach item	ColHide
    (if	(numberp item)
      (setq item (letter item))
    )
    (setq cell (vlax-variant-value
		 (vlax-invoke-method
		   *Sheet#1*
		   "Evaluate"
		   (strcat item "1:" item "1")
		 )
	       )
    )
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-put-property cols 'hidden 1)
    (vlax-release-object cols)
    (vlax-release-object cell)
  )
  (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
  (mapcar 'vlax-release-object
	  (list	*excell-cells*	    *Sheet#1*
		*Sheet-Collection*  *New-Book*
		*Books-Colection*   *AplExcel*
	       )
  )
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
(defun add_mline ( elist / pt1 mline_len pt2 tot_len)
(setq tot_len 0.0)
  (foreach k	elist
    (cond ((= 10 (car k))
	   (setq pt1	   (cdr k)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car k))
	   (setq pt2	   (cdr k)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
 )

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
tacongthang    11

cám ơn bạn nhóclangbat,

cũng muốn học viết lisp lắm, nhưng căn bản mình xuất phát từ dân kinh tế, không biết bắt đầu từ đâu nên chỉ ứng dụng các lisp có sẵn, còn lại vẫn phải nhờ các cao thủ giúp.

 Lisp của bạn mình test rồi, perfect cho công việc của mình, tuy chưa dùng với số lượng multiline lớn nhưng thấy số lượng nhỏ ra kết quả ok quá,nhưng bạn có thể nâng cấp giúp mình 1 chút xíu nữa được không? đó là thêm cột số lượng và gộp các multiline cùng layer cùng độ dài

 

@bác doanvanha: lâu quá không gặp bác, hồi trước bác viết giúp cái lisp ha đưa region về tâm hình học của region, giờ vẫn còn xài, ngon lắm bác Hà ạ. Thanks 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
nhoclangbat    382
 

- bạn cho nhoc file excel mẫu đc ko, nhoc chưa hỉu lắm ^^, ý bạn là các multiline cùng layer gộp lại làm 1 chiều dài các multiline đó cộng lại với nhau lun hay đếm có bao nhiêu multiline cùng 1 layer ^^

  • 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
nhoclangbat    382

- hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^

(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;=================================================================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=======================================================================
(defun c:kko (/ ss ds_ent ds_laydis layer dis info ds_tk ten_layer sl ds_new ko ds_tkk k1 k2 k3 K_join_ds)
;============================
(defun K_join_ds ( lst1 lst2 / tam  i ds_moi)
(setq i 0)
(foreach m lst1
(setq tam (append (nth i lst2) (list m)))
(setq ds_moi (append ds_moi (list tam)))
(setq i (1+ i))
)
ds_moi)
;================================================
(prompt "Quet chon cac Multiline ")
(setq ss (ssget '( (0 . "MLINE"))))
(if ss 
	(progn 
		(setq ds_ent (ss2ent ss))
			(foreach k ds_ent
				(setq info (entget k))
				(setq layer (acet-dxf 8 info))
				(setq dis (add_mline info))
				(setq ds_laydis (append ds_laydis (list (list  layer dis))))
			)
		(setq ds_new (LM:_UniqueFuzz ds_laydis 0.00001))
		(setq sl (mapcar '(lambda (z) (apply '+ (mapcar '(lambda (j) (if (equal j z 0.00001) 1 0)) ds_laydis))) ds_new))
		(setq ds_tk (K_join_ds sl ds_new))
	  (foreach u ds_tk
	  (setq k1 (LM:InsertNth "\t" 1 u) k2 (LM:InsertNth "\t" 2 k1) k3 (LM:InsertNth "\t" 4 k2))
	  (setq ds_tkk (append ds_tkk (list k3)))
	  )
	)
)
(xls ds_tkk '("LAYER" "\t" "\t" "CHIEU DAI" "\t" "SO LUONG") nil "Thong ke")
(princ)
)
;============================================================================================================================
(defun LM:InsertNth ( x n l )
  (
    (lambda ( i )
      (apply 'append
        (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l)
      )
    )
    -1
  )
)
;============================================================================================================================================
(defun LM:_UniqueFuzz ( l fz )
    (if l
      (cons (car l)
        (LM:_UniqueFuzz
          (vl-remove-if '(lambda ( x ) (equal x (car l)  fz)) (cdr l)) fz
        )
      )
    )
)
;==============================================================================================================================================
(vl-load-com)
(defun xls (Data-list	   header	  Colhide	 Name_list
	    /		   *aplexcel*	  *books-colection*
	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
	    *sheet-collection*		  col		 iz_listo
	    row		   cell		  cols
	   )
  (defun Letter	(N / Res TMP)
    (setq Res "")
    (while (> N 0)
      (setq TMP	(rem N 26)
	    TMP	(if (zerop TMP)
		  (setq	N   (1- N)
			TMP 26
		  )
		  TMP
		)
	    Res	(strcat (chr (+ 64 TMP)) Res)
	    N	(/ N 26)
      )
    )
    Res
  )
  (if (null Name_list)
    (setq Name_list "")
  )
  (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
    )
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
    )
  )
  (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
  (setq	Name_list (if (= Name_list "")
		    (vl-filename-base (getvar "DWGNAME"))
		    (strcat (vl-filename-base (getvar "DWGNAME"))
			    "&"
			    Name_list
		    )
		  )
	col	  0
	cols	  nil
  )
  (if (> (strlen Name_list) 26)
    (setq Name_list
	   (strcat (substr Name_list 1 10)
		   "..."
		   (substr Name_list (- (strlen Name_list) 13) 14)
	   )
    )
  )
  (vlax-for sh *Sheet-Collection*
    (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
  )
  (setq row Name_list)
  (while (member (strcase row) cols)
    (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
  )
  (setq Name_list row)
  (vlax-put-property *Sheet#1* 'Name Name_list)
  (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
  (vlax-put-property
    *AplExcel*
    "UseSystemSeparators"
    :vlax-false
  ) ;_?? ???????????? ????????? ?????????
  (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
  (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
  (vla-put-visible *AplExcel* :vlax-true)
  (setq	row 1
	col 1
  )
  (if (null header)
    (setq header '("X" "Y" "Z"))
  )
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (nth (1- col) header))
    )
    (setq col (1+ col))
  )
  (setq	row 2
	col 1
  )
  (repeat (length Data-list)
    (setq iz_listo (car Data-list))
    (repeat (length iz_listo)
      (vlax-put-property
	*excell-cells*
	"Item"
	row
	col
	(vl-princ-to-string (car iz_listo))
      )
      (setq iz_listo (cdr iz_listo)
	    col	     (1+ col)
      )
    )
    (setq Data-list (cdr Data-list))
    (setq col 1
	  row (1+ row)
    )
  )
  (setq	col (1+ (length header))
	row (1+ row)
  )
  (setq	cell (vlax-variant-value
	       (vlax-invoke-method
		 *Sheet#1*
		 "Evaluate"
		 (strcat "A1:" (letter col) (itoa row))
	       )
	     )
  ) ;_ end of setq
  (setq cols (vlax-get-property cell 'Columns))
  (vlax-invoke-method cols 'Autofit)
  (vlax-release-object cols)
  (vlax-release-object cell)
  (foreach item	ColHide
    (if	(numberp item)
      (setq item (letter item))
    )
    (setq cell (vlax-variant-value
		 (vlax-invoke-method
		   *Sheet#1*
		   "Evaluate"
		   (strcat item "1:" item "1")
		 )
	       )
    )
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-put-property cols 'hidden 1)
    (vlax-release-object cols)
    (vlax-release-object cell)
  )
  (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
  (mapcar 'vlax-release-object
	  (list	*excell-cells*	    *Sheet#1*
		*Sheet-Collection*  *New-Book*
		*Books-Colection*   *AplExcel*
	       )
  )
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
(defun add_mline ( elist / pt1 mline_len pt2 tot_len)
(setq tot_len 0.0)
  (foreach k	elist
    (cond ((= 10 (car k))
	   (setq pt1	   (cdr k)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car k))
	   (setq pt2	   (cdr k)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
 )

  • 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
tacongthang    11

các bạn cho hỏi chút,

hàm (setq ss (ssget '( (0. "MLINE")))) có thể chuyển thành chọn 1 lúc nhiều loại đối tượng được không?

vd như chọn "Mline", "line", "LWpolyline", "insert" cùng 1 lúc.

lisp của bạn nhoclangthang đúng ý mình rồi, tuy nhiên được "voi" lại đòi "hai bà tưng" nên mới sinh ra chuyện.

số là bv bên mình nó có thêm line để vẽ 1 số vật liệu khác, polyline là vật liệu tấm, và block cho vật tư đơn chiếc.

Thấy lisp làm ham quá nên cũng mày mò học lóm nhưng khi thay thế vài dòng thì nó chạy không được, các bác thông cảm nha, không biết gì nhưng vẫn thích vọc

 

1. nếu viết như thế này vào lisp kko thì nó không chạy: (setq ss (ssget '( (0. "MLINE") (0. "LINE") (0. "LWPOLYLINE") (0. "INSERT"))))

2. nếu viết thành 4 dòng và set ss1, ss2, ss3, ss4 thì kket quả xuất ra 4 lần, mặc dù mỗi lần quét chỉ chọn được 1 loại đối tượng

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
nhoclangbat    382

- hi  nếu bạn mún chọn nhiều lúc nhiều loại đối tượng thì viết như thế này ^^

(setq ss (ssget '( (0. "*LINE,INSERT"))))

- chọn thì ok nhưng chạy ra đc kết quả ko thì hên xui nha ^^

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
tacongthang    11

hì hì, cái này khó quá nên thôi thì nhờ luôn các cao thủ 

http://www.cadviet.com/upfiles/4/6784_vd_2.rar .

cũng vẫn lệnh kko, nhưng sau khi chọn một loạt đối tượng thì phân chia ra như sau, nhờ cao thủ giúp vậy,

1. Đối tượng Mline vẫn không thay đổi, vẫn là thống kê theo cùng tên layer, cùng độ dài, đếm số lượng

2.Đối tượng line thống kê theo tên lớp, độ dài tính tổng đặt cùng cột độ dài như đối tượng trên

3.Đối tượng INSERT thống kê theo tên block và đếm số lượng block có cùng tên

4. Đối tượng POLYLINE (cái này lúc vẽ chắc chắn sẽ vẽ khép kín), thống kê theo tên lớp, cùng kích thước dài và rộng, đếm số tấm. Đối tượng này kích thước được tính tấm nguyên, chỉ tính bề rộng và bề cao lớn nhất, không quan tâm đến số đỉnh của đa giá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

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


×