Scale text block

[MrCGIS 1]

Em xin chào các anh, hiện tại em có file địa chính có block thông tin thửa bao gồm: số thửa, quy hoạch, diện tích, line .... giờ em muốn scale block này làm sao để nó có thể nằm lọt trong thửa với tâm của nó đặt tại đầu line màu xanh ngay điểm block màu vàng, mong muốn của em là có được lisp scale hoàn loạt đối tượng để block thông tin lọt vào trong thửa để lấy dữ liệu. Mong các anh giúp

Em có để file cad mẫu và hình minh họa ạ em xin cảm ơn.

File mẫu: 

Ban đầu: 

Kết quả: 

 

Drawing4.dwg

[Dang D Khanh 4]

Thông tin trong bản vẽ của bạn khá đặc biệt nên không mất công sức để scale.

Chỉ cần chọn điểm gốc thu phóng block phù hợp.

Chỉ số thu phóng cũng chỉ định luôn =0.01 mà không cần tính toán.

Video Block_scale

Hàng free nhưng yêu cầu CAD22. Cần liên hệ mình.

[7o7 79]

2 giờ trước, Dang D Khanh đã nói:

Thông tin trong bản vẽ của bạn khá đặc biệt nên không mất công sức để scale.

Chỉ cần chọn điểm gốc thu phóng block phù hợp.

Chỉ số thu phóng cũng chỉ định luôn =0.01 mà không cần tính toán.

Video Block_scale

Hàng free nhưng yêu cầu CAD22. Cần liên hệ mình.

Xem video thì thấy rất ok,  nhưng yêu cầu cad22 thì bị dội ngay, không lẽ phải cài cad mới chỉ để chạy cái prog này? Chắc bác Khanh viết bằng ngôn ngữ không phải lisp, vì lisp cad nào cũng chạy tốt, trừ cad quá cũ < 2004.

[gia_bach 1.548]

Đon giản là scale block N_THUA_* tại điểm chèn của block CENTRD_1 với tỉ lệ = 0.01

Lisp hay VBA đều chơi được.

[7o7 79]

10 phút trước, Doan Van Ha đã nói:

Thứ này có nhiều.

• sct.lsp
  
• [✎]
   

