[Yêu cầu] lisp Phun tọa độ các điểm từ file txt vào CAD

Tháng 8 1, 2010

Cập nhật theo yêu cầu :
Lisp tạo ra 1 đ/tuợng POINT và 3 đ/tuợng TEXT như sau :

1. Lớp Point có kí hiệu điểm (cột 2-3)

2. Lớp Sothutu : TEXT Số thứ tự (cột 1)

3. Lớp Caodo : TEXT Cao độ (cột 4)

4. Lớp Code : TEXT Code (cột 5)

với định dạng của file điểm đo : STT X Y Z Code ,

chấp nhận kí tự phân biệt giữa các giá trị trong file điểm đo : dấu cách, dấu Tab, dấu phẩy.
(defun c:RFT(/ code data f h line pt pxy spc txt stt ten);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
(defun Split(str / i kitu line lst txtPhanbiet)
 (setq i 1 txtPhanbiet (strcat(chr 9)(chr 32)(chr 44)))
 (while (< i (strlen str))
   (setq kitu (substr str i 1))
   (if (vl-string-search kitu  txtPhanbiet)
     (progn
(if (null Lst)
  (setq Lst (list (substr Str 1 (- i 1))))
  (setq Lst (append Lst (list (read (substr Str 1 (- i 1)))))))
(setq Str (substr Str (+ i 1)) i 1))
     (setq i (1+ i)) )   )
 (setq Lst (append Lst (list Str)))  )
 (or *h* (setq *h* 2 ))
 (initget 6)
 (setq h (getdist (strcat "\nNhap chieu cao Text <" (rtos *h*) "> :")) )
 (if h (setq *h* h) (setq h *h*))
 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
     (or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
     (or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
     (or (tblsearch "layer" "Code") (command "-layer" "n" "Code" "c" 2 "Code" "") )
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))
  (progn
    (setq data (split Line) code (last data))
    (if (and
	  (= (vl-list-length data)5)
	  (setq pt (vl-remove code (cdr data)))
	  (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt))) )
      (progn
	(setq stt (car data) pXY (list (car pt)(cadr pt)))
	(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
	(vla-put-Layer (setq txt (vla-addtext spc stt (vlax-3d-point (list 0 0 0)) h)) "Sothutu")
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer (setq txt (vla-addtext spc code (vlax-3d-point (list 0 0 0)) h)) "Code")
	(vla-put-Alignment txt 6)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point (polar pXY 0 (* 0.2 h))))
	(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo")	))))) ) )
 (princ))
to : thanhduan2407

- Bạn tham khảo cách sử dụng hàm Split ở trên, chỉ đơn giản thay dòng (split Line "\t") bằng (split Line)

và dòng (vl-string-search "\t" Line) bằng (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))

- Nếu bạn đã biết VB thì việc học LISP rất đơn giản (Ngôn ngữ chỉ là cách thể hiện, thuật toán mới là vấn đề)

- Bạn có thể tham khảo bài Hướng dẫn lập trình Lisp, Hãy tự mình khám phá... của bác SSG.

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

Cháu sẽ cố gắng nghiên cứu

Autolisp thật là món quà tuyệt diệu

Có chỗ nào không hiểu mong bác giúp đỡ cháu nhiều.

Cháu không biết bác bao nhiêu tuổi xưng hô cho phải phép

Cháu năm nay 27 tuổi

Cảm ơn bác đã quan tâm đến bài viết

Tháng 8 2, 2010

 (defun trim (str)
 (while (and (/= str "") (= (substr str 1 1) " "))
   (setq str (substr str 2))
   (while (and (/= str "") (= (substr str (strlen str) 1) " "))
     (setq str    (substr    str 1 (1- (strlen str))))      
   )
 )
 str
)

Bác Gia_Bach à

Với ý tưởng là đọc 1 file txt với nhiều dấu cách hoặc nhiều dấu tab

Cháu đưa ra một ý tưởng: Cắt bỏ khoảng trống 2 đầu bằng hàm trim(str) sau đó kết hợp với hàm split của bác. Như vậy có ổn không ạ?

Bác có thể cho cháu một ý kiến được không?

(Hàm trim(str) cháu lấy từ diễn đàn )

