Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 29 September 2009 - 11:08 PM

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)

)
  • 0

#2 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 30 September 2009 - 07:42 AM

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

  • 2

#3 m00n

m00n

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 September 2009 - 08:43 AM

cam on ban nhieu
  • 0
Le Hoang Anh
HỌA VIÊN KIẾN TRÚC
Mobile: 098.996.0.339
E.mail: hoanganh2002@yahoo.com
IM: hoanganhle2002
Head Office:
184 Tran Nao Str., Binh An W., Dst. 2, HCMC, Vietnam
Phone: +84-8-3740 7520
Fax :+84-8-3748 7521
email: info@kiengia.vn
KIEN GIA Consultion Construction Corporation
ARTCHITECTURE - INTERIOR - LANDSCAPE - BUILDING

#4 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 September 2009 - 05:12 PM

Đã 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)
  • 0

#5 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 01 October 2009 - 09:36 AM

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

  • 3

#6 hai_1401

hai_1401

    biết lệnh rotate

  • Members
  • PipPipPip
  • 134 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 01 October 2009 - 09:48 AM

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:
  • 1

#7 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 October 2009 - 12:15 PM

Hi thanks các bác nhiều :cheers:
  • 0

#8 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 October 2009 - 12:45 PM

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

#9 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 02 October 2009 - 01:11 PM

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

  • 5

#10 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 October 2009 - 03:14 PM

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:
  • 0