Đến nội dung


Hình ảnh
- - - - -

[ yêu cầu ] Lisp up nội dung từ Excel vào Cad


  • Please log in to reply
42 replies to this topic

#1 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 25 March 2013 - 02:51 PM

Mình có một file excel và Cad, muốn up nội dung từ excel vào cad  theo thứ tự của tên ô trên các vòng tròn kí hiệu.

Dựa và tên ô chèn và thay thế nội dung CCTC, dientich, khoiluong và đúng vị trì nó.
File gởi kèm:

Rất mong được giúp đỡ. Cám ơn

  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 25 March 2013 - 06:47 PM

Mình có một file excel và Cad, muốn up nội dung từ excel vào cad  theo thứ tự của tên ô trên các vòng tròn kí hiệu.

Dựa và tên ô chèn và thay thế nội dung CCTC, dientich, khoiluong và đúng vị trì nó.
File gởi kèm:

Rất mong được giúp đỡ. Cám ơn
Similar topics from web:

Hề hề hề,

Bạn thử dùng cái này xem có phù hợp không nhé. Sử dụng với file bản vẽ bạn gửi nhé. Nếu OK bạn có thể sử dụng và chỉnh sửa cho phù hợp với các bản vẽ khác nhau.

 

(defun c:upsl ( / oldos ssc fn f str ans txl txt p0 et1 et2 et3 )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq ssc (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 3)))))
(setq  fn (getfiled "Select Data File" "" "csv" 0)
            f (open fn "r")
            ans "Y"
)
(while (and (/= (setq str (read-line f)) nil) (= (strcase ans) "Y") (/= ssc nil) ) 
           (setq txl (separate str (chr 44))  )
           (foreach etxt ssc
                   (setq txt (cdr (assoc 1 (entget etxt))))
                   (if (= txt (nth 0 txl))
                       (progn
                              (setq p0 (cdr (assoc 11 (entget etxt))))
                              (setq et1 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_CDTC") (cons 62 130))) 0)
                                        et2 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 2))) 0)
                                        et3 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_KLOV") (cons 62 31))) 0)
                             )
                             (entmod (subst (cons 1 (nth 1 txl)) (assoc 1 (entget et1)) (entget et1)))
                             (entmod (subst (cons 1 (nth 2 txl)) (assoc 1 (entget et2)) (entget et2)))
                             (entmod (subst (cons 1 (nth 3 txl)) (assoc 1 (entget et3)) (entget et3)))
                             (setq ssc (vl-remove etxt ssc))
                      )
                 )
           )
)
(close f)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Separate (S sym / i L ch)
(setq i 0 L nil)
(while (< i (strlen S))
      (setq i (1+ i) ch (substr S i 1))
      (if (= ch sym) (progn
    (setq
          L (append L (list (substr S 1 (- i 1))))
          S (substr S (1+ i) (- (strlen S) i))
          i 0
    )
      ))    
)
(append L (list S))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Chúc bạn vui.

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

#3 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 25 March 2013 - 07:23 PM

Thêm 1 Lisp nữa cho bạn đây.

http://www.cadviet.c...cel_vao_cad.lsp

Lệnh KK nhé. Sau đó chọn file số liệu (chuyển sang dạng txt ngăn cách bởi dấu tab hoặc space) rồi chọn số liệu trên bản vẽ.

Tuy nhiên để chạy lisp này thì bạn copy file sau đây vào thư mục Support trong CAD

http://www.cadviet.c...s/3/71162_a.dwg

