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

[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

[thanhduan2407 272]

(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

[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

[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

[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