Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hotanphi

Nhờ viết lisp xuất text từ cad sang excel dạng cột theo thứ tự chọn

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

Trên diễn đàn cũng có nhiều lisp xuất text sang excel nhưng vẫn không được như yêu cầu cần làm, nên em mong các bác giúp đỡ:

 

Lisp yêu cầu là nhấp chuột chọn một loạt sau đó lisp sẽ xuất các text vừa chọn ra file excel hoặc CSV theo một cột với tứ tự như thứ tự pick chọn text bên cad.

Ví dụ: chọn các text theo thứ tự pick là: H1,H2,H3,4,5,7,H4.... thì khi xuất ra excel sẽ là dạng cột như sau:

H1

H2

H3

4

5

7

H4

...

...

 

Xin cảm ơn các anh.

PS: Mình đã tìm kiếm trên diễn đàn nhưng ko thấy có lisp như vậy. Ko biết nếu đã có nhờ anh em chon xin link.

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

Đưa file lên đi bạn. Tôi viết cho. Hình như bạn yêu cầu vấn đề này ở nhiều chủ đề rồi đúng không? Đưa file cad để check đi 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

Đây bạn. Test thử nếu có gì thì Reply liền nhé

Xin cảm ơn bạn. Mình mới nhờ lần đầu tiên bạn ạh và cũng là chủ đề duy nhất. Đây là file cad

http://www.cadviet.com/upfiles/3/104866_vd.dwg


(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

)

)

)

(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:ttt(/ lst ss i el x fn)

(setq lst (list) ss (ssget (list (cons 0 "TEXT"))) )

(repeat (setq i (sslength ss))

(setq x (ssname ss (setq i (1- i))))

(setq el (entget x))

(if (= (cdr (assoc 0 el)) "TEXT")

(setq lst (append lst (list (list (cdr (assoc 1 el))))))

)

)

(setq fn (vl-filename-mktemp nil nil ".csv"))

(if (and lst (LM:WriteCSV (reverse lst) fn))

(startapp "explorer" fn)

)

)

  • Vote tăng 2

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 bạn. Test thử nếu có gì thì Reply liền nhé


(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

)

)

)

(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:ttt(/ lst ss i el x fn)

(setq lst (list) ss (ssget (list (cons 0 "TEXT"))) )

(repeat (setq i (sslength ss))

(setq x (ssname ss (setq i (1- i))))

(setq el (entget x))

(if (= (cdr (assoc 0 el)) "TEXT")

(setq lst (append lst (list (list (cdr (assoc 1 el))))))

)

)

(setq fn (vl-filename-mktemp nil nil ".csv"))

(if (and lst (LM:WriteCSV (reverse lst) fn))

(startapp "explorer" fn)

)

)

Xin cảm ơn bạn. Mình thử được rồi. Chúc bạn sức khỏe và 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

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

Đăng nhập để thực hiện theo  

×