Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
study_forever

Lisp move text vào tâm hình chữ nhật

Bởi study_forever , trong AutoLisp

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

study_forever    0

study_forever
Đã đăng

Nhờ các bác sửa giúp cái lisp để có thể move cả text lẫn Mtext vào rectang, cái lisp này chỉ move được mỗi text thôi!

 

 

;move text 2 center rectang

(defun c:dtt()

 

(setvar "cmdecho" 0)

(setq OS (getvar "OSMODE"))

(setvar "OSMODE" 32)

 

(setq P1 (getpoint "\nPick a corner of the rectangle: "))

(setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))

(setq A (angle P1 P2))

(setq D (distance P1 P2))

(setq P3 (polar P1 A (/ D 2.0)))

 

(setq ST (entsel "\nSelect text to center inside rectangle: "))

 

(while

(= ST nil)

(progn

(prompt "\nText was not selected...")

(setq ST (entsel "\nSelect text to center inside rectangle: "))

)

)

 

(command "justifytext" ST "" "MC")

(setq TMC (cdr (assoc 11 (entget (car ST)))))

(command "move" ST "" TMC P3)

 

(setvar "OSMODE" OS)

(princ)

 

)

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

gia_bach    1558

gia_bach
Đã đăng
Nhờ các bác sửa giúp cái lisp để có thể move cả text lẫn Mtext vào rectang, cái lisp này chỉ move được mỗi text thôi!

;move text 2 center rectang

.............

Bạn chạy thử LISP này : move cả text lẫn Mtext vào trung điểm của 2 điểm chỉ ra