;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU==========
;================KANGKUNG 25/03/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path)
    (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2))
  (setq Path file)
  (setq taphop(ssget '((0 . "TEXT"))))
  (setq index 0)
  (setq TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT)))
	  )
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))
	)
      )
    (setq index (1+ index))
    )
  (setq file_in(open file "R"))
  (setq lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(command "insert"  "a"  (cadr dt)  "1" "1" "0"
		   (vl-princ-to-string(car lst))
		   (vl-princ-to-string(cadr lst))
		   (vl-princ-to-string(caddr lst))
		   (vl-princ-to-string(cadddr lst)))
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (setvar "OSMODE" os)
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

  • 1

#4 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 25 March 2013 - 08:08 PM

Hề hề hề,

Bạn thử dùng cái này xem có phù hợp không nhé. Sử dụng với file bản vẽ bạn gửi nhé. Nếu OK bạn có thể sử dụng và chỉnh sửa cho phù hợp với các bản vẽ khác nhau.

 

(defun c:upsl ( / oldos ssc fn f str ans txl txt p0 et1 et2 et3 )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq ssc (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 3)))))
(setq  fn (getfiled "Select Data File" "" "csv" 0)
            f (open fn "r")
            ans "Y"
)
(while (and (/= (setq str (read-line f)) nil) (= (strcase ans) "Y") (/= ssc nil) ) 
           (setq txl (separate str (chr 44))  )
           (foreach etxt ssc
                   (setq txt (cdr (assoc 1 (entget etxt))))
                   (if (= txt (nth 0 txl))
                       (progn
                              (setq p0 (cdr (assoc 11 (entget etxt))))
                              (setq et1 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_CDTC") (cons 62 130))) 0)
                                        et2 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 2))) 0)
                                        et3 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))
                                                              (list (cons 0 "text") (cons 8 "Main_KLOV") (cons 62 31))) 0)
                             )
                             (entmod (subst (cons 1 (nth 1 txl)) (assoc 1 (entget et1)) (entget et1)))
                             (entmod (subst (cons 1 (nth 2 txl)) (assoc 1 (entget et2)) (entget et2)))
                             (entmod (subst (cons 1 (nth 3 txl)) (assoc 1 (entget et3)) (entget et3)))
                             (setq ssc (vl-remove etxt ssc))
                      )
                 )
           )
)
(close f)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Separate (S sym / i L ch)
(setq i 0 L nil)
(while (< i (strlen S))
      (setq i (1+ i) ch (substr S i 1))
      (if (= ch sym) (progn
    (setq
          L (append L (list (substr S 1 (- i 1))))
          S (substr S (1+ i) (- (strlen S) i))
          i 0
    )
      ))    
)
(append L (list S))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Chúc bạn vui.

 

Cám ơn Bạn. Lisp này chỉ thay được nội dung ở Vị trí CDTC và diện tích, còn vị trí Khối lượng không thay được Bạn ợi.

Mong bạn xem giúp mình với.


  • 0

#5 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 25 March 2013 - 08:14 PM

Thêm 1 Lisp nữa cho bạn đây.

http://www.cadviet.c...cel_vao_cad.lsp

Lệnh KK nhé. Sau đó chọn file số liệu (chuyển sang dạng txt ngăn cách bởi dấu tab hoặc space) rồi chọn số liệu trên bản vẽ.

Tuy nhiên để chạy lisp này thì bạn copy file sau đây vào thư mục Support trong CAD

http://www.cadviet.c...s/3/71162_a.dwg

