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

Tháng 3 25, 2013

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:

http://www.cadviet.com/upfiles/3/114381_02_s_1.dwg

http://www.cadviet.com/upfiles/3/114381_02_kl_01.rar

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

Tháng 3 25, 2013

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:

http://www.cadviet.com/upfiles/3/114381_02_s_1.dwg

http://www.cadviet.com/upfiles/3/114381_02_kl_01.rar

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

 
http://www.cadviet.com/upfiles/3/5194_updatetemdc.lsp
Chúc bạn vui.

Tháng 3 25, 2013

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

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_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.com/upfiles/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")

Tháng 3 25, 2013

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

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

http://www.cadviet.com/upfiles/3/5194_updatetemdc.lsp

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.

Tháng 3 25, 2013

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

http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_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.com/upfiles/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.

Tháng 3 25, 2013

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.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_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")

Tháng 3 26, 2013

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

Tháng 3 26, 2013

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

Tháng 3 26, 2013

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.

Tháng 3 26, 2013

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

Tháng 3 26, 2013

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.com/upfiles/3/71162_output_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")

Tháng 3 26, 2013

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.com/upfiles/3/71162_output_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

Tháng 3 26, 2013

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

Tháng 3 26, 2013

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

http://www.cadviet.com/upfiles/3/5194_xuattemdiachinh.lsp
 
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.

Tháng 3 26, 2013

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)

)

http://www.cadviet.com/upfiles/3/5194_xuattemdiachinh.lsp

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 ?

Tháng 3 26, 2013

