Đến nội dung


Hình ảnh
- - - - -

Nhờ sửa Lisp Copy Text Cad sang Excel


  • Please log in to reply
26 replies to this topic

#1 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 09 October 2014 - 08:43 PM

Mình sưu tầm được lisp này trên mạng phục vụ việc Copy Text từ Cad sang Excel. Hiện tại cái này nó đang có thể copy theo thứ tự chọn sang 1 cột bên Excel. Nay mình muốn nhờ các bác trên diễn đàn sửa giúp mình cái lisp này làm sao có thể quét chọn hết cả vùng dữ liệu rồi sao chép sang 1 cột bên Excel như hình mình mô tả.

Lệnh như sau:

1.      Gõ lệnh TTX

2.      Quét chọn các Text cần copy

3.      Enter kết thúc lệnh. Sẽ được 1 file Excel sinh ra có thứ tự Text như trong hình.

Nói chung, Lisp này dùng khá là ổn rồi. Chỉ cần sửa lại thứ tự Copy sang Excel thôi. Mong các bác giúp đỡ.

Xin chân thành cám ơn!

File Cad http://www.cadviet.c...3/64997_ttx.dwg

File Lip http://www.cadviet.c...64997_ttx_1.lsp64997_ttx.png


  • 0

#2 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 15 October 2014 - 11:49 AM

hjx. ko có ai giúp mình ah @@


  • 0

#3 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 15 October 2014 - 03:59 PM

File lsp ko down dc.
  • 0

#4 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 16 October 2014 - 10:39 PM

Mình up lại thử vẫn lỗi như vậy. Mình up qua Dropbox, bạn vào down nhé:

https://dl.dropboxus...5898261/TTX.lsp


  • 0

#5 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 17 October 2014 - 12:43 AM

Mình up lại thử vẫn lỗi như vậy. Mình up qua Dropbox, bạn vào down nhé:

https://dl.dropboxus...5898261/TTX.lsp

Hề hề hề,

Bạn thử dùng cái ni coi sao nhé.

 

http://www.mediafire...ext2excel-1.lsp

