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

Nhờ viết Lsp xuất toạ độ tâm block

Bởi hoangtienphuchung2014 , trong AutoLisp

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

PhamYen    2

PhamYen
Đã đăng
4 giờ trước, hoangtienphuchung2014 đã nói:

Hiện tại mình có file gồm các block! Mình muốn nhờ các bạn viết cho mình xin cái Lsp xuất toạ độ tâm block sang file excel! thanks các bạn nhiều

FILE-GOC.dwg

ban dung cai nay cua bac Duân

xtdbl.lsp

  • Like 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

thanhduan2407    272

thanhduan2407
Đã đăng
8 giờ trước, hoangtienphuchung2014 đã nói:

Cảm ơn bác Duân và Phạm Yến đã viết và chia sẻ! Mình vừa tải về nhưng lúc chạy thử thì báo lỗi! Thật làm phiền các bạn lần nữa nhé

Bạn ấy gửi thiếu hàm!
  

(defun C:00 (/ DEM I LTSBL LTSDONG SSBL TDO)
;;;;;;;XUAT TOA DO BLOCK
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq ssBl (ssget (list (cons 0 "INSERT"))))
  (if ssBl
    (progn
      (setq LtsBl (acet-ss-to-list ssBl))
      (setq LtsDong nil)
      (setq i 1)
      (foreach eBl LtsBl
	(setq Tdo (cdr (assoc 10 (entget eBl))))
	(setq LtsDong (append LtsDong
			      (list (list (rtos i 2 0)
					  (rtos (cadr Tdo) 2 3)
					  (rtos (car Tdo) 2 3)
					  (rtos (caddr Tdo) 2 3)
				    )
			      )
		      )
	)
	(setq i (1+ i))
      )

      (setq Dem (length LtsDong))
      (alert
	(strcat	"\nC\U+00F3 t\U+1EA5t c\U+1EA3 "
		(rtos Dem 2 0)
		" \U+0111\U+01B0\U+1EE3c xu\U+1EA5t t\U+1ECDa \U+0111\U+1ED9"
	)
      )
      (if (/= Dem 0)
	(progn
	  (if (vlax-get-or-create-object "Excel.Application")
	    (WriteToExcel LtsDong)
	    (WriteToCSV LtsDong)
	  )
	)
      )
    )
  )

  (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 1)
  (foreach pt lst_data
    (setq col 1)
    (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
	    (LM:lst->str pt ",")
	    fl
	  )
	)
	(close fl)
      )
    )
  )
  (princ)
)
 ;|«Visual LISP© Format Options»
(200 2 60 2 nil "end of " 80 9 0 0 0 T T T T)
;*** DO NOT add text below the comment! ***|;

 

  • Like 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

lon ton    2

lon ton
Đã đăng

Bác có thể dùng cái C2F.vlx này, nó có thể xuất tất tần tật các thông số của các loại đối tượng (text, block, line, Pl...) ra file csv.

C2F.rar

  • Like 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

dinhsyha    0

dinhsyha
Đã đăng
21 giờ trước, lon ton đã nói:

Bác có thể dùng cái C2F.vlx này, nó có thể xuất tất tần tật các thông số của các loại đối tượng (text, block, line, Pl...) ra file csv.

C2F.rar

 Lisp này mình không xuất được thông tin của polyline, quét chọn polyline nhưng lisp vẫn báo không tìm thấy đố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

dinhtiennd94    4

dinhtiennd94
Đã đăng
Vào lúc 8/6/2020 tại 11:04, lon ton đã nói:

Bác có thể dùng cái C2F.vlx này, nó có thể xuất tất tần tật các thông số của các loại đối tượng (text, block, line, Pl...) ra file csv.

C2F.rar

lisp này của Bác ạ,Bác xem lại giúp e với e xuất tọa độ của các đối tượng point,block... thì chuẩn, còn đối tượng text thì nó lệch hệ met mấy đơn vị

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

7o7    81

7o7
Đã đăng
9 giờ trước, dinhtiennd94 đã nói:

lisp này của Bác ạ,Bác xem lại giúp e với e xuất tọa độ của các đối tượng point,block... thì chuẩn, còn đối tượng text thì nó lệch hệ met mấy đơn vị

Lạ nhỉ!! Text mà cũng cần lấy toạ độ? Text thì có canh trái, phải, trên, dưới, giữa đủ kiểu thì lấy toạ độ nào cho chính xác? Bạn thử đưa bản vẽ có text cần lấy toạ độ xem nó ra làm sao.

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

thanhduan2407    272

thanhduan2407
Đã đăng (Đă chỉnh sửa) 
(defun C:00 (/ I LTSDONG LTSTEXT SSTEXT TDO)
;;;;;;;XUAT TOA DO TEXT
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq ssText (ssget (list (cons 0 "TEXT"))))
  (if ssText
    (progn
      (setq LtsText (acet-ss-to-list ssText))
      (setq LtsDong nil)
      (setq i 1)
      (foreach eT LtsText
	(setq Tdo (TD:Text-Base eT))
	(setq LtsDong (append LtsDong
			      (list (list (rtos i 2 0)
					  (rtos (cadr Tdo) 2 3)
					  (rtos (car Tdo) 2 3)
					  (rtos (caddr Tdo) 2 3)
				    )
			      )
		      )
	)
	(setq i (1+ i))
      )
      (if (> (length LtsDong) 0)
	(progn
	  (if (vlax-get-or-create-object "Excel.Application")
	    (WriteToExcel LtsDong)
	    (WriteToCSV LtsDong)
	  )
	)
      )
    )
  )
  (princ)
)
(defun TD:Text-Base (ent / MA71 MA72 X11 Ma10 Ma11)
  (setq Ma10 (cdr (assoc 10 (entget ent))))
  (setq Ma11 (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71 (cdr (assoc 71 (entget ent))))
  (setq Ma72 (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3))
	  (and (= Ma71 0) (= Ma72 5))
      )
    Ma10
    Ma11
  )
)
(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 1)
  (foreach pt lst_data
    (setq col 1)
    (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
	    (LM:lst->str pt ",")
	    fl
	  )
	)
	(close fl)
      )
    )
  )
)

 

Chỉnh sửa theo thanhduan2407
Bổ sung hàm

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
Về Đầu Trang AutoLisp
×