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

nhờ các anh sửa giúp lisp này như hình vẽ với ạ

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

-Cái này bạn nên yêu cầu muc đích cho công việc của bạn thì hay hơn chứ sửa cái lisp này thì chắc ít người giúp vì mọi người làm biến đọc cái lisp này nhìn hoa cả mắt

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ủa bạn đây

(defun C:Pick ( / LOOP NDUNG P PNT TOADOX TOADOY)
(setq loop T)
(while loop
	(setq Pnt (getpoint (strcat "\nPick \U+0111i\U+1EC3m tr\U+00EAn m\U+00E0n h\U+00ECnh:  ")))
	(cond
		  (T
		    (if Pnt
			   (progn
				(setq toadoY (/ (cadr (trans Pnt 1 0)) 1000.0))
				(setq toadoX (/ (car (trans Pnt 1 0)) 1000.0))
			     	(setq Ndung (strcat " X = " (rtos toadoX 2 3) " Y = " (rtos toadoY 2 3)))
				(setq p (getpoint Pnt "\nCh\U+1ECDn v\U+1ECB tr\U+00ED : "))
				(command "LEADER" Pnt p "" "" "Mtext" Ndung "")
			   )
		   	   (setq loop nil)
		     )
		)
	)
)
(princ)
)

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ủa bạn đây

(defun C:Pick ( / LOOP NDUNG P PNT TOADOX TOADOY L1 L2)
(setq loop T)
(setq L2 (list))
(while loop
  	(setq L1 (list))
	(setq Pnt (getpoint (strcat "\nPick \U+0111i\U+1EC3m tr\U+00EAn m\U+00E0n h\U+00ECnh:  ")))
	(cond
		  (T
		    (if Pnt
			   (progn
				(setq toadoY (/ (cadr (trans Pnt 1 0)) 1000.0))
				(setq toadoX (/ (car (trans Pnt 1 0)) 1000.0))
			     	(setq L1 (list toadoX toadoY))
			     	(setq L2 (append L2 (list L1)))
			     	(setq Ndung (strcat " X = " (rtos toadoX 2 3) " Y = " (rtos toadoY 2 3)))
				(setq p (getpoint Pnt "\nCh\U+1ECDn v\U+1ECB tr\U+00ED : "))
				(command "LEADER" Pnt p "" "" "Mtext" Ndung "")
			   )
		   	   (setq loop nil)
		     )
		)
	)
)
(if (vlax-get-or-create-object "Excel.Application")
			(WriteToExcel L2)
			(WriteToCSV L2)
)
(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)
		)
	)
)
(pr
  • 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


×