Tháng 8 2, 2010

 (defun trim (str)
 (while (and (/= str "") (= (substr str 1 1) " "))
   (setq str (substr str 2))
   (while (and (/= str "") (= (substr str (strlen str) 1) " "))
     (setq str    (substr    str 1 (1- (strlen str))))      
   )
 )
 str
)
Bác Gia_Bach à

Với ý tưởng là đọc 1 file txt với nhiều dấu cách hoặc nhiều dấu tab

Cháu đưa ra một ý tưởng: Cắt bỏ khoảng trống 2 đầu bằng hàm trim(str) sau đó kết hợp với hàm split của bác. Như vậy có ổn không ạ?

Bác có thể cho cháu một ý kiến được không?

(Hàm trim(str) cháu lấy từ diễn đàn )

Đây là thao tác chuẩn hóa dữ liệu.

Bạn có thể sử dụng hàm Trim này, nhưng nó chỉ xóa bớt khoảng trắng (SPACE) còn các kí hiệu khác như dấu TAG, dấu phẩy thì chưa sử lý đuợc. Cần phải bổ sung thêm.

CadViet là diễn đàn dành cho tất cả mọi người, Bạn hạn chế trao đổi cá nhân hay ghi đích danh 1 ai đó.

Trên diễn đàn còn có rất nhiều nguời có khả năng giúp bạn ...

...
Cháu không biết bác bao nhiêu tuổi xưng hô cho phải phép

Cháu năm nay 27 tuổi

Cảm ơn bác đã quan tâm đến bài viết