(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.com/upfiles/3/114381_02_mau_xuat_nhap_txt_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ề,...

Tháng 3 26, 2013

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.

Tháng 3 30, 2013

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.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_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

Tháng 3 30, 2013

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.com/upfiles/3/114381_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.

Tháng 3 31, 2013

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.com/upfiles/3/114381_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

Tháng 3 31, 2013

Cám ơn Bạn, Nhưng việc sử dụng Block ttinh thì lisp yên cần sửa từng ô. Việc này thì mình la2m từng block thì hơi lâu.

Bạn có thể hướng dẫn cụ thể lại cho mình được chứ.

Tháng 4 4, 2013

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.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_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")

Bạn cho mình xin hởi: nếu nình muốn up thêm 2 cột nửa ở cuối thì phải bổ sung những lệnh ở hàng nào vậy KangKung?

Mong được Bạn chỉ giúp.

Tháng 4 5, 2013

Bạn tientracdia này toàn đánh cờ 1 nước. Bạn muốn up thêm 2 cột chứ thêm 20 cột nữa đều được tuy nhiên số liệu thế nào và thể hiện ở vị trí nào trên bản vẽ. Ít nhất cũng nên cho người viết Lisp biết cụ thể số liệu đầu vào và đầu ra thì mới có câu trả lời chính xác được.

Tháng 4 5, 2013

Xin lỗi.

Trước đây nhập từ excel sang cad vào các vong tròn kí hiệu dựa vào cột STT file excel chỉ có các cột , như : STT, CCTC, Dientich, Khoiluong.

nay mình muốn thêm 2 cột CDTN, CDTK trên file excel và muốn nhập nội dung đó vào vòng tròn kí hiệu theo mẫu kí hiệu mới.

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

Tháng 4 5, 2013

Lisp mới đây. Tuy nhiên cách bạn đang làm việc hơi thiếu khoa học, làm lấy được chứ chưa có phương pháp tối ưu. Nếu quản lý đối tượng bằng block thuộc tính thì cách nhập số liệu đơn giản hơn nhiều. Lần đầu bạn muốn nhập số liệu với 4 cột, lần này là 6 cột, lần thứ n thì bao nhiêu? Tất cả điều này được giải quyết dễ dàng và đơn giản bằng cách sử dụng block thuộc tính. Muốn bao nhiêu số liệu thì chỉ cần thay đổi block thuộc tính là được thôi chứ không mất thời gian ngồi đo đo tính tính vị trí các Text rồi nhét vào trong code như mình đã làm. Mặt khác để Text như trên bản vẽ của bạn thì lại chưa có Lisp xuất ngược ra txt. Và nói trước là mình sẽ không chạy theo yêu cầu của bạn một lần nữa đâu nhé. Nếu bạn dùng block thuộc tính thì xuất ngược xuôi gì đều được hết.

;=====LISP UPDATE SO LIEU TU FILE TXT VAO CAD - REV1==========
;================KANGKUNG 25/03/2013==========================
;================ UPDATED 05/04/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.0627) (- (cadr pt1) 0.9735)) pt3(list (+ (car pt1) 1.2873) (- (cadr pt1) 0.9735))
		pt4(list (- (car pt1) 1.0627) (- (cadr pt1) 2.0669)) pt5(list (+ (car pt1) 1.2873) (- (cadr pt1) 2.0669))
		pt6(list (car pt1) (- (cadr pt1) 3.1385))
		)
	  (command "ZOOM" "W" (list (- (car pt1) 3) (+ (cadr pt1) 2)) (list (+ (car pt1) 3) (- (cadr pt1) 5)))
	  (command "ERASE" "W" (list (- (car pt1) 3) (+ (cadr pt1) 1)) (list (+ (car pt1) 3) (- (cadr pt1) 4)) "")
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.3281) (- (cadr pt1) 0.4652)))	(cons 11 (list (+ (car pt1) 2.3281) (- (cadr pt1) 0.4652)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.4999) (- (cadr pt1) 1.3975)))	(cons 11 (list (+ (car pt1) 2.4999) (- (cadr pt1) 1.3975)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (- (car pt1) 2.2015) (- (cadr pt1) 2.5608)))	(cons 11 (list (+ (car pt1) 2.2015) (- (cadr pt1) 2.5608)))
		  ))
	  (entmakex (list '(0 . "LINE")
		  (cons 8 "Layer7")
		  (cons 62 73)
		  (cons 10 (list (car pt1) (- (cadr pt1) 0.4652)))	(cons 11 (list (car pt1) (- (cadr pt1) 2.5608)))
		  ))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer1") (cons 62 3) (cons 10 pt1) (cons 40 0.5) (cons 1 (vl-princ-to-string(nth 0 lst))) (cons 72 1) (cons 11 pt1) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer2") (cons 62 130) (cons 10 pt2) (cons 40 0.5) (cons 1 (rtos (nth 1 lst) 2 2)) (cons 72 1) (cons 11 pt2) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer3") (cons 62 3) (cons 10 pt3) (cons 40 0.5) (cons 1 (rtos (nth 2 lst) 2 2)) (cons 72 1) (cons 11 pt3) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer4") (cons 62 130) (cons 10 pt4) (cons 40 0.5) (cons 1 (rtos (nth 3 lst) 2 2)) (cons 72 1) (cons 11 pt4) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer5") (cons 62 3) (cons 10 pt5) (cons 40 0.5) (cons 1 (rtos (nth 4 lst) 2 2)) (cons 72 1) (cons 11 pt5) (cons 73 2)))
	  (entmakex (list '(0 . "TEXT") (cons 8 "Layer6") (cons 62 31) (cons 10 pt6) (cons 40 0.5) (cons 1 (rtos (nth 5 lst) 2 2)) (cons 72 1) (cons 11 pt6) (cons 73 2)))
	  )
	)
      )
    )
  (close file_in)
  (command "UNDO" "END")
  (alert "Well Done")
  )
(princ "\n                Written By KangKung - 05/04/2013\n")
(princ "\n                  Nhap KK de chay chuong trinh\n")

Đăng nhập

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

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

tientracdia 16

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

phamthanhbinh 3.146

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

KangKung 250

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

tientracdia 16

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

tientracdia 16

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

KangKung 250

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

tientracdia 16

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

phamthanhbinh 3.146

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

phamthanhbinh 3.146

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

KangKung 250

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

tientracdia 16

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

KangKung 250

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

phamthanhbinh 3.146

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

tientracdia 16

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

phamthanhbinh 3.146

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

tientracdia 16

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

tientracdia 16

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

KangKung 250

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