Đến nội dung


Hình ảnh
- - - - -

[NHỜ CHỈNH SỬA] lisp phun toạ độ lên CAD


  • Please log in to reply
1 reply to this topic

#1 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 30 March 2014 - 11:07 PM

Nhờ các member ai biết chỉnh sửa giúp mình Lisp phun tọa độ từ file TXT vào trong CAD với

- File txt mình có cáu trúc STT[dấu tab]X[dấu tab]Y[dấu tab]Z

- Khi chạy lisp, nó không hiển thị giá trị Z

Help !

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/20044-yeu-cau-lisp-phun-toa-do-cac-diem-tu-file-txt-vao-cad/page-3
;; 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)

)


  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 31 March 2014 - 10:04 AM

Nhờ các member ai biết chỉnh sửa giúp mình Lisp phun tọa độ từ file TXT vào trong CAD với

- File txt mình có cáu trúc STT[dấu tab]X[dấu tab]Y[dấu tab]Z

- Khi chạy lisp, nó không hiển thị giá trị Z

Help !

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/20044-yeu-cau-lisp-phun-toa-do-cac-diem-tu-file-txt-vao-cad/page-3
;; 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)

)

Hề hề hề,

Cái này đã nói đến nhiều lần trong cái topic mà bạn down load lisp này. Hãy tìm và đọc lại, đừng bắt người khác làm  cái  việc mà chính bạn cũng không muốn.

Hãy nhớ lời khuyên của thầy thuốc, đọc kỹ hướng dẫn sử dụng trước khi dùng.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.