(defun c:SCT(/ ci tl n i)
 (prompt "\n Moi ban chon CIRCLE/DONUT/BLOCK")
 (setq ci (ssget '((0 . "CIRCLE,LWPOLYLINE,INSERT"))))
 (setq tl (getreal "\n Nhap ti le scale :") n (sslength ci) i 0)
 (while (< i n)
  (setq ent (ssname ci i))
  (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (command "scale" ent "" (centre ent) tl)
   (command "scale" ent "" (cdr (assoc 10 (entget ent))) tl))
  (setq i (1+ i)))
 (princ))

 

Không chạy đúng bác @Doan Van Ha ơi! Điểm chèn của block N_THUA_* nằm tận đâu đâu không scale về đúng chỗ được.

[MrCGIS 1]

54 phút trước, Doan Van Ha đã nói:

Thứ này có nhiều.

• sct.lsp
  
• [✎]
   

(defun c:SCT(/ ci tl n i)
 (prompt "\n Moi ban chon CIRCLE/DONUT/BLOCK")
 (setq ci (ssget '((0 . "CIRCLE,LWPOLYLINE,INSERT"))))
 (setq tl (getreal "\n Nhap ti le scale :") n (sslength ci) i 0)
 (while (< i n)
  (setq ent (ssname ci i))
  (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (command "scale" ent "" (centre ent) tl)
   (command "scale" ent "" (cdr (assoc 10 (entget ent))) tl))
  (setq i (1+ i)))
 (princ))

 

Cảm ơn anh, nhưng mà sao em load lisp nó báo lỗi không chạy được anh.

[MrCGIS 1]

13 giờ trước, Dang D Khanh đã nói:

Thông tin trong bản vẽ của bạn khá đặc biệt nên không mất công sức để scale.

Chỉ cần chọn điểm gốc thu phóng block phù hợp.

Chỉ số thu phóng cũng chỉ định luôn =0.01 mà không cần tính toán.

Video Block_scale

Hàng free nhưng yêu cầu CAD22. Cần liên hệ mình.

Anh cho em xin lisp với ạ...

[gia_bach 1.548]

1 giờ} trướ}c, Doan Van Ha đã nói:

Thứ này có nhiều.

• sct.lsp
  
• [✎]
   

(defun c:SCT(/ ci tl n i)
 (prompt "\n Moi ban chon CIRCLE/DONUT/BLOCK")
 (setq ci (ssget '((0 . "CIRCLE,LWPOLYLINE,INSERT"))))
 (setq tl (getreal "\n Nhap ti le scale :") n (sslength ci) i 0)
 (while (< i n)
  (setq ent (ssname ci i))
  (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (command "scale" ent "" (centre ent) tl)
   (command "scale" ent "" (cdr (assoc 10 (entget ent))) tl))
  (setq i (1+ i)))
 (princ))

 

bác phải scale tại điểm chèn của block CENTRD_1

[huunhantvxdts 195]

Vào lúc 31/3/2022 tại 10:36, MrCGIS đã nói:

Em xin chào các anh, hiện tại em có file địa chính có block thông tin thửa bao gồm: số thửa, quy hoạch, diện tích, line .... giờ em muốn scale block này làm sao để nó có thể nằm lọt trong thửa với tâm của nó đặt tại đầu line màu xanh ngay điểm block màu vàng, mong muốn của em là có được lisp scale hoàn loạt đối tượng để block thông tin lọt vào trong thửa để lấy dữ liệu. Mong các anh giúp

Em có để file cad mẫu và hình minh họa ạ em xin cảm ơn.

File mẫu: 

Ban đầu: 

Kết quả: 

 

Drawing4.dwg

Gửi bạn nhé

(defun C:SCBL (/ tl obj blkname pt p1 p2 ssbl doc blkname lay mau)
(setq tl (getreal "\nNhap ti le scale:"))
(princ "\nChon cac Blocks...")
(if (ssget '((0 . "INSERT")));(2 . "CENTRD_1")
(progn
(vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blkname (vla-get-Name obj))
	;chuyen doi tuong trong BL thanh mau layer
(if (= blkname "CENTRD_1")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq p1 (polar pt (/ (* 3 pi) 4) 5))
(setq p2 (polar pt (/ pi -4) 5))
(setq ssbl (ssget "C" p1 p2 '((0 . "INSERT") (-4 . "<NOT") (2 . "CENTRD_1") (-4 . "NOT>"))))
(command "scale" ssbl "" pt tl)
)
)
)
)
)
)

 

[MrCGIS 1]

2 giờ trước, huunhantvxdts đã nói:

Gửi bạn nhé

• scbl.lsp
  
• [✎]
   

(defun C:SCBL (/ tl obj blkname pt p1 p2 ssbl doc blkname lay mau)
(setq tl (getreal "\nNhap ti le scale:"))
(princ "\nChon cac Blocks...")
(if (ssget '((0 . "INSERT")));(2 . "CENTRD_1")
(progn
(vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blkname (vla-get-Name obj))
;chuyen doi tuong trong BL thanh mau layer
(if (= blkname "CENTRD_1")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq p1 (polar pt (/ (* 3 pi) 4) 5))
(setq p2 (polar pt (/ pi -4) 5))
(setq ssbl (ssget "C" p1 p2 '((0 . "INSERT") (-4 . "<NOT") (2 . "CENTRD_1") (-4 . "NOT>"))))
(command "scale" ssbl "" pt tl)
)
)
)
)
)
)

 

Cảm ơn anh giúp đỡ, nhưng cho em hỏi với trường hợp gần nhau thì kết quả lisp lại bị sai vị trí có cách nào cho chính xác hơn đc k anh. Với cho em hỏi sao em quét chọn block thì chỉ cho phép chọn số lượng ít thôi còn số lượng nhiều thì không thấy chạy ạ?

[huunhantvxdts 195]

14 phút trước, MrCGIS đã nói:

Cảm ơn anh giúp đỡ, nhưng cho em hỏi với trường hợp gần nhau thì kết quả lisp lại bị sai vị trí có cách nào cho chính xác hơn đc k anh. Với cho em hỏi sao em quét chọn block thì chỉ cho phép chọn số lượng ít thôi còn số lượng nhiều thì không thấy chạy ạ?

1. Phạm vi xét trong o vuông 10x10 nên nó bị dính vào nhau có thể giảm lại 2x2 chắc sẽ ổn.

2. Các đối tượng phải nằm trong phạm vi màn hình thấy được nó mới chạy bạn nhé

[huunhantvxdts 195]

22 phút trước, MrCGIS đã nói:

Cảm ơn anh giúp đỡ, nhưng cho em hỏi với trường hợp gần nhau thì kết quả lisp lại bị sai vị trí có cách nào cho chính xác hơn đc k anh. Với cho em hỏi sao em quét chọn block thì chỉ cho phép chọn số lượng ít thôi còn số lượng nhiều thì không thấy chạy ạ?

Sửa lại cho bạn nhé

(defun C:SCBL (/ tl obj blkname pt p1 p2 ssbl doc blkname lay mau)
(setq tl (getreal "\nNhap ti le scale:"))
(princ "\nChon cac Blocks...")
(if (ssget '((0 . "INSERT")));(2 . "CENTRD_1")
(progn
(vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blkname (vla-get-Name obj))
	;chuyen doi tuong trong BL thanh mau layer
(if (= blkname "CENTRD_1")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq p1 (polar pt (/ (* 3 pi) 4) 1))
(setq p2 (polar pt (/ pi -4) 1))
(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point pt) 500)
(setq ssbl (ssget "C" p1 p2 '((0 . "INSERT") (-4 . "<NOT") (2 . "CENTRD_1") (-4 . "NOT>"))))
(command "scale" ssbl "" pt tl)
)
)
)
)
)
)

 

[MrCGIS 1]

2 phút trước, huunhantvxdts đã nói:

Sửa lại cho bạn nhé

• scbl.lsp
  
• [✎]
   

(defun C:SCBL (/ tl obj blkname pt p1 p2 ssbl doc blkname lay mau)
(setq tl (getreal "\nNhap ti le scale:"))
(princ "\nChon cac Blocks...")
(if (ssget '((0 . "INSERT")));(2 . "CENTRD_1")
(progn
(vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blkname (vla-get-Name obj))
;chuyen doi tuong trong BL thanh mau layer
(if (= blkname "CENTRD_1")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq p1 (polar pt (/ (* 3 pi) 4) 1))
(setq p2 (polar pt (/ pi -4) 1))
(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point pt) 500)
(setq ssbl (ssget "C" p1 p2 '((0 . "INSERT") (-4 . "<NOT") (2 . "CENTRD_1") (-4 . "NOT>"))))
(command "scale" ssbl "" pt tl)
)
)
)
)
)
)

 

Em cảm ơn anh rất nhiều.

[MrCGIS 1]

2 giờ trước, huunhantvxdts đã nói:

Sửa lại cho bạn nhé

• scbl.lsp
  
• [✎]
   

(defun C:SCBL (/ tl obj blkname pt p1 p2 ssbl doc blkname lay mau)
(setq tl (getreal "\nNhap ti le scale:"))
(princ "\nChon cac Blocks...")
(if (ssget '((0 . "INSERT")));(2 . "CENTRD_1")
(progn
(vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blkname (vla-get-Name obj))
;chuyen doi tuong trong BL thanh mau layer
(if (= blkname "CENTRD_1")
(progn
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))))
(setq p1 (polar pt (/ (* 3 pi) 4) 1))
(setq p2 (polar pt (/ pi -4) 1))
(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point pt) 500)
(setq ssbl (ssget "C" p1 p2 '((0 . "INSERT") (-4 . "<NOT") (2 . "CENTRD_1") (-4 . "NOT>"))))
(command "scale" ssbl "" pt tl)
)
)
)
)
)
)

 

