Đến nội dung


Hình ảnh
- - - - -

Xin lisp căn Text vào chính giữa ô


  • Please log in to reply
13 replies to this topic

#1 traitimbuiduong

traitimbuiduong

    Chưa sử dụng CAD

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

Đã gửi 12 August 2010 - 12:56 AM

e có 1 file CAD như sau Hình đã gửi


Các bác tạo giùm e 1 cái Lisp move tâm của 1 cột Text 4830, 5208,1600...vào đường thẳng màu đỏ. E xin cảm ơn!
  • 0

#2 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 12 August 2010 - 08:07 AM

e có 1 file CAD như sau Hình đã gửi
Các bác tạo giùm e 1 cái Lisp move tâm của 1 cột Text 4830, 5208,1600...vào đường thẳng màu đỏ. E xin cảm ơn!

http://www.cadviet.c..._giua_hgvlx.rar
bạn tải về xóa"rar" và sử dụng, tên lệnh "hg"
  • 0

#3 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 12 August 2010 - 01:47 PM

e có 1 file CAD như sau Hình đã gửi
Các bác tạo giùm e 1 cái Lisp move tâm của 1 cột Text 4830, 5208,1600...vào đường thẳng màu đỏ. E xin cảm ơn!

Chọn 1 lúc nhiều text. lisp sẽ di chuyển text vào đúng trọng tâm của miền kín gần nhất bao quanh mỗi text.
(defun C:TC (/ Txt PTxt PTX SS i)
(setq SS (ssget "I") i 0)
(if (not SS)
(progn
(prompt "- Select text object")
(setq SS (ssget '((0 . "TEXT"))))
);progn
);if
(vl-load-com)
(command "UCS" "W")
(setq OSMLAST (getvar "osmode"))
(setvar "OSMODE" 0)
(repeat (sslength SS)
(setq txt (ssname SS i)
PTxt (GET_MIDTEXT txt)
PTX (GET_CENTER_REGION PTxt)
i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
(setvar "osmode" OSMLAST)
(command "UCS" "P")
(prompt "Thaistreetz@gmail.com")
(princ)
);end TC
(defun GET_CENTER_REGION (PT / SSL PTC )
(setq SSL (entlast))
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL)))
(setq SSL (entnext SSL))
);while
);if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (entlast)) 'Centroid))))
(command "erase" (entlast) "")
PTC
);progn
nil
);if
);END
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))
);end
(defun DXF (Id Obj)
(cdr (assoc Id (entget Obj)))
)
(defun GET_M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end

  • 3

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#4 traitimbuiduong

traitimbuiduong

    Chưa sử dụng CAD

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

Đã gửi 16 August 2010 - 08:51 PM

Cám ơn các bác rất nhiều
  • 0

#5 reddevil1904

reddevil1904

    Chưa sử dụng CAD

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

Đã gửi 14 September 2010 - 04:15 PM

@Thaistreetz : sao mình down về rồi
ap để load nó lên mà dùng ko đc
check lại hộ mình cái
thanks
  • 0

#6 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 14 September 2010 - 04:26 PM

@Thaistreetz : sao mình down về rồi
ap để load nó lên mà dùng ko đc
check lại hộ mình cái
thanks

Bạn tham khảo lsp này http://www.cadviet.c...showtopic=24188
Tên lệnh cc
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#7 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 17 September 2010 - 01:42 PM

@Thaistreetz : sao mình down về rồi
ap để load nó lên mà dùng ko đc
check lại hộ mình cái
thanks

Có lẽ nguyên nhân là UCS bản vẽ của bạn chưa ở World. Mình đã sửa trực tiếp vào code trên rồi nhé. bạn copy lại là dùng đc.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#8 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 02 October 2010 - 06:27 PM

Xin bác Thaistreetz bổ xung Lisp TC này có thêm option căn lề bên TRÁI và bên PHẢI trong các ô luôn nhé (Tương tự như trong Excel ấy mà). Thank you.
  • 0

#9 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 03 October 2010 - 03:00 PM

bổ xung Lisp TC này có thêm option căn lề bên TRÁI và bên PHẢI trong các ô luôn nhé (Tương tự như trong Excel ấy mà)

Có thể bạn không biết. lisp trên mình viết để áp dụng cho mọi hình dạng miền kín và mọi góc xiên của text. Vì thế với yêu cầu trên căn TRÁI VÀ PHẢI của bạn mình chỉ có thể viết để áp dụng 2 trường hợp này với điều kiện: miền kín là hình chữ nhật và text có góc quay = 0. với lựa chọn căn GIƯA, lisp vẫn làm việc bình thuờng như cũ.
Tại dòng nhắc: Select text object bạn có thể chọn đối tuợng để xử lý luôn hoặc gõ S (setting) để chọn vị trí căn lề.

(defun C:TC (/ Txt PTxt PTX SS i prmt DK TEMP_JTF DCL_ID DCL_JTF)
(setq SS (ssget "I" '((0 . "TEXT"))) i 0)
(command "undo" "begin")
(setvar "cmdecho" 0)
(if (not JTF-T) (setq JTF-T (list 0 1 0)))
(if (= (cadr JTF-T) 1)
(setq prmt "Text to Center")
(if (= (caddr JTF-T) 1) (setq prmt "Text to Right") (setq prmt "Text to Left"))
);if
(vl-load-com)
(if (not SS)
(progn
(prompt (strcat "\nSelect text object [Setting - " prmt " ]"))
(setq DK (grread nil 4 2))
(if (= (car DK) 3)
(setq SS (ssget "C" (cadr DK) (getcorner (cadr DK)) '((0 . "TEXT"))))
(if (= (cadr DK) 115)
(progn
(setq DCL_JTF (list "JTFtext : dialog {label = \"Justify in Region\"; : boxed_radio_row {"
" : radio_button { label = \"Left\"; key = \"Lft\";}"
" : spacer { width = 1.2; }"
" : radio_button { label = \"Center\"; key = \"Ctr\";}"
" : radio_button { label = \"Right\"; key = \"Rgt\";}}"
" ok_cancel;}"))
(setq TEMP_JTF (vl-filename-mktemp "CTK.DCL")
FILE_DCL (open TEMP_JTF "W"))
(foreach LL DCL_JTF (write-line LL FILE_DCL))
(close FILE_DCL)
(setq DCL_ID (load_dialog TEMP_JTF))
(new_dialog "JTFtext" DCL_ID)
(set_tile "Lft" (rtos (nth 0 JTF-T) 2 0))
(set_tile "Ctr" (rtos (nth 1 JTF-T) 2 0))
(set_tile "Rgt" (rtos (nth 2 JTF-T) 2 0))
(action_tile "accept" "(setq JTF-T (list(atof(get_tile \"Lft\"))(atof (get_tile \"Ctr\"))(atof (get_tile \"Rgt\"))))(done_dialog)")
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete TEMP_JTF)
(setq SS (ssget '((0 . "TEXT"))))
);progn
(if (= (cadr DK) 32) (exit) (progn (prompt "\nWrong Key (!) Select text oject or press [S]etting") (C:TC)))
);if
);if
);progn
);if
(if SS
(progn
(command "UCS" "W")
(setq OSMLAST (getvar "osmode"))
(setvar "OSMODE" 0)
(cond ((= (nth 1 JTF-T) 1)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_MIDTEXT txt) PTX (GET_CENTER_REGION PTxt) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_Ctr
((= (nth 0 JTF-T) 0)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_RIGHTTEXT txt) PTX (cadr (GET_LR_REGION PTxt)) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_rgt
((= (nth 2 JTF-T) 0)
(repeat (sslength SS)
(setq txt (ssname SS i) PTxt (GET_LEFTTEXT txt) PTX (car (GET_LR_REGION PTxt)) i (1+ i))
(if PTX (vl-cmdf "move" txt "" PTxt PTX))
);repeat
);list_lft
);cond
(setvar "osmode" OSMLAST)
(command "UCS" "P")
);progn
);if
(prompt "Thaistreetz@gmail.com")
(command "undo" "end")
(princ)
);end TC
(defun GET_CENTER_REGION (PT / SSL PTC )
(setq SSL (entlast))
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL)))
(setq SSL (entnext SSL))
);while
);if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (entlast)) 'Centroid))))
(command "erase" (entlast) "")
PTC
);progn
nil
);if
);END
(defun GET_LR_REGION (PT / SSL PTC )
(setq SSL (entlast))
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL)))
(setq SSL (entnext SSL))
);while
);if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (ACET-GEOM-SS-EXTENTS-FAST (ssget "L")))
(command "erase" (entlast) "")
(list (list (car (car PTC)) (+ (cadr (car PTC)) (* 0.5 (abs (- (cadr (car PTC)) (cadr (cadr PTC)))))))
(list (car (cadr PTC)) (- (cadr (cadr PTC)) (* 0.5 (abs (- (cadr (car PTC)) (cadr (cadr PTC))))))))
);progn
nil
);if
);END
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))
);end
(defun GET_RIGHTTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(list(+(car PT0)(car (cadr TB))(abs(-(cadr(car TB))(cadr (cadr TB))))) (cadr(polar PT0 (+(DXF 50 EN)(angle PT0 PTA))(distance PT0 PTA))))
)
(defun GET_LEFTTEXT (EN / TB PTxt PT0 PTA)
(setq TB (textbox (entget EN))
PTxt (GET_M2P (car TB) (cadr TB))
PT0 (DXF 10 EN)
PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
(list (- (car PT0) (abs (- (cadr (car TB)) (cadr (cadr TB))))) (cadr (polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))))
)
(defun DXF (Id Obj)
(cdr (assoc Id (entget Obj)))
)
(defun GET_M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));end

