Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
thiennvpecc1

Xuất Tọa Độ Và Khoảng Cách Cộng Dồn Pline Ra File Excel

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

Nhờ các bác trên diễn đàn viết dùm lisp xuất tọa độ Y và khoảng cách cộng dồn theo phương ngang của pline (chọn nhiều pline) ra file excel.

Cám ơn các bác.

(em đã tìm trên diễn đàn nhưng không có cái nào tương tự)

http://www.cadviet.com/upfiles/5/10743_ban_ve_va_ket_qua.rar

  • Vote giảm 2

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ạn dùng thử cái này:

p/s: Bạn nên sửa tiêu đề trước khi bịi mod xóa bài :D

;Xuat X tuong doi va Y tuyet doi cua polyline
(defun c:XUAT( / ss lst_name fn pw i ename TT)
(vl-load-com)
(prompt "\nChon PL !")
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(cond 
	(ss
		(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT PL,Ten dinh,Y _tuyet doi,X _tuong doi" pw)
		(setq i 0)
		(while (< i (length lst_name))
			(setq	ename (nth i lst_name)
					i (1+ i)
					lst_ver (acet-geom-vertex-list ename)
					)
			(write-line (setq TT (itoa i)) pw)
			(MakeText (car lst_ver) TT 1 0 "C" nil "Lay_Lsp_XUAT" 2 nil)
			(foreach pnt lst_ver
				(write-line (strcat "," (rtos (1+ (vl-position pnt lst_ver))) "," (rtos (cadr pnt) 2 2) "," (rtos (- (car pnt) (car (car lst_ver))) 2 2)) pw)
			)
		)
	)
)
(close pw)
(alert (strcat "Da them " (itoa (length lst_name)) " Text STT PL vao ban ve !"))
(princ)
)
;===================================|;
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
  • 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

Cám ơn bạn rất nhiều

 

 

Bạn dùng thử cái này:

p/s: Bạn nên sửa tiêu đề trước khi bịi mod xóa bài :D

;Xuat X tuong doi va Y tuyet doi cua polyline
(defun c:XUAT( / ss lst_name fn pw i ename TT)
(vl-load-com)
(prompt "\nChon PL !")
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(cond 
	(ss
		(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT PL,Ten dinh,Y _tuyet doi,X _tuong doi" pw)
		(setq i 0)
		(while (< i (length lst_name))
			(setq	ename (nth i lst_name)
					i (1+ i)
					lst_ver (acet-geom-vertex-list ename)
					)
			(write-line (setq TT (itoa i)) pw)
			(MakeText (car lst_ver) TT 1 0 "C" nil "Lay_Lsp_XUAT" 2 nil)
			(foreach pnt lst_ver
				(write-line (strcat "," (rtos (1+ (vl-position pnt lst_ver))) "," (rtos (cadr pnt) 2 2) "," (rtos (- (car pnt) (car (car lst_ver))) 2 2)) pw)
			)
		)
	)
)
(close pw)
(alert (strcat "Da them " (itoa (length lst_name)) " Text STT PL vao ban ve !"))
(princ)
)
;===================================|;
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end

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ôi sử dụng nhưng sau khi gõ lệnh và chọn PL thì hộp thoại (chọn file để xuất kết quả) hiện lên. Tôi đặt tên và đường dẫn rồi Save với đuôi .csv nhưng sau khi vào tìm thì không thấy có gì 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ôi sử dụng nhưng sau khi gõ lệnh và chọn PL thì hộp thoại (chọn file để xuất kết quả) hiện lên. Tôi đặt tên và đường dẫn rồi Save với đuôi .csv nhưng sau khi vào tìm thì không thấy có gì cả.

Bạn không thấy gì cả là sao ? Không thấy file hay file không có nội dung ?

  • 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

Nhờ bạn Hiepttr giúp mình lisp gần giống như trên (mình gửi kèm file)

Cám ơn bạn rất nhiều

http://www.cadviet.com/upfiles/5/10743_vidu.rar

Bạn có thể diễn giải cụ thể hơn không ?!

- Pline luôn luôn chỉ có 3 đỉnh (gồm 2 đoạn thẳng) ?

- Bảng dữ liệu xuất ra mình thấy hơi lủng củng:

 Có phải "X_dinh 1 đến đỉnh 2" là X2-X1 và tương tự cho "X_dinh 2 đến đỉnh 3" ?

 

p/s: Nhìn có vẻ như bạn đang tìm cách nhận số liệu nova từ bản vẽ thủ công nhỉ :D

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ạn có thể diễn giải cụ thể hơn không ?!

- Pline luôn luôn chỉ có 3 đỉnh (gồm 2 đoạn thẳng) ?

- Bảng dữ liệu xuất ra mình thấy hơi lủng củng:

 Có phải "X_dinh 1 đến đỉnh 2" là X2-X1 và tương tự cho "X_dinh 2 đến đỉnh 3" ?

 

p/s: Nhìn có vẻ như bạn đang tìm cách nhận số liệu nova từ bản vẽ thủ công nhỉ :D

Gửi bạn Hiepttr.

Mình đang muốn lấy số liệu từ mặt cắt ngang.

pline chỉ gồm 3 đỉnh (điểm ngoài cùng bên trái, tim và ngoài cùng bên phải

thông số xuất ra excel thi đúng như bạn nói ở trên, nhưng các thông số ở cùng 1 dòng cell.

Nhờ bạn nghiên cứu giúp mình.

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

Nếu là lấy số liệu trắc ngang thì thế này không ổn rồi bạn ah ! (Mình tưởng rằng bạn chỉ tò mò cho vui :D )

Để lisp làm việc hiệu quả, phiền bạn cung cấp bản vẽ mẫu lên vậy !

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
Đăng nhập để thực hiện theo  

×