Anh cho em hỏi nếu qua file cad khác khi tên block name đổi thì em nên sửa chỗ nào trong lisp để lisp chạy như bình thường ạ?

[huunhantvxdts 195]

22 phút trước, MrCGIS đã nói:

Anh cho em hỏi nếu qua file cad khác khi tên block name đổi thì em nên sửa chỗ nào trong lisp để lisp chạy như bình thường ạ?

Thay ch­ữ "CENTRD_1" bằng tên block mới

[MrCGIS 1]

9 phút trước, huunhantvxdts đã nói:

Thay ch­ữ "CENTRD_1" bằng tên block mới

Dạ cảm ơn anh, cho em hỏi thêm là nếu khoản cách giữa các block thông tin quá sát nhau thì em giảm giá trị thông tin đoạn :

 (setq p1 (polar pt (/ (* 3 pi) 4) 0.01))
(setq p2 (polar pt (/ pi -4) 0.01))

như thế này có hợp lý không anh, hay phải điều chỉnh chỗ khác nữa ạ?

[huunhantvxdts 195]

2 giờ trước, MrCGIS đã nói:

Dạ cảm ơn anh, cho em hỏi thêm là nếu khoản cách giữa các block thông tin quá sát nhau thì em giảm giá trị thông tin đoạn :

 (setq p1 (polar pt (/ (* 3 pi) 4) 0.01))