PS: Ban đừng trích dẫn bài người khác với cả code như trên. nhìn rối mắt lắm. giữ lại những gì cần phải reply thôi.
  • 3

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#10 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 06 October 2011 - 10:55 AM

Cái này sao không dùng được cho Mtext nhỉ chỉ dùng được cho Dtext thôi. thank
  • 0
^_^0905-0988.782004^_^

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 06 October 2011 - 11:06 AM

Bạn thử tìm đến những dòng này (ssget '((0 . "TEXT")))) và đổi thành (ssget '((0 . "*TEXT")))) xem có dùng được không ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 06 October 2011 - 01:52 PM

ketxu ơi mình thay như bạn nói rồi nhưng vẫn như cũ ko thể đối với Mtext
  • 0
^_^0905-0988.782004^_^

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 06 October 2011 - 02:09 PM

À, hình như bác Thaistreet sử dụng hàm Textbox, nên không chơi được với MText :) Bạn chờ xem bác ấy rỗi thì sửa cho, k thì Xplode nó ra thành Dtext rồi dụng vậy ^^
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 tranquangtriet

tranquangtriet

    biết zoom

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

Đã gửi 13 May 2015 - 09:01 AM

Chọn 1 lúc nhiều text. lisp sẽ di chuyển text vào đúng trọng tâm của miền kín gần nhất bao quanh mỗi text.