(defun c:ttx  (/ ss xlApp xlCells row col i)
  (vl-load-com)
  (setq ss1 (ssget '((0 . "*TEXT"))))
  (setq ssl (acet-ss-to-list ss1)
           ssl (vl-sort ssl  '(lambda (x y) (< (atof (cdr (assoc 1 (entget x)))) (atof (cdr (assoc 1 (entget y)))) )))  )
  (setq ss (acet-list-to-ss ssl))
  (if  ss 
    (progn
      (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
      (vla-put-visible xlApp :vlax-true)
      (foreach y
        (mapcar '(lambda (x / iPt)
                   (setq iPt (vlax-get x 'InsertionPoint))
                   (list (vla-get-TextString x)
                         (rtos (car iPt) 2 2)
                         (rtos (cadr iPt) 2 2)
                         (rtos (caddr iPt) 2 2)))
        (mapcar 'vlax-ename->vla-object
                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
        (if (> row 65536) (setq col 5))
        (setq i -1 row (1+ row))
        (mapcar
          (function
            (lambda (x)
              (vlax-put-property xlCells "Item" row
                (+ col (setq i (1+ i))) x))) y))))
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ))

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

#6 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 17 October 2014 - 08:25 AM

Còn cái này là sửa lại cái lsp bạn post.

http://www.cadviet.c.../127168_ttx.rar


  • 1

#7 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 17 October 2014 - 09:46 AM

Còn cái này là sửa lại cái lsp bạn post.

http://www.cadviet.c.../127168_ttx.rar

Hề hề hề,

Bác Tot77 phân loại đối tượng theo điểm đặt của nó phải không ạ?? Điều này có hơi khác với mình suy nghĩ là vì mình phân loại theo giá trị của đối tượng. 

Trong trường hợp cụ thể này thì hai cách phân loại này đều có chung kết quả. Tuy nhiên với các trường hợp khác thì kết quả sẽ không giống nhau.

Không hiểu ý chủ thớt ra sao nhể???


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

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 17 October 2014 - 09:56 AM

TÔi theo cái hình ở #1, vị trí từ trái qua và từ dưới lên (theo chiều mũi tên)

Những giá trị trong hình chỉ là ví dụ thôi (tôi nghĩ thế).


  • 1

#9 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 17 October 2014 - 10:10 AM

TÔi theo cái hình ở #1, vị trí từ trái qua và từ dưới lên (theo chiều mũi tên)

Những giá trị trong hình chỉ là ví dụ thôi (tôi nghĩ thế).

Hề hề hề,

Chắc là bác đúng. Mình căn cứ vào cái kết quả trên exel nên chọn cách phân loại như vầy. 

Vấn đề cơ bản ở đây chỉ là việc sắp xếp lại tập chọn theo một trật tự nào đó mà thôi.Nếu chủ thớt nói rõ hơn về cái trật tự này thì sẽ tốt hơn là để người làm lisp phải tự nghĩ .......


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

#10 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 17 October 2014 - 08:44 PM

Bác Tot77 sửa Lisp đúng ý mình rồi. Còn bác phamthanhbinh cũng có cách xuất theo giá trị từ nhỏ đến lớn cũng khá hay, mình sẽ lưu lại cả. Cám ơn các bác nhiều lắm.

Mình còn 1 bài toán nữa ko biết có làm khó các bác hơn chút nào ko? Nhưng mình hay phải copy tới cả nghìn text như thế này sang Excel, rồi rà soát lại rất mệt nên rất thủ công.

Bài toán như sau: Có các text như trong hình.

1.     Gõ lệnh TTX1

2.     Quét chọn cả 4 text số lần lượt trong các ô từ (Ô – 1) đến (Ô – 8). Chú ý cứ quét chọn cả 4 text 1 lần, do đó như trong hình ta cần quét 8 lần.

3.     File Excel xuất ra có kết quả theo thứ tự của mũi tên như trong hình mô tả.

Kết thúc lệnh. Rất mong có được sự giúp đỡ của diễn đàn.

Xin chân thành cám ơn sự giúp đỡ của các bác :)

File Cad: http://www.cadviet.c...997_txt_new.dwg

64997_ttx_new.png


  • 0

#11 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 18 October 2014 - 12:02 PM

Cái này cũng gần giống cái trên.

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
  
  (while (setq ss (ssget '((0 . "*TEXT"))))      
      (setq ss (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))    
      (while ss
(setq  ss (vl-sort ss '(lambda (x y) (> (cadr (car x)) (cadr (car y)))))
      ss1 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss)) (cadr (car x)) 0.2)) ss)
      ss1 (vl-sort ss1 '(lambda (x y) (< (caar x) (caar y))))
      ss (vl-remove-if '(lambda (x) (member x ss1)) ss)
)
(foreach z ss1
          (setq iPt (car z)
y (list (vla-get-TextString (last z))  (rtos (car iPt) 2 2)  (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))
 ) 
          (if (> row 65536) (setq col 5))
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
    )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)

  • 1

#12 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 19 October 2014 - 10:21 PM

Cảm ơn Bác Tot 77. Lisp này của bác dùng rất tốt rồi. Nhưng bác có thể chỉnh giúp mình lsao để mình có thể chọn hết xong rồi mới ấn enter dc ko? Chứ lisp này là cứ mỗi lần chọn lại enter 1 lần thì hơi chậm 1 tý ^^

Cái này cũng gần giống cái trên.

 

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
  
  (while (setq ss (ssget '((0 . "*TEXT"))))      
      (setq ss (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))    
      (while ss
(setq  ss (vl-sort ss '(lambda (x y) (> (cadr (car x)) (cadr (car y)))))
      ss1 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss)) (cadr (car x)) 0.2)) ss)
      ss1 (vl-sort ss1 '(lambda (x y) (< (caar x) (caar y))))
      ss (vl-remove-if '(lambda (x) (member x ss1)) ss)
)
(foreach z ss1
          (setq iPt (car z)
y (list (vla-get-TextString (last z))  (rtos (car iPt) 2 2)  (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))
 ) 
          (if (> row 65536) (setq col 5))
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
    )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)

  • 0

#13 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 20 October 2014 - 08:40 AM

Thì bạn yêu cầu quét 8 lần, quét mấy lần thì enter mấy lần. Hay bạn muốn quét luôn 32 text rồi làm 1 lúc, xem như quét 1 lần?


  • 1

#14 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 21 October 2014 - 07:30 AM

Nếu bản vẽ thật của bạn mỗi nhóm 4 chữ đều có cái khung bao pline như bản vẽ mẫu thì có thể sửa lsp để nhấp vào khung đó, nó sẽ đưa ra excel thay vì quét chữ và enter.


  • 0

#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 21 October 2014 - 08:00 AM

Cho mình tham gia tí,

có giải pháp nảo xuất các số gần đỉnh của từng ô sang écel không bạn

o-1 1.56 2.56 3.25 

o-2 4.56 2.56 3.25 

khị chọn các ô thuộc pline, lấy tên ô, xac định các số ở đỉnh xuất ra eccxel

http://www.cadviet.c...81_sn_excel.dwg


  • -1

#16 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 21 October 2014 - 08:42 AM

Cho mình tham gia tí,

có giải pháp nảo xuất các số gần đỉnh của từng ô sang écel không bạn

o-1 1.56 2.56 3.25 

o-2 4.56 2.56 3.25 

khị chọn các ô thuộc pline, lấy tên ô, xac định các số ở đỉnh xuất ra eccxel

http://www.cadviet.c...81_sn_excel.dwg

Được, với đk các số đúng là gần đỉnh, chứ như bản vẽ bạn đưa thì số 1.60 và 12.40 không biết là gần cái đỉnh nào.

Đk thứ 2 là text cùng 1 loại canh lề.


  • 0

#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 21 October 2014 - 10:44 AM

Ô hay, vậy thì có giải pháp rồi.

về nguyên tắc mình muốn tìm các số gần đỉnh của các đa giác ( nằm trong ngoài tùy ý ) của ô đó xuất ra hàng ngang theo tên ô, có thể các ô có cùng số tại điểm tiếp giáp.

xuất ra:  o-1 102 3.2 150 2.66  250 ( và diện tích ô đó )

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


  • 0

#18 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 21 October 2014 - 11:11 AM

Bạn dùng cái này thử xem.

Chọn 1 khung pline rồi chọn cái tên khung (ô-..), chọn tới đâu xuất excel tới đó.

Phần diện tích k biết lấy đơn vị là gì.

(defun c:tta (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)      
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst)
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
    (setq pl (ssname pl 0)) (redraw pl 3)
    (setq oo (car (entsel "\nChon ten cua khung:")))  (redraw pl 4) (redraw oo 3)
    
    (setq  ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))) 
 lst (list (vla-get-TextString (vlax-ename->vla-object oo)))
    )
    (foreach pt ssd
      (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
   lst (append lst (list (last txt))) 
      )
    )
    (setq lst (append lst (list (vla-get-Area (vlax-ename->vla-object pl))))
 i -1 row (1+ row))
    (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
    (prompt "\nChon khung pline:")
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)

  • 0

#19 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 21 October 2014 - 01:52 PM

À cái này hay quá. Cám ơn Bạn đã nhiệt tình giúp. diện tích lấy theo đơn vị m đi bạn. Số diện tich bạn giúp xuất ra ở cột số 9 trên eccxel giúp mình, nếu các số đỉnh không đủ thì kệ nó.

Có giải pháp nào mình chọn một lần hết các ô không bạn ?? Liisp  Nhận biết đa giác đó, Xuất tên ô trong khung và số từng đỉnh ra hàng sang ecxel.

Mong bạn giúp


  • 0

#20 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 21 October 2014 - 09:53 PM

Lisp #11 này rất ok rồi. Nhờ các bác sửa giúp mình thêm tính năng chia các giá trị text theo các layer khác nhau ra các cột khác nhau và vẫn theo thứ tự như vậy.

Như trong file cad mình gửi thì có 3 layer. Mình vẫn thao tác như cũ, nhưng text thuộc layer nào thì xuất kqua ra cùng lúc 3 cột khác nhau cho 3 layer. Cách xuất thì vẫn y như lisp TTY vậy.

Nếu bác làm dc vậy thì bác làm giúp mình cả với trường hợp lisp TTX trên tại #6 kia nữa với nha. Thanks bác nhiều ạ ^^

http://www.cadviet.c...997_tty_new.dwg

 


 

Cái này cũng gần giống cái trên.

 

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
  
  (while (setq ss (ssget '((0 . "*TEXT"))))      
      (setq ss (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))    
      (while ss
(setq  ss (vl-sort ss '(lambda (x y) (> (cadr (car x)) (cadr (car y)))))
      ss1 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss)) (cadr (car x)) 0.2)) ss)
      ss1 (vl-sort ss1 '(lambda (x y) (< (caar x) (caar y))))
      ss (vl-remove-if '(lambda (x) (member x ss1)) ss)
)
(foreach z ss1
          (setq iPt (car z)
y (list (vla-get-TextString (last z))  (rtos (car iPt) 2 2)  (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))
 ) 
          (if (> row 65536) (setq col 5))
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
    )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)

  • 0