[Help] Lisp Trích Xuất Giá Trị Trong Dimension Ra Mtext

[Funiki28 1]

Chào các bác

em muốn trích xuất giá trị ghi trong dimension và kéo thẳng lên phía trên thành dạng mtext như file cad đính kèm.

https://drive.google.com/open?id=0B_ToehCkY5kzWkxNYjFTWXdIMnM

Nhờ các bác giúp vì hiện tại em đang làm rất thủ công là copy cái dimension ra và explore để lấy giá trị trong dim, mà công việc của em làm điều này rất nhiều lần, khiến em mất rất nhiều thời gian.

Lisp e muốn như này:

Gõ lệnh cxt

Pick chọn vào giá trị ghi trong dimension và kéo thẳng lên pick vào điểm bất kì muốn đặt giá trị mtext.

Mong các bác giúp đỡ.

Thanks !

[quansla 259]

Chào các bác

em muốn trích xuất giá trị ghi trong dimension và kéo thẳng lên phía trên thành dạng mtext như file cad đính kèm.

https://drive.google.com/open?id=0B_ToehCkY5kzWkxNYjFTWXdIMnM

Nhờ các bác giúp vì hiện tại em đang làm rất thủ công là copy cái dimension ra và explore để lấy giá trị trong dim, mà công việc của em làm điều này rất nhiều lần, khiến em mất rất nhiều thời gian.

Lisp e muốn như này:

Gõ lệnh cxt

Pick chọn vào giá trị ghi trong dimension và kéo thẳng lên pick vào điểm bất kì muốn đặt giá trị mtext.

Mong các bác giúp đỡ.

Thanks !

Đây cơ mà Khi Pick, chú ý Pick vào đúng MTEXT của DIM nhé, thì LÍP mới hoạt động

(defun c:cxt(/ dt ent p)
  (vl-load-com)
  (if (setq dt (car(nentsel "\Pick DIM")))
    (progn
      (setq ent (entget dt))
      
      (setq p (getpoint (dxf 10 ent) "\nChon diem moi"))
      (entmakex
	(append
	  (list
	    '(0 . "MTEXT")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbMText"))
	  (vl-remove-if-not '(lambda(x) (member (car x) '(8 7 1 62 40 41 42 43 50 70 71 72 73)))  ent)
	  (list (cons 10 p))
	  )
      )
      ))
  (princ))

[quocmanh04tt 635]

Đây cơ mà Khi Pick, chú ý Pick vào đúng MTEXT của DIM nhé, thì LÍP mới hoạt động

(defun c:cxt(/ dt ent p)
  (vl-load-com)
  (if (setq dt (car(nentsel "\Pick DIM")))
    (progn
      (setq ent (entget dt))
      
      (setq p (getpoint (dxf 10 ent) "\nChon diem moi"))
      (entmakex
	(append
	  (list
	    '(0 . "MTEXT")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbMText"))
	  (vl-remove-if-not '(lambda(x) (member (car x) '(8 7 1 62 40 41 42 43 50 70 71 72 73)))  ent)
	  (list (cons 10 p))
	  )
      )
      ))
  (princ))

Sao dài thế?!!! Làm cái ngắn hơn tý!

 

(defun c:cdt  (/ ent poi)

  (while (and (setq ent (car (nentsel "\nChon DIMTEXT: ")))

              (eq (cdr (assoc 0 (entget ent))) "MTEXT")

              (Setq poi (getpoint "\nPick diem dat Mtext: " (cdr (assoc 10 (entget ent))))))

    (entmake (subst (cons 10 poi) (assoc 10 (entget ent)) (entget ent))))

  (princ))

[quansla 259]

Sao dài thế?!!! Làm cái ngắn hơn tý!

ờ nhể, mình điên rồi, :D

[Funiki28 1]

Lisp hoạt động rất chuẩn, thanks các bác   :D

[Doan Van Ha 3.191]

Sao dài thế?!!! Làm cái ngắn hơn tý!

Code hay

[TrNghia.Do 6]

Vào lúc 12/6/2017 tại 11:04, quansla đã nói:

Đây cơ mà Khi Pick, chú ý Pick vào đúng MTEXT của DIM nhé, thì LÍP mới hoạt động

 

• cxt.lsp
  
• [✎]
   

(defun c:cxt(/ dt ent p)
  (vl-load-com)
  (if (setq dt (car(nentsel "\Pick DIM")))
    (progn
      (setq ent (entget dt))
      
      (setq p (getpoint (dxf 10 ent) "\nChon diem moi"))
      (entmakex
	(append
	  (list
	    '(0 . "MTEXT")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbMText"))
	  (vl-remove-if-not '(lambda(x) (member (car x) '(8 7 1 62 40 41 42 43 50 70 71 72 73)))  ent)
	  (list (cons 10 p))
	  )
      )
      ))
  (princ))

Khi gọi lệnh pick vào dim thì mình thấy báo lỗi sau :  "CXX Pick DIM; error: no function definition: DXF"

Bác thử check lại xem có vấn đề gì ko?

[TrNghia.Do 6]

Vào lúc 12/6/2017 tại 11:12, quocmanh04tt đã nói:

Sao dài thế?!!! Làm cái ngắn hơn tý!

(defun c:cdt  (/ ent poi)

  (while (and (setq ent (car (nentsel "\nChon DIMTEXT: ")))

              (eq (cdr (assoc 0 (entget ent))) "MTEXT")

              (Setq poi (getpoint "\nPick diem dat Mtext: " (cdr (assoc 10 (entget ent))))))

    (entmake (subst (cons 10 poi) (assoc 10 (entget ent)) (entget ent))))

  (princ))

 

Mình thấy lisp này chỉ hoạt động tốt trên UCS-W ,  còn với UCS bất kỳ text trích xuất ra bị nhảy đi rất xa với dim đc chọn. Mong bạn có cách khắc phục để có thể sử dụng trên bất kì ucs nào mà ko cần chuyển về UCS-W

[quocmanh04tt 635]

18 phút trước, TrNghia.Do đã nói:

Mình thấy lisp này chỉ hoạt động tốt trên UCS-W ,  còn với UCS bất kỳ text trích xuất ra bị nhảy đi rất xa với dim đc chọn. Mong bạn có cách khắc phục để có thể sử dụng trên bất kì ucs nào mà ko cần chuyển về UCS-W

UCS bất kỳ đây:

(defun c:cdt  (/ els ent poi)
  (while (and (setq ent (car (nentsel "\nChon DIMTEXT: ")))
              (eq (cdr (assoc 0 (setq els (entget ent)))) "MTEXT")
              (Setq poi (getpoint "\nPick diem dat Mtext: " (trans (cdr (assoc 10 els)) 0 1))))
    (entmake (subst (cons 10 (trans poi 1 0)) (assoc 10 els) els)))
  (princ))