Chuyển đến nội dung
Diễn đàn CADViet
tuyphong_frv

[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ị

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

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

 (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 )

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
 (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. :(

  • 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
 (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

  • 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ậ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

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
Đâ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

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

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
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 đỡ.

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á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

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 đã 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ả:

123.jpg

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

Ở đâ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:

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
Ở đâ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

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
Ở đâ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.

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 đã 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ả:

123.jpg

 

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

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

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ó 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ừ.

  • 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

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

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

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 :)

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

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.

  • 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

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é

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 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á

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 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))

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

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


×