(defun c:dtt (/ a d obj os p1 p2 p3 st)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (setq OS (getvar "OSMODE"))
 (setvar "OSMODE" 32)
 (setq P1 (getpoint "\nPick a corner of the rectangle: "))
 (setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
 (setq A (angle P1 P2))
 (setq D (distance P1 P2))
 (setq P3 (polar P1 A (/ D 2.0)))
 (setq ST (entsel "\nSelect text to center inside rectangle: "))
 (while
   (= ST nil)
    (progn
      (prompt "\nText was not selected...")
      (setq ST (entsel "\nSelect text to center inside rectangle: "))
    )
 )
 (and
   (setq obj (vlax-ename->vla-object (car st))
  typ (vlax-get obj 'ObjectName) )
   (cond
     ((= typ "AcDbText")
      (vla-put-alignment obj 10)
      (vla-put-TextAlignmentPoint obj (vlax-3d-point p3))
      )
     ((= typ "AcDbMText")
      (vla-put-AttachmentPoint obj 5)
      (vla-put-InsertionPoint obj (vlax-3d-point p3))
      )
     )
   )
 (setvar "OSMODE" OS)
 (princ)
)

  • Vote tăng 2

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

study_forever    0

study_forever
Đã đăng

Đã thế nhờ bác Gia_bach và mọi người sửa luôn giúp cái lisp này để có thể chuyển Mtext vào tâm 1 vật nào đó, thanks các bác

 

;; free lisp from cadviet.com

 

(defun c:dt ()

(defun mid (ent / p1 p2)

(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)

(setq p1 (vlax-safearray->list p1)

p2 (vlax-safearray->list p2)

pt (mapcar '+ p1 p2)

pt (mapcar '* pt '(0.5 0.5 0.5))

)

pt

)

(setq src (car (entsel "\nDoi tuong can di chuyen: ")))

(redraw src 3)

(setq des (car (entsel "\nDoi tuong dich: ")))

(redraw src 4)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command ".move" src "" (mid src) (mid des))

(setvar "osmode" oldos)

(princ)

)

(vl-load-com)

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

gia_bach    1558

gia_bach
Đã đăng
Đã thế nhờ bác Gia_bach và mọi người sửa luôn giúp cái lisp này để có thể chuyển Mtext vào tâm 1 vật nào đó, thanks các bác

.............................

(defun mid (ent / p1 p2)

(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)

(setq p1 (vlax-safearray->list p1)

p2 (vlax-safearray->list p2)

pt (mapcar '+ p1 p2)

pt (mapcar '* pt '(0.5 0.5 0.5))

)

pt

)

........................

Chào study_forever

Tiếng Việt mình, cụm từ "Đã thế" đuợc dùng trong bối cảnh nào vậy ta ?

 

Hàm (defun mid (ent / p1 p2) ..) bạn post lên không trả về tâm của 1 đối tuợng đâu !

Thưc chất là nó trả về tâm của hình chử nhật bao quanh đối tuợng đó.

"Đã thế" : tâm của 1 cung tròn (ARC) ở đâu ?

"Đã thế" : tâm của 1 đuờng kích thuớc (Dimension) ở đâu ?

.....

Khái niệm "tâm 1 vật nào đó" mà bạn Post ở trên cần phải hiểu là tâm của hình chử nhật bao quanh đối tuợng đó.

 

"Đã thế" :bạn chạy thử LISP này xem có Đã đã đã ............. hôn ? 

(defun c:dt (/ cen des obj src ss_ent typ)
 (vl-load-com)
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2))
   (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
   )
 (and
   (princ "\nChon doi tuong can di chuyen (Text,MText) : ")
   (setq ss_ent (ssget "_:S:E" '((0 . "*TEXT"))) )
   (setq src (ssname ss_ent 0))
   (not(redraw src 3))
   (setq obj (vlax-ename->vla-object src)
  typ (vlax-get obj 'ObjectName))
   (setq des (car (entsel "\nDoi tuong dich: ")))
   (not(redraw src 4))
   (setq cen (vlax-3d-point(mid des)))

   (cond
     ((= typ "AcDbText")
      (vla-put-alignment obj 10)
      (vla-put-TextAlignmentPoint obj cen)
      )
     ((= typ "AcDbMText")
      (vla-put-AttachmentPoint obj 5)
      (vla-put-InsertionPoint obj cen)
      )
     )
   )
 (princ)
 )

  • Vote tăng 3

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

hai_1401    30

hai_1401
Đã đăng

Bác Gia_bach thông cảm, chắc bác study thấy bác nhiệt tình quá nên cố gắng nhờ bác thêm 1 chút ấy mà :cheers: :cheers:

  • Vote tăng 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

study_forever    0

study_forever
Đã đăng
Chào study_forever

Tiếng Việt mình, cụm từ "Đã thế" đuợc dùng trong bối cảnh nào vậy ta ?

 

Hàm (defun mid (ent / p1 p2) ..) bạn post lên không trả về tâm của 1 đối tuợng đâu !

Thưc chất là nó trả về tâm của hình chử nhật bao quanh đối tuợng đó.

"Đã thế" : tâm của 1 cung tròn (ARC) ở đâu ?

"Đã thế" : tâm của 1 đuờng kích thuớc (Dimension) ở đâu ?

.....

Khái niệm "tâm 1 vật nào đó" mà bạn Post ở trên cần phải hiểu là tâm của hình chử nhật bao quanh đối tuợng đó.

 

"Đã thế" :bạn chạy thử LISP này xem có Đã đã đã ............. hôn ? 

(defun c:dt (/ cen des obj src ss_ent typ)
 (vl-load-com)
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2))
   (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
   )
 (and
   (princ "\nChon doi tuong can di chuyen (Text,MText) : ")
   (setq ss_ent (ssget "_:S:E" '((0 . "*TEXT"))) )
   (setq src (ssname ss_ent 0))
   (not(redraw src 3))
   (setq obj (vlax-ename->vla-object src)
  typ (vlax-get obj 'ObjectName))
   (setq des (car (entsel "\nDoi tuong dich: ")))
   (not(redraw src 4))
   (setq cen (vlax-3d-point(mid des)))

   (cond
     ((= typ "AcDbText")
      (vla-put-alignment obj 10)
      (vla-put-TextAlignmentPoint obj cen)
      )
     ((= typ "AcDbMText")
      (vla-put-AttachmentPoint obj 5)
      (vla-put-InsertionPoint obj cen)
      )
     )
   )
 (princ)
 )

Ơ nhưng mà bác Gia_bach ơi, sao cái lisp dt bác lại bỏ chức năng move các đối tượng mà chỉ để chức năng đối tượng là text thôi à? Thế thì mất hết ý nghĩa của cái lisp này rồi, em muốn vẫn giữ nguyên chức năng move các đối tượng khác vào tâm 1 đối tượng nào đó và bổ sung thêm đối tượng là mtext thôi (text thì đã được rồi), bác xem lại giúp em nhé, thanks các bác nhiều 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

gia_bach    1558

gia_bach
Đã đăng
...................

vẫn giữ nguyên chức năng move các đối tượng khác vào tâm 1 đối tượng nào đó và bổ sung thêm đối tượng là mtext thôi

.....................................

Update theo yêu cầu :
(defun c:dt (/ cen des obj src typ)
 (vl-load-com)
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2))
   (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
   )
 (and
   (setq src (car (entsel "\nChon doi tuong can di chuyen: ")))
   (not(redraw src 3))
   (setq obj (vlax-ename->vla-object src)
  typ (vlax-get obj 'ObjectName))
   (setq des (car (entsel "\nDoi tuong dich: ")))
   (not(redraw src 4))
   (setq cen (vlax-3d-point(mid des)))    
   (cond
     ((= typ "AcDbText")
      (vla-put-alignment obj 10)
      (vla-put-TextAlignmentPoint obj cen)
      )
     ((= typ "AcDbMText")
      (vla-put-AttachmentPoint obj 5)
      (vla-put-InsertionPoint obj cen)
      )
     (t (vlax-invoke obj 'Move (mid src) (mid des) ) )
     )
   )
 (princ)
 )

  • Vote tăng 5

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

study_forever    0

study_forever
Đã đăng
Update theo yêu cầu :
(defun c:dt (/ cen des obj src typ)
 (vl-load-com)
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2))
   (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
   )
 (and
   (setq src (car (entsel "\nChon doi tuong can di chuyen: ")))
   (not(redraw src 3))
   (setq obj (vlax-ename->vla-object src)
  typ (vlax-get obj 'ObjectName))
   (setq des (car (entsel "\nDoi tuong dich: ")))
   (not(redraw src 4))
   (setq cen (vlax-3d-point(mid des)))    
   (cond
     ((= typ "AcDbText")
      (vla-put-alignment obj 10)
      (vla-put-TextAlignmentPoint obj cen)
      )
     ((= typ "AcDbMText")
      (vla-put-AttachmentPoint obj 5)
      (vla-put-InsertionPoint obj cen)
      )
     (t (vlax-invoke obj 'Move (mid src) (mid des) ) )
     )
   )
 (princ)
 )

:cheers: :cheers: :cheers:

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×