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

cần giúp đở lấy tọa độ các điểm polyline

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

minhblack    0

Mình cần xuất tọa độ  các đường polyline 2d (đươc kết hợp từ line và arc) được chọn là từ file .dxf (chỉ gồm các đường polyline)

bằng vba . Nhờ các bạn giúp dùm bằng ct hay chỉ cách lấy tọa độ từ .dxf củng được . cám ơn nhiều

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    226
(defun c:XTDPL ( / e ss item Tdo Code LtsVer i j n X Y Z STT L1 L2 L3 L4 L5 Dem);;;;;;;;;;;;;;;;;XUAT TOA DO PLINE
(vl-load-com)
(setvar "CMDECHO" 0)
(setq L5 (list))
(setq j 0)
(setq Dem 0)
(setq ss (ssget (list  (cons 0  "POLYLINE,LWPOLYLINE"))))
(while
  	(setq item (nth j (acet-ss-to-list ss)))
  	(setq i 0)
  	(setq L1 (list))
	(setq L2 (list))
	(setq L3 (list))
	(setq L4 (list))
  	(setq LtsVer (acet-geom-vertex-list item))
  	(setq L1 (list (strcat "Polyline co tat ca: " (rtos (length LtsVer) 2 0) " dinh")))
  	(while (setq P (nth i LtsVer))
		(setq L2 (list  (rtos (+ i 1) 2 0)  (rtos (cadr p) 2 3)  (rtos (car p) 2 3) (rtos (caddr p) 2 3) ))
	  	(setq L3 (append L3 (list L2)))
		(setq i (1+ i))
	)
  	(setq L3 (append (list L1) L3))
  	(setq L5 (append L5 L3))
  	(setq j (1+ j))
  	(setq Dem (1+ Dem))
)
(if (vlax-get-or-create-object "Excel.Application")
			(WriteToExcel L5)
			(WriteToCSV L5)
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 " (rtos Dem 2 0) " \U+0111\U+01B0\U+1EE3c phun t\U+1ECDa \U+0111\U+1ED9"))
(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 (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl)
			)
			(close fl)
		)
	)
)
(princ)
)

Bạn thử xem

  • 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
minhblack    0

Cám ơn bạn rất nhiều . Điều thứ nhất là mình quên ngôn ngử lisp (lâu quá không đụng tới khoảng 6,7 năm) , mình cần bằng visual basic nhưng mà mình sẻ tìm hiểu cấu trúc chương trình của bạn và chuyển sang visua basic coi sao.

Điều thứ 2 là vì vấn đề bản quyền mình không xài autoucad mà mình xài Nanocad(free) mà chạy lisp thì bị báo lổi và không thể kiểm tra bị lổi ở lệnh nào nên mình phải xuất các đường polyline mà mình chọn ra .dxf rồi từ đó mình mới lấy tọa độ và bán kính r

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
anhcau    0

Cám ơn bạn rất nhiều . Điều thứ nhất là mình quên ngôn ngử lisp (lâu quá không đụng tới khoảng 6,7 năm) , mình cần bằng visual basic nhưng mà mình sẻ tìm hiểu cấu trúc chương trình của bạn và chuyển sang visua basic coi sao.

Điều thứ 2 là vì vấn đề bản quyền mình không xài autoucad mà mình xài Nanocad(free) mà chạy lisp thì bị báo lổi và không thể kiểm tra bị lổi ở lệnh nào nên mình phải xuất các đường polyline mà mình chọn ra .dxf rồi từ đó mình mới lấy tọa độ và bán kính r

 

mình đang dùng Nanocad 5.0 

Nó miễn phí cài khoảng một số lần cho mỗi account gì đó, hình như 10 lần.

Bạn phải đăng ký trên website của nó, rồi chọn .. nó sẽ gửi cho một mã cài tương ứng với phiên bản đó.

Nói chung là dùng free

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
dung2471991    0

tại sao em dùng cad 2010 không mở được file này, khi mở lên ở trong không có gì cả. mà trong khi đó bên người gửi bảo vẫn mở bình thường và in bình thường. ai giúp em 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

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


×