(setq p2 (polar pt (/ pi -4) 0.01))

như thế này có hợp lý không anh, hay phải điều chỉnh chỗ khác nữa ạ?

Bạn tự test được mà, nếu ko được thì tăng lên nhé

[MrCGIS 1]

Vào lúc 1/4/2022 tại 19:55, huunhantvxdts đã nói:

Bạn tự test được mà, nếu ko được thì tăng lên nhé

Với các trường hợp các text chồng nhau thì mình có thể set tâm scale của layer "N_THUA" tại vị trí "center" của nó sau đó scale tại điểm đặt của layer "CENTRD" như vậy có đc k anh?

[quocmanh04tt 634]

Bài này nếu quét chọn block "N_THUA*" trước, với từng block xác định Boundingbox, từ đây quét block "CENTRD_1", sẽ ít gặp rắc rối hơn và không gặp vấn đề như trên.

[MrCGIS 1]

42 phút trước, quocmanh04tt đã nói:

Bài này nếu quét chọn block "N_THUA*" trước, với từng block xác định Boundingbox, từ đây quét block "CENTRD_1", sẽ ít gặp rắc rối hơn và không gặp vấn đề như trên.

xin anh chỉ giáo với ạ...

[MrCGIS 1]

Vào lúc 1/4/2022 tại 19:55, huunhantvxdts đã nói:

Bạn tự test được mà, nếu ko được thì tăng lên nhé

 (setq p1 (polar pt (/ (* 3 pi) 4) 0.01))
(setq p2 (polar pt (/ pi -4) 0.01))

Anh có thể giải thích thêm cho em biết thêm hai dòng code này là gì không anh? về set chỉ số ,... Em cảm ơn

[huunhantvxdts 195]

1 giờ trước, MrCGIS đã nói:

 (setq p1 (polar pt (/ (* 3 pi) 4) 0.01))
(setq p2 (polar pt (/ pi -4) 0.01))

Anh có thể giải thích thêm cho em biết thêm hai dòng code này là gì không anh? về set chỉ số ,... Em cảm ơn

Cái này là set 2 điểm của khung để chọn đối tượng bạn.

Add zalo 0848.998.045 trao đổi thêm nhé

[quocmanh04tt 634]

Mình đi theo hướng như đã nói ở trên.

(defun c:tt  (/ blc cen ent llp mid obj ss1 ss2 urp)
  (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*"))))
    (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1))
      (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp)
      (setq llp (vlax-safearray->list llp)
            urp (vlax-safearray->list urp)
            mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp)
            cen nil)
      (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1"))))
             (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2))
               (setq cen (cons (cdr (assoc 10 (entget blc))) cen)))
             (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y)))))
             (vlax-invoke obj 'scaleentity (car cen) 0.01)))))
  (princ))

 

[7o7 79]

16 giờ trước, quocmanh04tt đã nói:

Mình đi theo hướng như đã nói ở trên.

• tt.lsp
  
• [✎]
   

(defun c:tt  (/ blc cen ent llp mid obj ss1 ss2 urp)
  (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*"))))
    (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1))
      (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp)
      (setq llp (vlax-safearray->list llp)
            urp (vlax-safearray->list urp)
            mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp)
            cen nil)
      (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1"))))
             (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2))
               (setq cen (cons (cdr (assoc 10 (entget blc))) cen)))
             (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y)))))
             (vlax-invoke obj 'scaleentity (car cen) 0.01)))))
  (princ))

 

Tâm boundingbox với điểm chèn block Center cũng có kc chứ chưa hẳn đã trùng, do đó nếu có 2 bl N-Thua cách nhau nhỏ hơn kc đó thì kết quả không còn đúng.

[MrCGIS 1]

17 giờ trước, quocmanh04tt đã nói:

Mình đi theo hướng như đã nói ở trên.

• tt.lsp
  
• [✎]
   

(defun c:tt  (/ blc cen ent llp mid obj ss1 ss2 urp)
  (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*"))))
    (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1))
      (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp)
      (setq llp (vlax-safearray->list llp)
            urp (vlax-safearray->list urp)
            mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp)
            cen nil)
      (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1"))))
             (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2))
               (setq cen (cons (cdr (assoc 10 (entget blc))) cen)))
             (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y)))))
             (vlax-invoke obj 'scaleentity (car cen) 0.01)))))
  (princ))

 

Em cảm ơn anh lisp sài rất tốt nếu quét chọn những vùng nhỏ ạ....Tks anh nhiều