Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
study_forever

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

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

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    1.442
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

Đã 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    1.442
Đã 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

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
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    1.442
...................

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
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  

×