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

Nhờ Viết Lisp Tọa Độ Theo File Đính Kem

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

133575_toado.png

Nhờ các Pro viết dùm mình lisp như hình trên:

Khi pick điểm hiện ra các số thứ tự trên bảng vẻ,khi pick xong sẽ cho ngưòi dùng 3 lựa chọn.

1. Số thập phận 2 hoặc3 hoặc 4

2. xuất bảng trong Cad hoặc xuất sang excel

3.xuất bảng ra cad và excel luôn.

  • Vote giảm 4

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

Theo mình thì bài toán này không phải viết lisp đâu cho mệt óc đâu bạn ơi.

Bước 1: Bạn dùng lệnh Li lấy ra tọa độ dán vào excel.

Bước 2: Lập hàm trong excel lấy ra x, y và khoảng cách

Hi vọng là sẽ đúng ý bạn vì cái này ngày trước mình cũng làm nhiều rồi. Lisp ko hiệu quả lắm

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

Rảnh nên soạn sớ tấu cho bạn đây :D :D :D

(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
	(setq point p)
	(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
	(setq p (list i (car p) (cadr p))
	i (1+ i)
	lst (cons p lst)))
(if (> (length lst) 2)
	(progn
		(initget "Cad Excel cadAndexcel")
		(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cadAndexcel]"))
		(cond
			((wcmatch key "Cad") 
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			)
			((wcmatch key "Excel")
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
			(t
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			;;Xong chen bang trong cad
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
		)
	)
	(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)
;===================================
(defun MakeText (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)									
				(cons 50 (if Ang Ang 0))									
				(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
;=================================
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))								  
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)									
				(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq	pnt2 (polar base_pnt 0 celwidth)
		pnt3 (polar pnt2 (* 1.5 pi) celheight)
		pnt4 (polar pnt3 pi celwidth)
		)
(if justify (setq justify (strcase justify)))
(cond
	((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
	((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
	((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
	((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
	((wcmatch justify "TL")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
	((wcmatch justify "TC")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
	((wcmatch justify "TR")	(setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
	((wcmatch justify "ML")	(setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
	((wcmatch justify "MR")	(setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
	(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)

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

Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D

 

>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
	(setq point p)
	(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
	(setq p (list i (car p) (cadr p))
	i (1+ i)
	lst (cons p lst)))
(if (> (length lst) 2)
	(progn
		(initget "Cad Excel cadAndexcel")
		(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cad_And_excel]"))
		(cond
			((wcmatch key "Cad") 
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			)
			((wcmatch key "Excel")
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
			(t
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			;;Xong chen bang trong cad
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
		)
	)
	(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)

;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))								  
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)									
				(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq	pnt2 (polar base_pnt 0 celwidth)
		pnt3 (polar pnt2 (* 1.5 pi) celheight)
		pnt4 (polar pnt3 pi celwidth)
		)
(if justify (setq justify (strcase justify)))
(cond
	((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
	((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
	((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
	((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
	((wcmatch justify "TL")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
	((wcmatch justify "TC")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
	((wcmatch justify "TR")	(setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
	((wcmatch justify "ML")	(setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
	((wcmatch justify "MR")	(setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
	(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)
;===================================
(defun MakeText (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)									
				(cons 50 (if Ang Ang 0))									
				(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
;=================================

p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.

Phải chăng là do mình đã để ngõ tham số point trong đó.

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

Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D

 

>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
	(setq point p)
	(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
	(setq p (list i (car p) (cadr p))
	i (1+ i)
	lst (cons p lst)))
(if (> (length lst) 2)
	(progn
		(initget "Cad Excel cadAndexcel")
		(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cad_And_excel]"))
		(cond
			((wcmatch key "Cad") 
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			)
			((wcmatch key "Excel")
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
			(t
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			;;Xong chen bang trong cad
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
		)
	)
	(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)

;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))								  
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)									
				(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq	pnt2 (polar base_pnt 0 celwidth)
		pnt3 (polar pnt2 (* 1.5 pi) celheight)
		pnt4 (polar pnt3 pi celwidth)
		)
(if justify (setq justify (strcase justify)))
(cond
	((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
	((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
	((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
	((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
	((wcmatch justify "TL")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
	((wcmatch justify "TC")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
	((wcmatch justify "TR")	(setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
	((wcmatch justify "ML")	(setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
	((wcmatch justify "MR")	(setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
	(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)
;===================================
(defun MakeText (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)									
				(cons 50 (if Ang Ang 0))									
				(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
;=================================

p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.

Phải chăng là do mình đã để ngõ tham số point trong đó.

Hàm MakeText nằm trong hàm H:Creat... Vì vậy, chỉ khi hàm H:Creat... được sử dụng thì hàm MakeText mới được load. Trong lisp này thì hàm MakeText được gọi trước hàm H:Creat... nên nó chưa được load >> lỗ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

Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D

 

>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
	(setq point p)
	(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
	(setq p (list i (car p) (cadr p))
	i (1+ i)
	lst (cons p lst)))
(if (> (length lst) 2)
	(progn
		(initget "Cad Excel cadAndexcel")
		(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cad_And_excel]"))
		(cond
			((wcmatch key "Cad") 
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			)
			((wcmatch key "Excel")
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
			(t
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
					(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
				(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
			;;Xong lap lai dong 1 + k/cach khep
			;;Xong chen bang trong cad
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
 				(close pw)
			)
		)
	)
	(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)

;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))								  
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)									
				(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq	pnt2 (polar base_pnt 0 celwidth)
		pnt3 (polar pnt2 (* 1.5 pi) celheight)
		pnt4 (polar pnt3 pi celwidth)
		)
(if justify (setq justify (strcase justify)))
(cond
	((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
	((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
	((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
	((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
	((wcmatch justify "TL")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
	((wcmatch justify "TC")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
	((wcmatch justify "TR")	(setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
	((wcmatch justify "ML")	(setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
	((wcmatch justify "MR")	(setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
	(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)
;===================================
(defun MakeText (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)									
				(cons 50 (if Ang Ang 0))									
				(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
;=================================

p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.

Phải chăng là do mình đã để ngõ tham số point trong đó.

Cảm ơn bác hiepttr nhiều cơ bản lisp đã gần đúng ý em, em đã text và nhờ bác chỉnh lại cho em tí.

1. Khoảng cách các cột Tọa độ X,Y , K/CÁCH hơi rộng

2. Các Text chưa được canh giữa.

3. Phần câu lệnh xuất bảng kết quả sang Cad thì đã Ok, còn xuất sang Excel em đã làm nhưng xuất sang excel nhìn rất rối( các số gộp lại chung một cột) bác có cách nào khắc phục không, nếu không bác chuyển qua định dạng TXT luôn để e chuyển vào máy toàn đạt cắm mốc luôn.

4. Câu lênh xuất kết quả trên Cad và excel thì chỉ thấy kết quả trên cad còn trên Excel không thấy dấu hiệu gì.

Tiện thể mình gỡi Bác File cad mình bố trí bảng kết quả để bác chỉnh lại kích thước cho phù hợp 

http://www.cadviet.com/upfiles/5/133575_b2_03.dwg

  • Vote giảm 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

@Namgiang:

1. Khoảng cách này bạn đã không yêu cầu từ đầu >>> Ngại sửa lắm, nhưng đã sửa theo ý bạn.

2. Text chữ thì canh giữa, số thì canh Right (k/cach canh giữa là vì mình nhác, nếu không đã canh R) >>>> Mình bảo lưu, ko sửa.

3. Bạn cài đặt dấu thập phân cho Excel là đấu chấm "." nhé !

4. Có lẽ bạn đã không đặt lại tên file nên xuất file trùng tên vì trước đó bạn đã thử cho lựa chọn Excel

;lisp pick diem => xuat toa do thua ra cad, excel
;;So diem pick phai >2
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
;===================================
(defun MakeText (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)									
				(cons 50 (if Ang Ang 0))									
				(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
;=================================
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
	(setq point p)
	(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
	(setq p (list i (car p) (cadr p))
	i (1+ i)
	lst (cons p lst)))
(if (> (length lst) 2)
	(progn
		(setq #sole (NGT #sole 3 getint "So thap phan"))
		(initget "Cad Excel cadAndexcel")
		(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cadAndexcel]"))
		(cond
			((wcmatch key "Cad") 
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 #sole) nil)
					(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 #sole) nil)
					(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 #sole) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 #sole) nil)
			;;Xong lap lai dong 1 + k/cach khep
			)
			((wcmatch key "Excel")
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 #sole) "," (rtos (last (last lst)) 2 #sole)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 #sole) "," (rtos (last p) 2 #sole) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 #sole)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 #sole) "," (rtos (last (last lst)) 2 #sole) "," (rtos (distance last_pnt (cdr (last lst))) 2 #sole)) pw)
 				(close pw)
			)
			(t
				(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
				(setq base_pnt (getpoint "\nDiem chen: "))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
			;;Xong tieu de
				(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
				(setq last_pnt (cdr (last lst)))
			;;Xong dong 1
				(foreach p (cdr (reverse lst))
					(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
					(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 #sole) nil)
					(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
					(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 #sole) nil)
					(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
					(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 #sole) nil)
				)
			;;Xong cac diem giua
				(setq base_pnt (polar (polar base_pnt pi (* 20 #textheight)) (* 1.5 pi) (* 2 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 4 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
				(setq base_pnt (polar base_pnt 0 (* 4 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 8 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 #sole) nil)
				(setq base_pnt (polar base_pnt 0 (* 8 #textheight)))
				(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 7 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 #sole) nil)
			;;Xong lap lai dong 1 + k/cach khep
			;;Xong chen bang trong cad
				(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 				(setq pw (open fn "w"))
				(write-line "STT,X,Y,K/cach (m)" pw)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 #sole) "," (rtos (last (last lst)) 2 #sole)) pw)
				(setq last_pnt (cdr (last lst)))
 				(foreach p (cdr (reverse lst))
  				(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 #sole) "," (rtos (last p) 2 #sole) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 #sole)) pw)
				)
				(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 #sole) "," (rtos (last (last lst)) 2 #sole) "," (rtos (distance last_pnt (cdr (last lst))) 2 #sole)) pw)
 				(close pw)
			)
		)
	)
	(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)

;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))								  
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)									
				(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq	pnt2 (polar base_pnt 0 celwidth)
		pnt3 (polar pnt2 (* 1.5 pi) celheight)
		pnt4 (polar pnt3 pi celwidth)
		)
(if justify (setq justify (strcase justify)))
(cond
	((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
	((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
	((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
	((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
	((wcmatch justify "TL")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
	((wcmatch justify "TC")	(setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
	((wcmatch justify "TR")	(setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
	((wcmatch justify "ML")	(setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
	((wcmatch justify "MR")	(setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
	(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)

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ác hiệp đã giúp, khi nào Bác có thời gian chỉnh dùm em để hoàn thiện luôn nha.

Câu lệnh thứ 3 Cad and excel em đã thử mà vẫn không đuợc, chỉ có cad đươc ah.

Phần xuất toạ độ sang Excel Bác chỉnh  từng cột luôn cho 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

Cảm ơn vì bạn đã cảm ơn :D :D :D

Mình đã sửa rồi đó thôi, bạn có đọc được bài viết của mình ở trên không ???

Vẫn xảy ra lỗi có lẻ là do bạn thôi, hoặc là khả năng mình chỉ đến thế ... Ở máy mình vẫn chạy tốt mà ???

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

File excel của mình ra như vậy có giống bạn không, nó nằm chung hết một cột.

133575_loi.png

 

Nhờ bạn chỉ thêm cho mình, trường hợp mình muốn đổi tọa độ  X thành Y thì phải sữa lisp ở dòng lệnh nào

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ác cột trong file csv không phải lúc nào cũng phân cách bằng ","

Tham khảo Lee Mac

(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))

 

Nếu hiepttr chưa sửa lisp thì mở file csv bằng notepad, thay "," bằng ";" rồi save lạ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

MÌnh không rành về lisp , các tọa độ  x, y khi xuất sang Excel  có thể chia ra từng cột được không bạn, hay phai coppy làm thủ công

 

Nếu a Hiệp chưa sửa Lisp thì bạn sửa tạm trong file Excel cũng được mà ^^

Vào Data--> Text to Columns.... 

 

Chúc thành công !

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

@ ndtnv: Cảm ơn bác vì viên tăng lực :D

Nhưng có lẻ nên để "bạn í" sửa cài đặt một tí cho có vận động vì nếu

(vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList") trả lại là "," hoặc "." ... chắc mình không lường hết được "hậu quả" :D

 

>>>>> Phiền bạn cài đặt lại dấu thập phân là đấu chấm "." ... cho (cả Excel) và Control Panel\\International trước khi chạy lisp vậy ! :D :D :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

Các cột trong file csv không phải lúc nào cũng phân cách bằng ","

Tham khảo Lee Mac

(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))

 

Nếu hiepttr chưa sửa lisp thì mở file csv bằng notepad, thay "," bằng ";" rồi save lại

Để phân cột rõ ràng, nó còn phụ thuộc vào Decimal symbol và Digit grouping symbol nữa?

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

Không có ai xem dùm mình với.

Xem qua code thì thấy quá dài, muốn kiểm tra thì quá oải . Bài ở mục   #9

không biết bạn đã down về chưa mà cứ đòi Help hoài :) . Ở bài trướ đó thì

(initget "Cad Excel cadAndexcel")

(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cad_And_excel]"))

nên không nhận ra cadAndexcel thì đúng rồi. Nhưng bài ở mục 9 thì đã sửa :

(initget "Cad Excel cadAndexcel")

(setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cadAndexcel]"))

Chắc down nhiều quá nên lẫn lộn chăng :D

  • 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ác cột trong file csv không phải lúc nào cũng phân cách bằng ","

Tham khảo Lee Mac

(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))

 

Nếu hiepttr chưa sửa lisp thì mở file csv bằng notepad, thay "," bằng ";" rồi save lại

Để phân cột file .csv, nó phụ thuộc vào Decimal symbol. Nghĩa là khi ô màu đỏ là dấu "." thì biến (setq sep ","), khi ô màu đỏ là dấu "," thì biến (setq sep ";")

tất nhiên ô màu xanh là ăn theo (nếu Decimal symbol là "." thì Digit grouping là "," là ngược lại)

Bạn Test thử Lisp của Lee khi thay đổi Decimal symbol để kiểm nghiệm trong trường hợp này thì có lẽ Lee đã nhầm lẫn :)

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; Returns T if successful, else nil
(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w")) (progn
(setq sep (cond ( (vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))    
(foreach row lst (write-line (LM:lst->csv row sep) des)) (close des) t)))
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv (lst sep) 
(if (cdr lst) (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep) )) 
(defun LM:csv-addquotes (str sep / pos) 
(cond ((wcmatch str (strcat "*[`" sep "\"]*")) (setq pos 0)    
(while (setq pos (vl-string-position 34 str pos)) (setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)) ) (strcat "\"" str "\"") ) (str) )) ;;;;;
(defun c:test ( / ss fn in lst)
(if (and (setq ss (ssget '((0 . "POINT"))))
(setq fn (getfiled "Create Output File" "" "csv" 1)) ) (progn (repeat (setq in (sslength ss)) 
(setq lst (cons (mapcar 'rtos (cdr (assoc 10 (entget (ssname ss (setq in (1- in))))))) lst)) )
(if (LM:WriteCSV (reverse lst) fn) (startapp "explorer" fn)) )) (princ)) 

127397_csv_1.png

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


×