Tui thuộc thế hệ 6X, đừng gọi bằng thằng là phải phép rùi. :(

Tháng 8 2, 2010

 (defun trim (str)
 (while (and (/= str "") (= (substr str 1 1) " "))
   (setq str (substr str 2))
   (while (and (/= str "") (= (substr str (strlen str) 1) " "))
     (setq str    (substr    str 1 (1- (strlen str))))      
   )
 )
 str
)
......

Cháu đưa ra một ý tưởng: Cắt bỏ khoảng trống 2 đầu bằng hàm trim(str) sau đó kết hợp với hàm split của bác. Như vậy có ổn không ạ?

......

(Hàm trim(str) cháu lấy từ diễn đàn )

Hàm vl-string-trim có chức năng tương tự như hàm trim(str) của bạn nhưng hay hơn là không những có thể loại bỏ khoảng trắng ở 2 đầu mà có thể loại bỏ các các kí tự không phải là khoảng trắng ở 2 đầu

Cú pháp : (vl-string-trim char-set str)

Ví dụ 1 :

(vl-string-trim " " "   CAD VIET  ")

-> Return : CAD VIET

Ví dụ 2 :

(vl-string-trim "-" "-----CAD VIET------")

-> Return : CAD VIET

Tháng 8 2, 2010

Cập nhật theo yêu cầu :
Lisp tạo ra 1 đ/tuợng POINT và 3 đ/tuợng TEXT như sau :

1. Lớp Point có kí hiệu điểm (cột 2-3)

2. Lớp Sothutu : TEXT Số thứ tự (cột 1)

3. Lớp Caodo : TEXT Cao độ (cột 4)

4. Lớp Code : TEXT Code (cột 5)

với định dạng của file điểm đo : STT X Y Z Code ,

chấp nhận kí tự phân biệt giữa các giá trị trong file điểm đo : dấu cách, dấu Tab, dấu phẩy.
(defun c:RFT(/ code data f h line pt pxy spc txt stt ten);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;    
 (vl-load-com)
(defun Split(str / i kitu line lst txtPhanbiet)
 (setq i 1 txtPhanbiet (strcat(chr 9)(chr 32)(chr 44)))
 (while (< i (strlen str))
   (setq kitu (substr str i 1))
   (if (vl-string-search kitu  txtPhanbiet)
     (progn
(if (null Lst)
  (setq Lst (list (substr Str 1 (- i 1))))
  (setq Lst (append Lst (list (read (substr Str 1 (- i 1)))))))
(setq Str (substr Str (+ i 1)) i 1))
     (setq i (1+ i)) )   )
 (setq Lst (append Lst (list Str)))  )
 (or *h* (setq *h* 2 ))
 (initget 6)
 (setq h (getdist (strcat "\nNhap chieu cao Text <" (rtos *h*) "> :")) )
 (if h (setq *h* h) (setq h *h*))
 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
     (or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
     (or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
     (or (tblsearch "layer" "Code") (command "-layer" "n" "Code" "c" 2 "Code" "") )
     (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))
  (progn
    (setq data (split Line) code (last data))
    (if (and
	  (= (vl-list-length data)5)
	  (setq pt (vl-remove code (cdr data)))
	  (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt))) )
      (progn
	(setq stt (car data) pXY (list (car pt)(cadr pt)))
	(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
	(vla-put-Layer (setq txt (vla-addtext spc stt (vlax-3d-point (list 0 0 0)) h)) "Sothutu")
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer (setq txt (vla-addtext spc code (vlax-3d-point (list 0 0 0)) h)) "Code")
	(vla-put-Alignment txt 6)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point (polar pXY 0 (* 0.2 h))))
	(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo")	))))) ) )
 (princ))
to : thanhduan2407

- Bạn tham khảo cách sử dụng hàm Split ở trên, chỉ đơn giản thay dòng (split Line "\t") bằng (split Line)

và dòng (vl-string-search "\t" Line) bằng (wcmatch Line (strcat "*"(chr 9)"*,*"(chr 32)"*,*`"(chr 44)"*"))

- Nếu bạn đã biết VB thì việc học LISP rất đơn giản (Ngôn ngữ chỉ là cách thể hiện, thuật toán mới là vấn đề)

- Bạn có thể tham khảo bài Hướng dẫn lập trình Lisp, Hãy tự mình khám phá... của bác SSG.

Bác Gia_bach à!

Có sử dụng thì mới biết là có nhiều vấn đề nhỏ trong một vấn đề lớn.

Cháu đã sử dụng được hàm của bác nhưng có một vấn đề là: Mã Code của cháu chỉ sử dụng được từ viết liền nhau, nếu có dấu cách hoặc dấu tab hoặc dấu phẩy trong mã Code thì sẽ báo lỗi. Cháu hiểu lỗi này vì nó sẽ tách tất cả các kí tự trong một dòng. Lại mong bác chỉnh sửa giúp cháu. (cháu rất ngại vì là 1 người lắm chuyện, không chịu suy nghĩ) cháu sẽ cố gắng để sau này được như bác. Thà nhận là không biết gì còn hơn là giấu dốt ko chịu tìm hiểu. Kính mong thư bác hồi âm

Tháng 8 3, 2010

Đây là thao tác chuẩn hóa dữ liệu.
Bạn có thể sử dụng hàm Trim này, nhưng nó chỉ xóa bớt khoảng trắng (SPACE) còn các kí hiệu khác như dấu TAG, dấu phẩy thì chưa sử lý đuợc. Cần phải bổ sung thêm.

CadViet là diễn đàn dành cho tất cả mọi người, Bạn hạn chế trao đổi cá nhân hay ghi đích danh 1 ai đó.

Trên diễn đàn còn có rất nhiều nguời có khả năng giúp bạn ...

Tui thuộc thế hệ 6X, đừng gọi bằng thằng là phải phép rùi. :(

Cảm ơn bác Gia_bach rất nhiều

Tháng 8 3, 2010

Hàm vl-string-trim có chức năng tương tự như hàm trim(str) của bạn nhưng hay hơn là không những có thể loại bỏ khoảng trắng ở 2 đầu mà có thể loại bỏ các các kí tự không phải là khoảng trắng ở 2 đầu
Cú pháp : (vl-string-trim char-set str)

Ví dụ 1 :
(vl-string-trim " " "   CAD VIET  ")
-> Return : CAD VIET

Ví dụ 2 :
(vl-string-trim "-" "-----CAD VIET------")
-> Return : CAD VIET

Cảm ơn anh Tue_NV rất nhiều

Không chỉ có Autolisp tuyệt diệu mà diễn dàn cũng thật tuyệt diệu

Cảm ơn tất cả những ai đã tham gia http://www.cadviet.com

Tháng 9 20, 2010

Lisp có trục trặc:
Nếu hàng nào có đủ 5 cột thì nó hiểu cột thứ 5 là "độ cao" còn cột thứ tư bị lờ đi

Trong trắc địa trục X là trục bắc, Y là trục đông, khác với trục toạ độ Đề các trong toán học, do vậy lisp đã thể hiện vị trí points sai.

Các point được bắn vào cad là 2D , nên gán Z cho nó để còn sử dụng vào việc tạo bình đồ. Nếu ai không cần chế độ 3D point thì chỉ cần sử dụng lệnh là phẳng là xong

Bác xem lại các vấn đề trên.

Đúng là Lissp trên có trục trặc, mong được các anh giúp đỡ.

Tháng 10 9, 2010

Cái này mình mạn phép chỉnh bản quyền của tác giả 1 ty để làm theo yêu cầu của bạn

Có gì pm nhé

;; free lisp from cadviet.com
(defun c:RFT (/ code data f h line pt pxy spc txt stt ten)
				;Read File Txt
     ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;
 (vl-load-com)
 (defun Split (str / i kitu line lst txtPhanbiet)
   (setq i 1
  txtPhanbiet
   (strcat (chr 9) (chr 32) (chr 44))
   )
   (while (< i (strlen str))
     (setq kitu (substr str i 1))
     (if (vl-string-search kitu txtPhanbiet)
(progn
  (if (null Lst)
    (setq Lst (list (substr Str 1 (- i 1))))
    (setq Lst (append Lst (list (read (substr Str 1 (- i 1))))))
  )
  (setq	Str (substr Str (+ i 1))
	i   1
  )
)
(setq i (1+ i))
     )
   )
   (setq Lst (append Lst (list Str)))
 )
 (or *h* (setq *h* 2))
 (initget 6)
 (setq	h (getdist (strcat "\nNhap chieu cao Text <" (rtos *h*) "> :")
  )
 )
 (if h
   (setq *h* h)
   (setq h *h*)
 )
 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point")
  (command "-layer" "n" "Point" "")
     )
     (or (tblsearch "layer" "Sothutu")
  (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "")
     )
     (or (tblsearch "layer" "Caodo")
  (command "-layer" "n" "Caodo" "c" 4 "Caodo" "")
     )
     (or (tblsearch "layer" "Code")
  (command "-layer" "n" "Code" "c" 2 "Code" "")
     )
     (setq spc	(vla-get-ModelSpace
	  (vla-get-ActiveDocument (vlax-get-Acad-Object))
	)
     )
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (wcmatch
      Line
      (strcat "*" (chr 9) "*,*" (chr 32) "*,*`" (chr 44) "*")
    )
  (progn
    (setq data (split Line)
	  code (last data)
    )
    (if	(and
	  (= (vl-list-length data) 5)
	  (setq pt (vl-remove code (cdr data)))
	  (not (vl-catch-all-error-p
		 (vl-catch-all-apply 'vlax-3d-point pt)
	       )
	  )
	)
;;;neu du lieu data co 5 bien so
      (progn
	(setq stt (car data)
	      pXY (list (car pt) (cadr pt))
	)
	(vla-put-Layer
	  (vla-addpoint spc (vlax-3d-point pXY))
	  "Point"
	)
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      stt
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Sothutu"
	)
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      code
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Code"
	)
	(vla-put-Alignment txt 6)
	(vla-put-TextAlignmentPoint
	  txt
	  (vlax-3d-point (polar pXY 0 (* 0.2 h)))
	)
	(vla-put-Layer
	  (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h)
	  "Caodo"
	)
      )
      ;;het progn list data=5
;;;neu du lieu data co 4 bien so (ban co the dung ham COND hoac if de bay loi
      (progn
	(setq pt (vl-remove code (cdr data)))
	(not (vl-catch-all-error-p
	       (vl-catch-all-apply 'vlax-3d-point pt)
	     )
	)
	(setq stt (car data)
	      pXY (list (car pt) (cadr pt))
	)
	(vla-put-Layer
	  (vla-addpoint spc (vlax-3d-point pXY))
	  "Point"
	)
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      stt
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Sothutu"
	)
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer
	  (vla-addtext spc (last data) (vlax-3d-point pXY) h)
	  "Caodo"
	)
      )
;;;het progn list=4
    )
  )
)
     )
   )
 )
 (princ)
)

