Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
AUTOCAD_2019

Lisp scale 2 đối tượng cùng lúc

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

Thưa các anh trong diễn đàn, em có một vấn đề như sau: em có các lô thửa đất và các loại kí hiệu đất như trong bản vẽ...

Giờ em muốn các kí hiêu đất của thửa đất nằm gọn trong thửa chứ point đặt điểm của các kí hiệu không được lệch ra ngoài thửa ...để dữ liệu có thể hiểu được bên phần mềm khác, vì số lượng rất nhiều nên em không làm thủ công được và vấn đề ở đây là phải scale một lúc 2 đối tượng, và lệnh MA không cho phép quét hai đội tượng khác nhau khi em scale một đối tượng rồi dùng lệnh MA cho các đối tượng còn lại, 

tâm scale là có thể là giữa đối tượng

Kết quả em muốn như sau, tỷ lệ sai số ( có thể chấp nhận sai khi scale không thể nằm lọt trong thửa)

em gửi bản vẽ

drawing05072019.rar

Cho em cảm ơn trước

 

image.png.23420471acce965ffe8348f78cbc3375.png

 

 

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

@AUTOCAD_2019Bạn dùng lisp sau, lệnh là SCO

(vl-load-com)
(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

(defun c:sco (/ sc ss lsp mip); scale object
  (initget (+ 1 2 4))
  (setq sc (getreal "\nHe so scale: "))
  (while (setq ss (ssget '((0 . "*TEXT"))))
    (setq lsp (LM:ssboundingbox ss))
    (setq mip (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car lsp)(cadr lsp)))
    (command "_.scale" ss "" mip sc)
    )
  (princ)
  )

 

  • Like 1

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
4 phút trước, tien2005 đã nói:

@AUTOCAD_2019Bạn dùng lisp sau, lệnh là SCO


(vl-load-com)
(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

(defun c:sco (/ sc ss lsp mip); scale object
  (initget (+ 1 2 4))
  (setq sc (getreal "\nHe so scale: "))
  (while (setq ss (ssget '((0 . "*TEXT"))))
    (setq lsp (LM:ssboundingbox ss))
    (setq mip (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car lsp)(cadr lsp)))
    (command "_.scale" ss "" mip sc)
    )
  (princ)
  )

 

Cảm ơn bạn đã viết lisp, duy có một điều là khi mình dùng lisp cho nhiều đối tượng thì text nó bị dồn lại có cách nào có thể giúp mình cho text nó không thay đổi vị trí và chỉ scale tại tâm của của nó không ? thank bạn nhiều

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

Khi Bạn chọn các đối tượng thì lisp sẽ scale tại điểm giữa của hình bao các đối tượng được chọn. Do đó theo hình Bạn mô tả thì khi chọn chỉ chọn 2 đối tượng text hoặc mtext xong rồi enter. Cứ lần lượt chọn từng cặp như thế nhé

  • Like 1

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

thanks bạn tại vì số lượng rất nhiều nên chọn một cặp làm cũng hơi lâu, nếu không thể làm hết đối tượng thì mình đành xử lí từng cái vậy, dù sao cũng cảm ơn bạn vì đã viết lisp cho minh nhé ^^

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

chắc bạn muốn đỗ file vào phần mềm xuất bảng biểu, theo mình cái này nên xử lý trước ở phần tạo nhãn bên micro, làm nhãn nhỏ thui để chạy, 1 file nhãn lớn để trình bày, mình mẹo 1 tý dựa trên lisp bạn trên, tuy nhiên chắc không triệt để đc vì khi text nó lớn hơi khó kiểm soát chưa kể nhãn nằm ngoài vùng thửa

(defun c:scc (/ ss_30 ds_30 ss_text tam ds-33 ds_30  ss_33 mid1 ip2 ip3 ip4 ip1) 
(setvar 'cmdecho 0)	
;---------------------------------------------
(setq ss_33 (ssget '((0 . "*text") (8 . "Level 33"))))
(if ss_33
	(progn	
		(setq ds-33 (ss2ent ss_33))
		(foreach k ds-33
			(setq s1 (ssadd k))
			(setq mid1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car (LM:ssboundingbox s1))(cadr (LM:ssboundingbox s1))))
			(setq ip1 (mapcar '+ mid1 '(-10 3.5 0)) ip4 (mapcar '+ mid1 '(10 3.5 0)))
			(setq ip2 (mapcar '+ mid1 '(10 -35 0)))
			(setq ip3 (mapcar '+ mid1 '(-10 -35 0)))
			(setq ss_text (ssget "_CP" (list  ip1 ip4 ip2 ip3) '((0 . "*text"))))
			(vl-cmdf "_.scale" ss_text "" mid1 0.1)
			(setq s1 nil)
		)
	)
)
(princ)
)
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;========================================		
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)

 

  • Like 1

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
4 giờ trước, nhoclangbat đã nói:

chắc bạn muốn đỗ file vào phần mềm xuất bảng biểu, theo mình cái này nên xử lý trước ở phần tạo nhãn bên micro, làm nhãn nhỏ thui để chạy, 1 file nhãn lớn để trình bày, mình mẹo 1 tý dựa trên lisp bạn trên, tuy nhiên chắc không triệt để đc vì khi text nó lớn hơi khó kiểm soát chưa kể nhãn nằm ngoài vùng thửa


(defun c:scc (/ ss_30 ds_30 ss_text tam ds-33 ds_30  ss_33 mid1 ip2 ip3 ip4 ip1) 
(setvar 'cmdecho 0)	
;---------------------------------------------
(setq ss_33 (ssget '((0 . "*text") (8 . "Level 33"))))
(if ss_33
	(progn	
		(setq ds-33 (ss2ent ss_33))
		(foreach k ds-33
			(setq s1 (ssadd k))
			(setq mid1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car (LM:ssboundingbox s1))(cadr (LM:ssboundingbox s1))))
			(setq ip1 (mapcar '+ mid1 '(-10 3.5 0)) ip4 (mapcar '+ mid1 '(10 3.5 0)))
			(setq ip2 (mapcar '+ mid1 '(10 -35 0)))
			(setq ip3 (mapcar '+ mid1 '(-10 -35 0)))
			(setq ss_text (ssget "_CP" (list  ip1 ip4 ip2 ip3) '((0 . "*text"))))
			(vl-cmdf "_.scale" ss_text "" mid1 0.1)
			(setq s1 nil)
		)
	)
)
(princ)
)
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;========================================		
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)

 

CẢM ƠN BẠN RẤT NHIỀU, MÌNH SẼ XỬ LÍ NÓ BÊN MICROSATION TRƯỚC

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×