;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU==========
;================KANGKUNG 25/03/2013=======================
(defun C:KK()
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if (not Path)
    (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2))
  (setq Path file)
  (setq taphop(ssget '((0 . "TEXT"))))
  (setq index 0)
  (setq TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT)))
	  )
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))
	)
      )
    (setq index (1+ index))
    )
  (setq file_in(open file "R"))
  (setq lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(command "insert"  "a"  (cadr dt)  "1" "1" "0"
		   (vl-princ-to-string(car lst))
		   (vl-princ-to-string(cadr lst))
		   (vl-princ-to-string(caddr lst))
		   (vl-princ-to-string(cadddr lst)))
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (setvar "OSMODE" os)
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Lisp của bạn thì xuất nội dung thuộc tính cần phải nhập vào riêng từng ô thì quá lâu khi mình sửa. Mong bạn xem giúp lại.

Mình muốn quét tất cả các ô, chọn file excel, *.cvs hay *.txt dựa vào tên ô và lisp thay thế vào các ô Cad hàng loat.

Rất mong được sự giúp đỡ. CÁm ơn nhiều.


  • 0

#6 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 25 March 2013 - 09:40 PM

Không muốn dùng Block Attribute thì chơi Lisp này, đúng theo yêu cầu luôn.

http://www.cadviet.c..._cad_rev1_1.lsp

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))) os(getvar "OSMODE"))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file index 0 TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT))))
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))))
    (setq index (1+ index)))
  (setq file_in(open file "R") lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(car lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_CDTC") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (cadr lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 2) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (caddr lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_KLOV") (cons 62 31) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (cadddr lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  )
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

  • 1

#7 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 March 2013 - 07:26 AM

Lisp này tuyệt quá rồi KangKung ơi. Cám ơn nhiều nha. Cho mình xin hỏi thêm tí. Vòng tròn trên mình dùng cho kí hiệu ô lưới 10 m, nếu có sự thay đổi kích cở của vòng tròn ( Ô lưới 5m ) Lisp có bị ảnh hưởng gì không ?? nhờ bạn giúp. Bạn viết Lisp hay qua, xin giải thích giúp mình các dòng lệnh của lisp này để mình học tâp với. ;;----------------------------------------------------------------- Xin phép bạn đừng nghĩ là mình thế này nọ nha... Nhờ bạn giúp mình Lisp : xuất ngược các nội dung từ Cad ( Theo mẫu cũ trên ) ra Excel với các nội dung STTO - CCTC - DIENTICH - KHOILUONG Trong vòng tròn ra Excel theo theo từng hàng, file xuất nằm cùng thư mục và cùng tên của cad . Rất Cám ơn


  • 0

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 26 March 2013 - 08:30 AM

Lisp này tuyệt quá rồi KangKung ơi. Cám ơn nhiều nha. Cho mình xin hỏi thêm tí. Vòng tròn trên mình dùng cho kí hiệu ô lưới 10 m, nếu có sự thay đổi kích cở của vòng tròn ( Ô lưới 5m ) Lisp có bị ảnh hưởng gì không ?? nhờ bạn giúp. Bạn viết Lisp hay qua, xin giải thích giúp mình các dòng lệnh của lisp này để mình học tâp với. ;;----------------------------------------------------------------- Xin phép bạn đừng nghĩ là mình thế này nọ nha... Nhờ bạn giúp mình Lisp : xuất ngược các nội dung từ Cad ( Theo mẫu cũ trên ) ra Excel với các nội dung STTO - CCTC - DIENTICH - KHOILUONG Trong vòng tròn ra Excel theo theo từng hàng, file xuất nằm cùng thư mục và cùng tên của cad . Rất Cám ơn

 

Nếu bạn quản lý đối tượng bằng Block Attributes thì Xuất xuôi, xuất ngược bằng ATTIN và ATTOUT


  • 1

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 26 March 2013 - 11:02 AM

Cám ơn Bạn. Lisp này chỉ thay được nội dung ở Vị trí CDTC và diện tích, còn vị trí Khối lượng không thay được Bạn ợi.

Mong bạn xem giúp mình với.

Hề hề hề,

Bạn hãy kiểm tra lại bản vẽ bạn sủ dụng ví mình đã test với file số liệu và file bản vẽ mà bạn gửi thì nó chạy ngon lành, đổi theo đúng yêu cầu. Hãy lưu ý rằng nếu các đối tượng text của bạn không đúng với các điều kiện lọc (layer, color) trong lisp (tương ứng với bản vẽ bạn gửi) thì nó sẽ không thay đổi được.


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

#10 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 26 March 2013 - 11:48 AM

Lisp này tuyệt quá rồi KangKung ơi. Cám ơn nhiều nha. Cho mình xin hỏi thêm tí. Vòng tròn trên mình dùng cho kí hiệu ô lưới 10 m, nếu có sự thay đổi kích cở của vòng tròn ( Ô lưới 5m ) Lisp có bị ảnh hưởng gì không ?? nhờ bạn giúp. Bạn viết Lisp hay qua, xin giải thích giúp mình các dòng lệnh của lisp này để mình học tâp với. ;;----------------------------------------------------------------- Xin phép bạn đừng nghĩ là mình thế này nọ nha... Nhờ bạn giúp mình Lisp : xuất ngược các nội dung từ Cad ( Theo mẫu cũ trên ) ra Excel với các nội dung STTO - CCTC - DIENTICH - KHOILUONG Trong vòng tròn ra Excel theo theo từng hàng, file xuất nằm cùng thư mục và cùng tên của cad . Rất Cám ơn

Hề hề hề,

Bạn hãy thử test lisp này với các bản vẽ có chứa các text số hoặc chữ khác ngoài các text cần sửa xem sao nhé. 

Nếu thay đổi kích thước vòng tròn thì phải chú ý kẻo các text cần thay sẽ nhảy ra khỏi vòng tròn  hoặc không nằm đúng vị trí cũ đâu.

Việc xuất ngược số liệu từ bản vẽ vào file csv hay file txt thì trên diễn đàn có nhiều lắm rồi. Bạn hãy tìm kiếm và chọn lấy cho mình cái gì phù hợp nhé.


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

#11 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 26 March 2013 - 11:59 AM

Lisp này tuyệt quá rồi KangKung ơi. Cám ơn nhiều nha. Cho mình xin hỏi thêm tí. Vòng tròn trên mình dùng cho kí hiệu ô lưới 10 m, nếu có sự thay đổi kích cở của vòng tròn ( Ô lưới 5m ) Lisp có bị ảnh hưởng gì không ?? nhờ bạn giúp. Bạn viết Lisp hay qua, xin giải thích giúp mình các dòng lệnh của lisp này để mình học tâp với. ;;----------------------------------------------------------------- Xin phép bạn đừng nghĩ là mình thế này nọ nha... Nhờ bạn giúp mình Lisp : xuất ngược các nội dung từ Cad ( Theo mẫu cũ trên ) ra Excel với các nội dung STTO - CCTC - DIENTICH - KHOILUONG Trong vòng tròn ra Excel theo theo từng hàng, file xuất nằm cùng thư mục và cùng tên của cad . Rất Cám ơn

Lisp #6 chỉ đúng với trường hợp cụ thể như bản vẽ của bạn gửi thôi. Nếu bạn muốn xuất ngược xuất xuôi số liệu thì tốt nhất là dùng Block Attribute như Lisp #3. Lisp #3 có ưu điểm nữa là nếu bạn  vẽ cho lưới 5m, 10m, 100m ... đều được hết, để làm điều đó bạn chỉ cần chỉnh lại vị trí của các Text trong bản vẽ đính kèm mục #3 thôi.

Tiện đây cho bạn cái lisp xuất số liệu Block Attribute từ CAD sang txt. Bạn dùng Lisp #3 và Lisp này là có thể chuyển đổi số liệu từ CAD sang TXT và ngược lại ngon lành rồi.

http://www.cadviet.c...t_attribute.lsp

;=====LISP CONVERT ATTRIBUTE TO TEXT==========
;=========KANGKUNG 26/03/2013=================
(defun C:KK()
  (IF (NOT PATH)
    (SETQ PATH (getvar "dwgprefix")))
  (setq taphop(ssget '((0 . "INSERT")))	index 0 tenfileout(getfiled "Output File" PATH "txt" 11))
  (SETQ PATH tenfileout tenfile(open tenfileout "W"))
  (write-line "No.	Easting	Northing	STTO	CCTC	D.TICH	K.LUONG" tenfile)
  (setq i 0)
  (while (< index (sslength taphop))
    (setq enlist (entget (ssname taphop index))i(1+ i) STT(rtos i 2 0)
	  insert_point(cdr(assoc 10 enlist))
	  CHUOI (strcat STT "\t" (rtos (car insert_point) 2 3) "\t" (rtos (cadr insert_point) 2 3))
	  EN2(ENTNEXT(ssname taphop index))
	  ENLIST2(ENTGET EN2))
    (while (/= (cdr(assoc 0 enlist2)) "SEQEND")
      (SETQ VALUE(cdr(assoc 1 enlist2))
	    TAG(cdr(assoc 2 enlist2))
	    CHUOI(STRCAT CHUOI "\t" VALUE)
	    en2(entnext en2)
	    enlist2(entget en2))
      )
    (write-line CHUOI tenfile)
    (setq index (+ index 1))
    )
  (alert (strcat (rtos i 2 0) " objects converted!"))
  (princ)
  (close tenfile)
  (COMMAND "NOTEPAD" tenfileout)
)
(princ "\n                Written By KangKung - 26/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

  • 1

#12 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 March 2013 - 04:21 PM

Lisp #6 chỉ đúng với trường hợp cụ thể như bản vẽ của bạn gửi thôi. Nếu bạn muốn xuất ngược xuất xuôi số liệu thì tốt nhất là dùng Block Attribute như Lisp #3. Lisp #3 có ưu điểm nữa là nếu bạn  vẽ cho lưới 5m, 10m, 100m ... đều được hết, để làm điều đó bạn chỉ cần chỉnh lại vị trí của các Text trong bản vẽ đính kèm mục #3 thôi.

Tiện đây cho bạn cái lisp xuất số liệu Block Attribute từ CAD sang txt. Bạn dùng Lisp #3 và Lisp này là có thể chuyển đổi số liệu từ CAD sang TXT và ngược lại ngon lành rồi.

http://www.cadviet.c...t_attribute.lsp

;=====LISP CONVERT ATTRIBUTE TO TEXT==========
;=========KANGKUNG 26/03/2013=================
(defun C:KK()
  (IF (NOT PATH)
    (SETQ PATH (getvar "dwgprefix")))
  (setq taphop(ssget '((0 . "INSERT")))	index 0 tenfileout(getfiled "Output File" PATH "txt" 11))
  (SETQ PATH tenfileout tenfile(open tenfileout "W"))
  (write-line "No.	Easting	Northing	STTO	CCTC	D.TICH	K.LUONG" tenfile)
  (setq i 0)
  (while (< index (sslength taphop))
    (setq enlist (entget (ssname taphop index))i(1+ i) STT(rtos i 2 0)
	  insert_point(cdr(assoc 10 enlist))
	  CHUOI (strcat STT "\t" (rtos (car insert_point) 2 3) "\t" (rtos (cadr insert_point) 2 3))
	  EN2(ENTNEXT(ssname taphop index))
	  ENLIST2(ENTGET EN2))
    (while (/= (cdr(assoc 0 enlist2)) "SEQEND")
      (SETQ VALUE(cdr(assoc 1 enlist2))
	    TAG(cdr(assoc 2 enlist2))
	    CHUOI(STRCAT CHUOI "\t" VALUE)
	    en2(entnext en2)
	    enlist2(entget en2))
      )
    (write-line CHUOI tenfile)
    (setq index (+ index 1))
    )
  (alert (strcat (rtos i 2 0) " objects converted!"))
  (princ)
  (close tenfile)
  (COMMAND "NOTEPAD" tenfileout)
)
(princ "\n                Written By KangKung - 26/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Vẫn không xuất ra txt được bạn ơi. Bạn xem lại giúp


  • 0

#13 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 26 March 2013 - 05:38 PM

Vẫn không xuất ra txt được bạn ơi. Bạn xem lại giúp

Có hàng nghìn cách để không xuất ra được txt ví dụ như lisp lỗi, người sử dụng không đúng cách, hoặc gì gì đó v.v.... Vì thế để biết nó lỗi gì và có cách khắc phục thì bạn nên copy cái đoạn nó báo lỗi rồi paste lên đây hoặc là gửi file số liệu của bạn để mình test thử. Lần sau bạn nên làm như thế khi gặp trường hợp như thế này, đừng có thông báo quá sức ngắn gọn như vậy, chả ai biết mà lần với mò.


  • 0

#14 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 26 March 2013 - 06:56 PM

Vẫn không xuất ra txt được bạn ơi. Bạn xem lại giúp

Hề hề hề,

Không xuất được là do bạn chưa làm đúng theo ý của bác Kang Kung. bạn phải sử dụng lisp #3 của bác ấy để chuyển các nhóm tẽt này thành block thuộc tính đã bạn ạ.

Đây là líp có thể xuất thẳng các nhóm text này ra file csv, bạn hãy thử xem sao.

Tuy nhiên mình khuyên bạn nên sử dụng các block thuộc tính thì sẽ thuận lợi cho quá trình sử dụng bản vẽ và số liệu sau này hơn Việc mình làm lisp này chỉ đáp ứng cho nhu cầu trước mắt của bạn chứ không hẳn đã là tối ưu cho bạn. hãy chọn cho mình phương án tối ưu nhất.

 

(defun c:xtdc ( / sst ssn fn fid pt d t1 t2 t3 t4 )
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "Circle") (cons 8 "Main_CircleKQ") (cons 62 83))))
          fn (getfiled "Chon file de save" "" "csv" 1)
          fid (open fn "w")
)
(foreach en sst
        (setq pt (cdr (assoc 10 (entget en)))
                  d (cdr (assoc 40 (entget en)))
                 ssn (acet-ss-to-list (ssget "w" (list (- (car pt) d) (- (cadr pt) d)) (list (+ (car pt) d) (+ (cadr pt) d))
                                                                    (list (cons 0 "text"))))
        )
        (foreach enp ssn 
               (cond
                       ((= (cdr (assoc 62 (entget enp))) 3) (setq t1 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 130) (setq t2 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 2) (setq t3 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 31) (setq t4 (cdr (assoc 1 (entget enp)))))
                       (t nil )
               )
        )
        (setq txt (strcat t1 (chr 44) t2 (chr 44) t3 (chr 44) t4))
        (write-line txt fid)
)
(close fid)
(princ)
)
 
Hy vọng bạn hài lòng và hãy lưu ý rằng các bản vẽ bạn sử dụng phải có các text cần xuất có các thuộc tính giống như bản vẽ bạn đã post. Nếu không kết quả có thể không như ý do việc lọc text không đúng. Cụ thể trong lisp này mình sử dụng thuộc tính màu của các text để sắp xếp chúng vào file csv.

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

#15 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 March 2013 - 08:20 PM

Hề hề hề,

Không xuất được là do bạn chưa làm đúng theo ý của bác Kang Kung. bạn phải sử dụng lisp #3 của bác ấy để chuyển các nhóm tẽt này thành block thuộc tính đã bạn ạ.

Đây là líp có thể xuất thẳng các nhóm text này ra file csv, bạn hãy thử xem sao.

Tuy nhiên mình khuyên bạn nên sử dụng các block thuộc tính thì sẽ thuận lợi cho quá trình sử dụng bản vẽ và số liệu sau này hơn Việc mình làm lisp này chỉ đáp ứng cho nhu cầu trước mắt của bạn chứ không hẳn đã là tối ưu cho bạn. hãy chọn cho mình phương án tối ưu nhất.

 

(defun c:xtdc ( / sst ssn fn fid pt d t1 t2 t3 t4 )
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "Circle") (cons 8 "Main_CircleKQ") (cons 62 83))))
          fn (getfiled "Chon file de save" "" "csv" 1)
          fid (open fn "w")
)
(foreach en sst
        (setq pt (cdr (assoc 10 (entget en)))
                  d (cdr (assoc 40 (entget en)))
                 ssn (acet-ss-to-list (ssget "w" (list (- (car pt) d) (- (cadr pt) d)) (list (+ (car pt) d) (+ (cadr pt) d))
                                                                    (list (cons 0 "text"))))
        )
        (foreach enp ssn 
               (cond
                       ((= (cdr (assoc 62 (entget enp))) 3) (setq t1 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 130) (setq t2 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 2) (setq t3 (cdr (assoc 1 (entget enp)))))
                       ((= (cdr (assoc 62 (entget enp))) 31) (setq t4 (cdr (assoc 1 (entget enp)))))
                       (t nil )
               )
        )
        (setq txt (strcat t1 (chr 44) t2 (chr 44) t3 (chr 44) t4))
        (write-line txt fid)
)
(close fid)
(princ)
)
 