Nhờ Bạn giúp mình chỉnh cách thể hiện lại trên Cad theo hệ trắc địa, X của mình hiện nay sang Y, và Y của mình hiện nay sang X.

Rất mong được sự giúp đở của Bạn

Tháng 10 9, 2010

Mình đã làm xong cho bạn rồi, phần chuyển dữ liệu từ txt sang cad , rất nhanh, miễn tab hay cách đều ok ( bao nhiêu cũng đc)

tạo đầy đủ layer cho bạn, text hiển thị lấy theo text style hiện thời

file gốc bạn để tại C:\goc.txt (dữ liệu như bạn đã nói)

Các modul sau bạn cứ nói cụ thể mình sẽ làm tiếp

Lệnh là FC (fun cad =))), đã chỉnh x là trục bắc , y là trục nam cho bạn

:cheers:

Tải tệp lisp và video hướng dẫn tại :

http://www.fileserve.com/file/Z4H6eF7

Đây là kết quả:

Tháng 10 9, 2010

Ở đây mình đã thêm tính năng chèn điểm cho bạn luôn :cheers:

http://www.mediafire.com/?54uog3g0lzawr5l

Lệnh là (defun c:acc()

ACC

Như vậy còn tính năng xuất từ điểm và text ra txt cho bạn nữa thôi nhé :cheers: :cheers:

Tháng 10 11, 2010

Ở đây mình đã thêm tính năng chèn điểm cho bạn luôn :cheers:

http://www.mediafire.com/?54uog3g0lzawr5l

Lệnh là (defun c:acc()

ACC

Như vậy còn tính năng xuất từ điểm và text ra txt cho bạn nữa thôi nhé :cheers: :cheers:

Cám ơn KS.PhanThanhTu đã giúp mình.

file của bạn mình dùng lệnh ACC thêm điểm thì được, riêng lệnh FC khi gọi lệnh thì không ra kết qua. Không biết buộc phải dùng Acad2007 hay sao vậy bạn.?

Không nhất thiết file tọa độ *.txt phải ở ổ C, cho vào thư mục bất kỳ nào cũng được. Mong được bạn chỉ giúp.

Riêng còn một vấn đề này nửa, nhờ bạn giúp : sau khi chèn điểm vào bản vẽ với số thứ tự và cao độ mình có một file tổng hợp chung, cần chọn tất cả các điểm đó xuất ra file text với các nội dung sau STT X Y Caodo Code , Xin được Bạn giúp đỡ. Cám ơn

Tháng 10 20, 2010

Ở đây mình đã thêm tính năng chèn điểm cho bạn luôn :lol:

http://www.mediafire.com/?54uog3g0lzawr5l

Lệnh là (defun c:acc()

ACC

Như vậy còn tính năng xuất từ điểm và text ra txt cho bạn nữa thôi nhé :lol: :lol:

Xin chào bạn KS.PhanThanhTu

Mình rất muốn xem mã Code của bạn nhưng phần bạn viết có xen vào VBA mà bạn lại để pass nên mình pó tay không xem được.

Rất mong bạn có thể gửi cho mình bản ko khoá. (VBA)

Cảm ơn bạn nhiều.

Tháng 6 8, 2011

Mình đã làm xong cho bạn rồi, phần chuyển dữ liệu từ txt sang cad , rất nhanh, miễn tab hay cách đều ok ( bao nhiêu cũng đc)

tạo đầy đủ layer cho bạn, text hiển thị lấy theo text style hiện thời

file gốc bạn để tại C:\goc.txt (dữ liệu như bạn đã nói)

Các modul sau bạn cứ nói cụ thể mình sẽ làm tiếp

Lệnh là FC (fun cad =))), đã chỉnh x là trục bắc , y là trục nam cho bạn

:cheers:

Tải tệp lisp và video hướng dẫn tại :

http://www.fileserve.com/file/Z4H6eF7

Đây là kết quả:

Anh ơi anh upload lại link video va file hướng dẫn đi anh, link bị die rồi,

Mà em load file text2cad.dvb không được, là lỗi gì vậy anh?

Em đang dùng cad 2010

Tháng 2 24, 2012

Có bác nào giúp em chỉnh sửa lisp của bác Gia_Bach http://www.cadviet.c.../80142_rft2.lsp

;; free lisp from cadviet.com
(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com 			|;  
 (vl-load-com)
 (defun Split (Str Char / Lst pos)
(while (setq pos (vl-string-search Char Str))
 	(if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
 	(setq Str (substr Str (+ pos 2)) ))
(setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
 	(or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
 	(or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
 	(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
 	(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
 	(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
 	(setq f (open (findfile ten) "r"))
 	(while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
(setq data (split Line "\t" )
val (car data)
pt  (cdr data))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
  	(progn
 (setq pXY (list (car pt)(cadr pt)))
 (vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
 (vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")
 (vla-put-Alignment str 8)
 (vla-put-TextAlignmentPoint str (vlax-3d-point pXY))
 (vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo") )))))  ))
 (princ))

với yêu cầu:

- File text dạng : SST,Y,X,Z,Code

- Độ cao Z có dấu chấm ở hàng thập phân nằm đúng vào vị trí tọa độ (X,Y) của điểm đó .

Em xin cảm ơn trước.

Tháng 2 24, 2012

File Text + CAD đâu bạn ????

Tháng 2 24, 2012

Có bác nào giúp em chỉnh sửa lisp của bác Gia_Bach http://www.cadviet.c.../80142_rft2.lsp

;; free lisp from cadviet.com
(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
 ;|  By : Gia Bach, gia_bach @  www.CadViet.com 			|;  
 (vl-load-com)
 (defun Split (Str Char / Lst pos)
(while (setq pos (vl-string-search Char Str))
 	(if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
 	(setq Str (substr Str (+ pos 2)) ))
(setq Lst (append Lst (list (read Str)))))

 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
 	(or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
 	(or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
 	(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
 	(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
 	(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
 	(setq f (open (findfile ten) "r"))
 	(while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
  (progn
(setq data (split Line "\t" )
val (car data)
pt  (cdr data))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
  	(progn
 (setq pXY (list (car pt)(cadr pt)))
 (vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
 (vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")
 (vla-put-Alignment str 8)
 (vla-put-TextAlignmentPoint str (vlax-3d-point pXY))
 (vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo") )))))  ))
 (princ))

với yêu cầu:

- File text dạng : SST,Y,X,Z,Code

- Độ cao Z có dấu chấm ở hàng thập phân nằm đúng vào vị trí tọa độ (X,Y) của điểm đó .

Em xin cảm ơn trước.

Bạn muốn như vậy thì phải tạo block Att rồi. Sau đó tách thành 2 kiểu nguyên và phần sau dấu phẩy. Cái này tôi làm được nhưng không có thời gian. Bác Ketxu sẽ giúp bạn nếu bạn đưa ra 1 file mẫu.

Chú ý với bất cứ ai yêu cầu đều phải đưa file mẫu lên.

Hề hề. Ketxu quan tâm mừ.

Tháng 2 24, 2012

File Text + CAD đâu bạn ????

File text: http://www.cadviet.c.../3/80142_11.txt

Cad: http://www.cadviet.com/upfiles/3/80142_drawing_2.dwg

Cái này em xuất bằng NOVA.Nhưng Nova xuất ra phần cao độ Z thành 2 phần text (textcaodococ và textcaodomia) riêng biệt. Khi mình muốn chỉnh cho text bé lại ( để phù hợp với tỉ lệ bản đồ) thì 2 phần nguyên va phần thập phân lại cách quá xa dấu "."

Tháng 2 24, 2012

Yêu cầu này mình đã xử lý 1 lần. Hiện giờ tìm lại bài rất khó, lúc nào rảnh có thể tìm hoặc viết, tuy nhiên cũng phải nói luôn với bạn việc text

Độ cao Z có dấu chấm ở hàng thập phân nằm đúng vào vị trí tọa độ (X,Y) của điểm đó

là hoàn toàn hên xui, chỉ gần đúng chứ không thể đúng. Chỉ có thể làm đúng 100% nếu tách biệt 3 cái như NOVA đã làm :)

Tháng 2 24, 2012

Thực ra khi đã xuất ra được thành 3 đối tượng như bạn có thì và mục đích là muốn chỉnh kích thước text thì bài toán mình nghỉ không cần đọc file txt nửa.

-Điểm point hiện nay có cao độ vậy theo mình bài toán chỉ cần:

-Tắt 2 text trước và sau đi. (cái này bạn dùng layoff)

-Giữ nguyên point hiện có (để làm nguyên liệu cho lisp và các phần mềm can thiệp sau này).

-Lisp chỉ cần đọc z của point và viết ra 1 text tại point này lệch tí cũng không sao (khi in tắt luôn cái point đi).

Lúc này công việc quá đơn giản. OK?

LIsp đó như này:

 
(Defun c:kthtr ()
(setvar "MODEMACRO" "CHINH CAO DO HIEN TRANG")
(command "-layer" "new" "SOCAODOSUACHUA" "color" "50" "SOCAODOSUACHUA" "")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(Princ "\nHay chon vung :")
(setq XX (ssget '((0 . "POINT,CIRCLE"))))
(setq L 0)
(setq M (sslength XX))
(while (< L M)
  (setq DT (ssname XX L))
  (setq DT (entget DT))
  (setq TEXT (cdr (assoc 10 DT)))
 (setq x (car TEXT))
 (setq y (cadr TEXT))
 (setq z (caddr TEXT))
 (command "-layer" "set" "SOCAODOSUACHUA" "")
 (command "TEXT" "c" (list (+ x 0)(- y 0)) 1 0 (rtos Z 2 2))
  (setq L (1+ L))
)
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
 	(Princ)
)

Vui lòng tắt chế độ bắt điểm trước khi chạy lisp vì cái này trong bộ tổng hợp mình chưa sửa lưu và trả biến này nên xóa bén đi rồi.

Tháng 2 24, 2012

Yêu cầu này mình đã xử lý 1 lần. Hiện giờ tìm lại bài rất khó, lúc nào rảnh có thể tìm hoặc viết, tuy nhiên cũng phải nói luôn với bạn việc text

là hoàn toàn hên xui, chỉ gần đúng chứ không thể đúng. Chỉ có thể làm đúng 100% nếu tách biệt 3 cái như NOVA đã làm :)

-_- Thôi thì méo mó có hơn không.Lúc nào anh tìm cho em nhé

Tháng 2 25, 2012

Cảm ơn các bạn đồng nghiệp!

Mình rất hay phải sử dụng file dữ liệu dạng này, nếu được xin nhờ các bạn sửa point thành vòng tròn. Nếu mà nhập được trực tiếp file từ excel hoặc từ word thì tốt quá

Tháng 5 23, 2012

Làm sao để đổi Point => Circle vậy Gia_Bach

Tháng 5 23, 2012

Mình không biết làm sao để chỉnh lisp này để khi phun điểm lên acad điểm tọa độ point sang hình tròn cả

nhờ anh em chỉ dùm. Cảm ơn nhiều

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=20044

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt

;| By : Gia Bach, gia_bach @ www.CadViet.com |;

(vl-load-com)

(defun Split (Str Char / Lst pos)

(while (setq pos (vl-string-search Char Str))

(if (null Lst)

(setq Lst (list (substr Str 1 pos)))

(setq Lst (append Lst (list (read (substr Str 1 pos))))))

(setq Str (substr Str (+ pos 2)) ))

(setq Lst (append Lst (list (read Str)))))

(if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))

(progn

(or (tblsearch "layer" "point") (command "-layer" "n" "point" "") )

(or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )

(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )

(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))

(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))

(setq f (open (findfile ten) "r"))

(while (setq Line (read-line f))

(if (vl-string-search "\t" Line)

(progn

(setq data (split Line "\t" )

val (car data)

pt (cdr data))

(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))

(progn

(setq pXY (list (car pt)(cadr pt)))

(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "point")

(vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")

(vla-put-Alignment str 8)

(vla-put-TextAlignmentPoint str (vlax-3d-point pXY))

(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo") ))))) ))

(command "Zoom" "E" "")

(princ))

Tháng 5 23, 2012

Làm sao để đổi Point => Circle vậy Gia_Bach

Mình không biết làm sao để chỉnh lisp này để khi phun điểm lên acad điểm tọa độ point sang hình tròn cả

..............

Hình tròn - Circle thì phải có bán kính chứ ?

bán kính lấy ở đâu ?

Bạn nên đưa file cad lên thì mọi nguời mới có đủ thông tin để giúp đuợc.

Đăng nhập

[Yêu cầu] lisp Phun tọa độ các điểm từ file txt vào CAD

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

thanhduan2407 272

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

thanhduan2407 272

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

gia_bach 1.549

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

Tue_NV 3.912

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

thanhduan2407 272

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

thanhduan2407 272

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

thanhduan2407 272

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

khaosat2009 11

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

khaosat2009 11

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

KS.PhanThanhTu 76

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

KS.PhanThanhTu 76

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

khaosat2009 11

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

thanhduan2407 272

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

secam 0

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

lonzthjeura 0

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

ketxu 2.984

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

thanhduan2407 272

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

lonzthjeura 0

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

ketxu 2.984

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

duy782006 1.544