Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
ngoclop

Nhờ viết lisp lọc các đối tượng là text trong một vùng kín xuất ra Excel

Bởi ngoclop , trong Sử dụng AutoCAD

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

 

Nhờ các bác viết hộ em lisp lọc các đối tượng là text trong một vùng kín (pline kín) sau đó xuất ra excel. Em cảm ơn các bác.

Hề hề hề,

Vùng kín ấy có nhiều rận lắm, lôi nó ra excel theo kiểu gì??? Bạn hãy gửi một bản vẽ mẫu và file excel mẫu lên nhé.

  • Vote tăng 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

KangKung    250

KangKung
Đã đăng

Nhờ các bác viết hộ em lisp lọc các đối tượng là text trong một vùng kín (pline kín) sau đó xuất ra excel. Em cảm ơn các bác.

Lisp của bạn đây. Vùng kín hay hở đều chơi hết.File xuất ra gồm có STT X Y và nội dung Text

;========LISP OUTPUT TEXT BEN TRONG PLINE==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
  (setq plst (acet-geom-vertex-list (car (entsel "\n Select pline:\n"))))
  (setq plst1 (vl-sort plst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
  (setq X_min(car (nth 0 plst1))
	X_max(car (last plst1)))
  (setq plst2 (vl-sort plst '(lambda (e1 e2) (if (/= (cadr e1) (cadr e2)) (< (cadr e1) (cadr e2)) (< (car e1) (car e2))))))
  (setq Y_min(cadr (nth 0 plst2))
	Y_max(cadr (last plst2)))
  (command "ZOOM" (list X_min Y_min) (list X_max Y_max))
  (setq taphop (ssget  "CP" plst '((0 . "TEXT"))))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Output File" Path "csv" 11) Path file)
  (setq file_out(open file "W"))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
      (setq InsertPoint(cdr(assoc 10 TEXT)))
      (setq InsertPoint(cdr(assoc 11 TEXT))))
    (setq String(cdr(assoc 1 TEXT)))
    (write-line (strcat (rtos (+ index 1) 2 0) "," (rtos (car InsertPoint) 2 3) "," (rtos (cadr InsertPoint) 2 3) "," String) file_out)
    (setq index (+ index 1))
    )
  (close file_out)
  (alert "Well done!")
  )
(princ "\n         Written By KangKung - 28/03/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")
  • Vote tăng 3

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Lôi các text đó ra thành một cột trong excel thôi bác Bình ah, em cảm ơn bác

Hề hề hề,

Ôi chao, nhiều rận quá.

Cột thì dễ rồi, nhưng trật tự xếp trong cột mới là vấn đề.cái lisp của bác KangKung sẽ cho trật tự là thứ tự các text được hình thành trong bộ chọn text.và sẽ chọn cả các text nằm trên biên vùng chọn. Còn nó có đúng hay không thì chỉ có bạn biết mà thô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

tientracdia    16

tientracdia
Đã đăng

 

Lisp của bạn đây. Vùng kín hay hở đều chơi hết.File xuất ra gồm có STT X Y và nội dung Text

;========LISP OUTPUT TEXT BEN TRONG PLINE==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
  (setq plst (acet-geom-vertex-list (car (entsel "\n Select pline:\n"))))
  (setq plst1 (vl-sort plst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
  (setq X_min(car (nth 0 plst1))
	X_max(car (last plst1)))
  (setq plst2 (vl-sort plst '(lambda (e1 e2) (if (/= (cadr e1) (cadr e2)) (< (cadr e1) (cadr e2)) (< (car e1) (car e2))))))
  (setq Y_min(cadr (nth 0 plst2))
	Y_max(cadr (last plst2)))
  (command "ZOOM" (list X_min Y_min) (list X_max Y_max))
  (setq taphop (ssget  "CP" plst '((0 . "TEXT"))))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Output File" Path "csv" 11) Path file)
  (setq file_out(open file "W"))
  (setq index 0)
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
      (setq InsertPoint(cdr(assoc 10 TEXT)))
      (setq InsertPoint(cdr(assoc 11 TEXT))))
    (setq String(cdr(assoc 1 TEXT)))
    (write-line (strcat (rtos (+ index 1) 2 0) "," (rtos (car InsertPoint) 2 3) "," (rtos (cadr InsertPoint) 2 3) "," String) file_out)
    (setq index (+ index 1))
    )
  (close file_out)
  (alert "Well done!")
  )
(princ "\n         Written By KangKung - 28/03/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

Cám ơn bạn KangKung về Lisp trên,

Mính có một file tọa độ điểm gồm : lớp điểm ( dạng point )  là tọa độ x,y ; lớp Số thứ tụ điểm, lớp cao độ , lớp code dạng ghi chú về điểm đó ( dạng text),

Xin  nhờ Bạn giúp mình Lisp xuất :  điểm point , text ra excel theo từng điểm theo hàng như sau : Số thứ tụ điểm đó - tọa độ X - tọa độ Y - Ghi chú. ( X,Y theo điểm point ).

File gởi kèm

http://www.cadviet.com/upfiles/3/114381_xuat_ra_excel.dwg

Cám ơn

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng (Đă chỉnh sửa)

Cám ơn bạn KangKung về Lisp trên,

Mính có một file tọa độ điểm gồm : lớp điểm ( dạng point )  là tọa độ x,y ; lớp Số thứ tụ điểm, lớp cao độ , lớp code dạng ghi chú về điểm đó ( dạng text),

Xin  nhờ Bạn giúp mình Lisp xuất :  điểm point , text ra excel theo từng điểm theo hàng như sau : Số thứ tụ điểm đó - tọa độ X - tọa độ Y - Ghi chú. ( X,Y theo điểm point ).

File gởi kèm

http://www.cadviet.com/upfiles/3/114381_xuat_ra_excel.dwg

Cám ơn

Hề hề hề,

Mình đã xem bản vẽ của bạn và có một vài ý kiến như sau:

1/- Một cụm point của bạn gồm có 4 đối tượng là; 1 text trên lớp "Dh_Caodo", 1 point trên lớp "Dh_Point", 1 text trên lớp "Dh_stt" và 1 text trên lớp "Dh_Code". Vì sao bạn không nhóm cả 4 đối tượng này vào một block thuộc tính để dễ dàng truy xuất nó mà để rời rạc như vậy. Điều này gây khó khăn cho việc chọn đối tượng cần truy xuất do khá nhiều điểm của bạn nằm liền kề nhau và có chung các thuộc tính chọn lựa.

2/- Với 4 đối tượng trong nhóm nhưng bạn chỉ cần truy xuất hai đối tượng là text trên lớp "Dh_stt" và point tên lớp "Dh_Point" thôi ư?? Các đối tượng khác có cần quan tâm không?? Nếu có thì nhét chúng vào đâu???

3/- Việc viết lisp này tuy không quá khó, nhưng trên diễn đàn cũng có khá nhiều lisp tương tự với yêu cầu của bạn rồi, sao bạn không thử tìm kiếm và lấy về dùng thử. Nếu có lisp nào bạn thấy gần phù hợp nhất với yêu cầu của bạn thì post lên để mọi người chỉnh giúp chỉnh sửa cho phù hợp, như vậy sẽ nhanh hơn nhiều là việc làm mới bạn ạ. Bạn cũng nên thông cảm với các lisper trên diễn đàn vì thời gian và sự kiên nhẫn hạn chế bạn ạ.

Hề hề hề,...

Và đây là lisp theo yêu cầu của bạn:

 
(defun c:xpt ( / oldos fn f ssc p1 p2 txt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq  fn (getfiled "Select Data File" "" "csv" 0)
          f (open fn "w")
          ssc (acet-ss-to-list (ssget "w" (setq p1 (getpoint "\n Chon diem goc tren ben trai vung chon"))
                                                             (setq p2 (getpoint p1 "\n Chon diem goc duoi ben phai vung chon"))
                                                             (list (cons 0 "point") (cons 8 "Dh_Point")))) 
          txt "" )
(foreach po ssc
        (setq txt (strcat (cdr (assoc 1 (entget (car (acet-ss-to-list (ssget "w" p1 p2
                                        (list (cons 0 "text") (cons 11 (cdr (assoc 10 (entget po)))) (cons 8 "Dh_stt")))))))) 
                                  (chr 44) (rtos (cadr (assoc 10 (entget po))) 2 2) 
                                  (chr 44) (rtos (caddr (assoc 10 (entget po))) 2 2)))
        (write-line txt f)
)
(close f)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)


 
Chúc bạn vui
 
Khuyến mãi cho bạn một lisp khác đơn giản hơn với cách dùng như cụ:




(defun c:xpt1 ( / oldos fn f ssc p1 p2 txt )


(vl-load-com)


(setq oldos (getvar "osmode"))


(setvar "osmode" 0)


(command "undo" "be")


(setq  fn (getfiled "Select Data File" "" "csv" 0)


          f (open fn "w")


          ssc (acet-ss-to-list (ssget "w" (setq p1 (getpoint "\n Chon diem goc tren ben trai vung chon"))


                                                             (setq p2 (getpoint p1 "\n Chon diem goc duoi ben phai vung chon"))


                                                             (list (cons 0 "text") (cons 8 "Dh_stt")))) 


          txt "" )


(write-line  "STT diem , Toa do X , Toa do Y , Ghi chu" f)


(foreach tex ssc


      (setq txt (strcat (cdr (assoc 1 (entget tex))) (chr 44) (rtos (cadr (assoc 11 (entget tex))) 2 2) 


                                 (chr 44) (rtos (caddr (assoc 11 (entget tex))) 2 2)) )


      (write-line txt f)


)


(close f)


(command "undo" "e")


(setvar "osmode" oldos)


(princ)


)






 





			
				


	Chỉnh sửa  theo phamthanhbinh 
	
		
Bổ sung lisp, sửa lỗ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

				

	

			
		

	



	



					
				
					
					
					






					
				
					
					
					







	

	

		

			
KangKung
			  

	
		
	
			 250
	
		
	

		

		

			


	
		KangKung
	

		

	

	
	

		



	

	

		

			
		


		

			Đã đăng  
			
				
				
			
		

	


	


	

		
		

			



Lisp không xuất ra file txt hay cvs được Bạn ơi.


Mong bạn giúp




Lỗi ở đây (setvar "osmde" 0). Sửa osmde thành osmode



			
		


		

			
				
					

	
	
		

			
				
				

					
						

	
	
    
	
		
			
			
  • 
				
					
				
						
							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

				

	

			
		

	



	



					
				
					
					
					






					
				
					
					
					







	

	

		

			
phamthanhbinh
			  

	
		
	
			 3.146
	
		
	

		

		

			


	
		phamthanhbinh
	

		

	

	
	

		



	

	

		

			
		


		

			Đã đăng  
			
				
				
			
		

	


	


	

		
		

			



Mình không hiểu, lisp yêu cầu chọn file csv  ???


Ý mình muốn chọn trong đa giác hay các điểm  rối xuất ra file thôi




Hề hề hề,


Lisp yêu cầu chọn file csv để bạn lưu dữ liệu xuất ra vào đó. Sau khi chọn file csv bạn sẽ phải chọn vùng chứa các điểm cần xuất theo phương pháp chọn bằng window. Nếu bạn muốn chọn vào polyline có sẵn thì phải thay đổi code. bạn hãy tham khảo lisp nói trên và tự sửa nhé. Nó không quá khó. Dơn giản chỉ là thay phương pháp chọn bằng window (w) thành phương pháp chọn bằng window polyline (wp). Tất nhiên lúc này bạn phải có code để xác định tọa độ các đỉnh của polyline. Trên diễn đàn đã có khá nhiều code về cách chọn này, bạn chịu khó tìm hiểu nhé. Mình lười rồi.



			
		


		

			
				
					

	
	
		

			
				
				

					
						

	
	
    
	
		
			
			
  • 
				
					
				
						
							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

				

	

			
		

	



	



					
				
					
					
					






					
				
			
			



		

	


	

	
		
		

			
				
				





	
	
		

			
				
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  
	
	

	

		
			Người theo dõi
			0
		
	




		

		

			



		

	







	

		
			
				Về Đầu Trang
				Sử dụng AutoCAD
			
		
	

	




	

	

	




						


					

					


					

				

			

			
		

		
		


	×