Hy vọng bạn hài lòng và hãy lưu ý rằng các bản vẽ bạn sử dụng phải có các text cần xuất có các thuộc tính giống như bản vẽ bạn đã post. Nếu không kết quả có thể không như ý do việc lọc text không đúng. Cụ thể trong lisp này mình sử dụng thuộc tính màu của các text để sắp xếp chúng vào file csv.

Lisp này vẩn không thể xuất được bạn ơi.

Nếu như bạn chọn thuộc tính lọc theo màu có thể là bị vướng ở một màu nào của bản vẽ trên.

Líp này bạn có xuất ra được không ?


  • 0

#16 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 26 March 2013 - 10:03 PM

(defun c:XTSN (/ oldos sslst tlst filename f sslst1 C1 C2 C3 C4 )  ;C1 C2 C3 C4 C5 C6 C7 C8
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq sslst (acet-ss-to-list (ssget (list (cons 0 "circle") (cons 62 63) (cons 8 "SN_circleKQ"))))
          tlst ""   )
(setq filename (getfiled "Select a File" "" "csv" 1))
(setq f (open filename "w")) 
(write-line "SN_STTO,SN_CCTC,SN_DTIH,SN_KLUG," f)
(foreach e sslst
         (setq sslst1 (acet-ss-to-list (ssget "w" (list (- (cadr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
                                                                                 (- (caddr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
                                                                          )
                                                  (list (+ (cadr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
                                                                                 (+ (caddr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
                                                                          )
                                                 (list (cons 0 "text"))     ))  )
       
		  (setq C1 nil C2 nil C3 nil C4 nil )
         (foreach en sslst1
                  (if (= (cdr (assoc 8 (entget en))) "SN_STTO")
                      (setq C1 (cdr (assoc 1 (entget en))) )
                  )
         )
         (foreach en sslst1
                  (if (= (cdr (assoc 8 (entget en))) "SN_CCTC")
                      (setq C2 (cdr (assoc 1 (entget en))) )
                  )
         )
         (foreach en sslst1
                  (if (= (cdr (assoc 8 (entget en))) "SN_DTIH")
                     (setq C3 (cdr (assoc 1 (entget en))) )
                  )
         )
         (foreach en sslst1
                  (if (= (cdr (assoc 8 (entget en))) "SN_KLUG")
                      (setq C4 (cdr (assoc 1 (entget en))) )
                  )
         )
        
         (setq tlst (strcat (if C1 C1 " ") (chr 44) 
							(if C2 C2 " ") (chr 44) 
							(if C3 C3 " ") (chr 44) 
							(if C4 C4 " ") (chr 44)                       
							))
         (write-line tlst f)
         (setq tlst "")
)
(close f)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

Mình sưu tầm được lisp xuất các nội dung trong ô vòng tròn ra excel được rất nhiều cột .

muốn chỉ xuất 4 nội dung trong ô gồm SN_STTO, SN_CCTC, SN_DTiH, SN_KLUG.

Rieng ô vong tron có tên lớp SN_CircleKQ riêng.

Rất mong được bạn xem sửa giúp để thực hiện việc xuất ra excel.

Cám ơn

http://www.cadviet.c...xt_excel_01.dwg

Hề hề hề,

Cấu trúc cái lisp bạn gửi khá giống với cái líp của mình. Mình đã test trên bản vẽ bạn gửi thì kết quả rất ngon lành. Vì sao bạn lại test không được nhỉ??? Hãy gửi cái bản vẽ bạn đã test lên để mình kiểm tra nhé. Việc sửa cái lisp bạn gửi không khó nhưng chỉ sợ vẫn không phù hợp yêu cầu của bạn nếu như bạn không gửi cái bản vẽ của bạn lên.

Hề hề hề,...


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

#17 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 March 2013 - 10:44 PM

Hề hề hề,

Cấu trúc cái lisp bạn gửi khá giống với cái líp của mình. Mình đã test trên bản vẽ bạn gửi thì kết quả rất ngon lành. Vì sao bạn lại test không được nhỉ??? Hãy gửi cái bản vẽ bạn đã test lên để mình kiểm tra nhé. Việc sửa cái lisp bạn gửi không khó nhưng chỉ sợ vẫn không phù hợp yêu cầu của bạn nếu như bạn không gửi cái bản vẽ của bạn lên.

Hề hề hề,...

Xin lỗi, xin thứ lỗi.

Mình nhầm lớp chính của vòng tròn, do mình thay đổi nên lisp xtcd.lsp không nhận ra. Mình đã chỉnh lại xong và chạy tốt.

Cám ơn bạn nhiều nha.

Nhưng mình vẫn lo về cấu trúc lọc màu cũa Bạn. Có cách nào khác nữa không bạn ?

Mong được Bạn giúp.


  • 0

#18 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 30 March 2013 - 11:25 PM

Không muốn dùng Block Attribute thì chơi Lisp này, đúng theo yêu cầu luôn.

http://www.cadviet.c..._cad_rev1_1.lsp

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
(defun C:KK()
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "TEXT"))) os(getvar "OSMODE"))
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq file(getfiled "Select File:" Path "txt" 2) Path file index 0 TEXT_LIST (list))
  (while (< index (sslength taphop))
    (setq TEXT (entget (ssname taphop index)))
    (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
      (progn
	(setq String(cdr(assoc 1 TEXT)))
	(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
	  (setq InsertPoint(cdr(assoc 10 TEXT)))
	  (setq InsertPoint(cdr(assoc 11 TEXT))))
	(setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST))))
    (setq index (1+ index)))
  (setq file_in(open file "R") lst_solieu(list))
  (while(setq txt(read-line file_in))
    (if (/= txt nil) (setq lst (read (strcat "(" txt ")"  ))))
    (foreach dt TEXT_LIST
      (if (= (car dt) (vl-princ-to-string(car lst)))
	(progn
	  (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(car lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_CDTC") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (cadr lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_DTOV") (cons 62 2) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (caddr lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Main_KLOV") (cons 62 31) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (cadddr lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  )
	)
      )
    )
  (COMMAND "ERASE" TAPHOP "")
  (close file_in)
  (command "UNDO" "END")
  )
(princ "\n                Written By KangKung - 25/03/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Bạn cho mình hỏi dòng lệnh này nghĩa thế nào vậy bạn : (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))

 Mình muốn thay vòng tròn cũ R 2.5 va mới R= 1.5 để phù hợp với ô lưới, việc xuất text vào thì không còn đúng vào vị trí ô củ trước đây

Mong được Bạn chỉ giúp.

Cám ơn


  • 0

#19 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 30 March 2013 - 11:55 PM

Bạn cho mình hỏi dòng lệnh này nghĩa thế nào vậy bạn : (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))

 Mình muốn thay vòng tròn cũ R 2.5 va mới R= 1.5 để phù hợp với ô lưới, việc xuất text vào thì không còn đúng vào vị trí ô củ trước đây

http://www.cadviet.c...1_vong_tron.rar

Mong được Bạn chỉ giúp.
Cám ơn

Bạn xem hình minh hoạ rồi sửa lại cho phù hợp.

71162_ttd.jpg


  • 2

#20 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 31 March 2013 - 07:08 AM

Bạn cho mình hỏi dòng lệnh này nghĩa thế nào vậy bạn : (setq pt1(cadr dt) pt2(list (- (car pt1) 1.0757) (- (cadr pt1) 1.3762)) pt3(list (+ (car pt1) 1.2744) (- (cadr pt1) 1.3762)) pt4(list (car pt1) (- (cadr pt1) 2.7500)))

 Mình muốn thay vòng tròn cũ R 2.5 va mới R= 1.5 để phù hợp với ô lưới, việc xuất text vào thì không còn đúng vào vị trí ô củ trước đây

http://www.cadviet.c...1_vong_tron.rar

Mong được Bạn chỉ giúp.
Cám ơn

 

+ Nếu bạn sử dụng Block ATT để tạo đối tượng thì chắc chắn 100% là phù hợp với mọi ô lưới, không cần phải chỉnh lại khoảng cách như trong  Lisp của bạn KangKung hay của bác PhamThanhBinh

- Hơn nữa, việc xuất nhập CAD với Excel không cần thêm Lisp nào nữa vì đã có 2 lệnh ATTIN và ATTOUT trong Express


  • 1


Trở lại AutoLisp