(defun C:TC (/ Txt PTxt PTX SS i)
 (setq SS (ssget "I") i 0)
  (if (not SS)
	(progn
	  (prompt "- Select text object")
	  (setq SS (ssget '((0 . "TEXT"))))
	  );progn
	);if
	(vl-load-com)
	 (command "UCS" "W")
	(setq	OSMLAST	(getvar "osmode"))
	(setvar "OSMODE" 0)
	(repeat (sslength SS)
		(setq txt (ssname SS i)
				PTxt (GET_MIDTEXT txt)
					PTX	(GET_CENTER_REGION PTxt)
					i (1+ i))
		(if PTX	(vl-cmdf "move" txt "" PTxt PTX))
	);repeat
	(setvar "osmode" OSMLAST)
	(command "UCS" "P")
	(prompt "Thaistreetz@gmail.com")
	(princ)
);end TC
(defun GET_CENTER_REGION (PT / SSL PTC )
	(setq SSL (entlast))
	(if (= (DXF 0 SSL) "POLYLINE")
		(while	(/= "SEQEND" (DXF 0 (entnext SSL)))
			(setq SSL (entnext SSL))
		);while
	);if
	(vl-cmdf "-boundary" PT "")
	(if (entnext SSL)
		(progn
			(command "region" "L" "")
			(setq PTC (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (entlast)) 'Centroid))))
			(command "erase" (entlast) "")
			PTC
		);progn
		nil
	);if	
);END
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
  (setq TB (textbox (entget EN))
		PTxt (GET_M2P (car TB) (cadr TB))
		PT0 (DXF 10 EN)
		PTA (list (+ (car PT0) (car PTxt)) (+ (cadr PT0) (cadr PTxt))))
  (polar PT0 (+ (DXF 50 EN) (angle PT0 PTA)) (distance PT0 PTA))
);end
(defun DXF (Id Obj)
	(cdr (assoc Id (entget Obj)))
)
(defun GET_M2P (PT1 PT2) (polar PT1 (angle PT1 PT2) (* 0.5 (distance PT1 PT2))));en

bạn ơi có thể thêm lệnh EDIT vào lệnh trên lun không, nghĩa là khi minh bấm 1 lệnh thì sẽ sữa được chữ và sau đó tự đưa vào centre hình gần nhất nghĩa là ghép 2 lệnh ED và TC chỉ vào 1 lệnh duy nhất thoi được không thank!!!!!!


  • 0