Chuyển đến nội dung
Diễn đàn CADViet
traitimbuiduong

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

Bởi traitimbuiduong , trong AutoLisp

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

cd2k44    123

cd2k44
Đã đăng
e có 1 file CAD như sau 91939798.jpg

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.com/upfiles/3/lisp_can_giua_hgvlx.rar

bạn tải về xóa"rar" và sử dụng, tên lệnh "hg"

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

Thaistreetz    539

Thaistreetz
Đã đăng
e có 1 file CAD như sau 91939798.jpg

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

  • 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

Thaistreetz    539

Thaistreetz
Đã đăng
@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.

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

Phiphi-    176

Phiphi-
Đã đăng

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.

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

Thaistreetz    539

Thaistreetz
Đã đăng
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.

  • 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

ketxu    2.984

ketxu
Đã đăng

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 ?

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

ketxu    2.984

ketxu
Đã đăng

À, 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 ^^

  • 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

tranquangtriet    3

tranquangtriet
Đã đăng

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

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
Về Đầu Trang AutoLisp
×