[Nhờ chỉnh sửa] Xin lisp căn Text vào chính giữa ô

Tháng 10 8, 2011

Lisp này của bạn Thaistreetz viết nhưng chỉ dùng được cho Dtext nhờ các bạn chỉnh sửa để dùng cho Mtext. Thanks

Hình ảnh: ebf210b1fd0540ab9811a536b9941148_36262497.123.png

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=22849
(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

Tháng 10 8, 2011

Bạn không đọc quy định post bài ở box Autolisp à ?

Tháng 10 8, 2011

Đã sửa lại như thế có được không ketxu. Vì mình mới post lần đầu nên còn gà lắm. mong bạn thông cảm. thanks bạn cái lisp đánh cos cao độ nhé.

Tháng 10 8, 2011

Không hiểu ý của anh risusu dư nào???

Với các kiểu vẽ text vào giữa ô chữ nhật , vuông, tròn, khỏi cần phải dùng lisp! Chỉ cần dùng lệnh DT:

Command: dt TEXT

Current text style: "Standard" Text height: 25.5472 Annotative: No

Specify start point of text or [Justify/Style]: j Enter an option

[Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: c

Specify center point of text:

Specify height <25.5472>: 210

Specify rotation angle of text <0>:

( Với hình vuông, hình chữ nhật, sau khi chọn c, phải Polar tracking để bắt tâm ...)

Tháng 10 8, 2011

Không hiểu ý của anh dư nào???

Với các kiểu vẽ text vào giữa ô chữ nhật , vuông, tròn, khỏi cần phải dùng lisp! Chỉ cần dùng lệnh DT:

Command: dt TEXT

Current text style: "Standard" Text height: 25.5472 Annotative: No

Specify start point of text or [Justify/Style]: j Enter an option

[Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: c

Specify center point of text:

Specify height <25.5472>: 210

Specify rotation angle of text <0>:

( Với hình vuông, hình chữ nhật, sau khi chọn c, phải Polar trackinh để bắt tâm ...Đừng hao tổn Nơ- ron và những chuyện vô bổ!

Bạn đã dùng lisp này chưa nếu chưa thì dùng thử đi. đánh lệnh kéo 1 cái bao quanh toàn bộ text là nó tự động vào giữa rất nhanh.

Tháng 2 19, 2012

không có lits dành cho TEXT hay MTEXT hả các anh. Vì em thấy dùng text và mtext nhiều hơn DTEXT mà.

Tháng 2 19, 2012

không có lits dành cho TEXT hay MTEXT hả các anh. Vì em thấy dùng text và mtext nhiều hơn DTEXT mà.

DTEXT chính là TEXT đó.

Tháng 2 19, 2012

Lisp này của bạn Thaistreetz viết nhưng chỉ dùng được cho Dtext nhờ các bạn chỉnh sửa để dùng cho Mtext. Thanks Hình ảnh:

Những trường hợp lập bảng như thế này thì tốt hơn là dùng DTEXT cho nhẹ. Quan điểm của mình khi vẽ là hạn chế dùng MTEXT nên không viết cho MTEXT.

Mình bận nên chỉ sửa qua 1 chút theo yêu cầu của bạn (Căn TEXT hoặc MTEXT vào chính giữa ô) thôi nhá.

Không căn được MTEXT cho lựa chọn căn vào lề phải và trái của ô đâu đấy, bác nào rảnh rỗi thì sửa dùm bạn ấy cho 2 lựa chọn này. mình cảm ơn!

(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 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))));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))));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))));list_lft
);cond
(setvar "osmode" OSMLAST)
(command "UCS" "P")));if
(prompt "Thaistreetz@gmail.com")
(command "undo" "end")
(princ)
);end TC
(defun GET_CENTER_REGION (PT / SSL PTC enx)
(setq SSL (entlast) enx SSL)
(if (= (DXF 0 SSL) "POLYLINE")
(while (/= "SEQEND" (DXF 0 (entnext SSL))) (setq SSL (entnext SSL))));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))))));if
(while (setq enx (entnext enx)) (entdel enx))
ptc);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))));if
(vl-cmdf "-boundary" PT "")
(if (entnext SSL)
(progn
(command "region" "L" "")
(setq PTC (ACET-GEOM-SS-EXTENTS-FAST (ssget "L")))
(entdel (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));END
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
(setq TB (ACET-GEOM-TEXTBOX (entget EN) 0))
(GET_M2P (car TB) (caddr TB)))
(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
[/codeBOX]

Tháng 2 20, 2012

Lisp này căn được 1 dòng text vào giữa hình cn hoặc vuông,có bác nào có lisp căn nhiều dòng text vào không,cho mình xin.Thanks.

Tháng 2 20, 2012

Lisp này căn được 1 dòng text vào giữa hình cn hoặc vuông,có bác nào có lisp căn nhiều dòng text vào không,cho mình xin.Thanks.

Hề hề hề, nếu đã căn được một dòng text ắt bạn sẽ có thể căn được nhiều dòng vói một vòng lặp để căn cho các text có trong bộ chọn của bạn.

Là người tham gia diễn đàng không mới,và cũng đã có ít nhiều kinh nghiệm về lisp. bạn hãy cố gắng tự sửa cái lisp trên được không.

Gợi ý là bạn hãy chọn tập hợp các Text cần căn chỉnh bằng hàm ssget rồi sau đó lặp với hàm while hoặc foreach xem sao nhé.

Chúc bạn thành công...

Tháng 2 20, 2012

Hề hề hề, nếu đã căn được một dòng text ắt bạn sẽ có thể căn được nhiều dòng vói một vòng lặp để căn cho các text có trong bộ chọn của bạn.

Là người tham gia diễn đàng không mới,và cũng đã có ít nhiều kinh nghiệm về lisp. bạn hãy cố gắng tự sửa cái lisp trên được không.

Gợi ý là bạn hãy chọn tập hợp các Text cần căn chỉnh bằng hàm ssget rồi sau đó lặp với hàm while hoặc foreach xem sao nhé.

Chúc bạn thành công...

Nói thật với bác,về lisp thì e mù tịt,Bác có thời gian thì giúp e tí.Cảm ơn bác nhiều.

Tháng 2 20, 2012

Nói thật với bác,về lisp thì e mù tịt,Bác có thời gian thì giúp e tí.Cảm ơn bác nhiều.

Hề hề hề,

Bạn đã dùng lisp này với nhiều text chưa nhỉ???

Mình chưa dùng nhưng đọc lisp thì thấy bác ấy cho phép làm với nhiều text cơ mà. bạn hãy thử lại coi sao nhé.

Tháng 2 20, 2012

Lisp này căn được 1 dòng text vào giữa hình cn hoặc vuông,có bác nào có lisp căn nhiều dòng text vào không,cho mình xin.Thanks.

Lisp của TG Thaistress căn tất cả text/mtext trong từng ô về giữa ô. Khi đó nếu trong ô có nhiều text thì chúng sẽ đè lên nhau. Tôi đoán là ý bạn không phải thế. Có lẽ bạn muốn nếu ô có nhều dòng text thì chúng không đè lên nhau mà vẫn cách nhau theo từng hàng(?). Nếu là đúng ý bạn thì y/c của bạn đưa ra là chưa đầy đủ, vì còn nhiều vấn đề liên quan khác, chẳng hạn:

- Khoảng cách giữa các hàng?

- Khoảng cách của hàng trên/dưới so với đường bao?

Nói chung là hơi khổ đấy.

Nếu đoán sai thì thôi nhé!

Thân thương!

Tháng 2 20, 2012

Lisp của TG Thaistress căn tất cả text/mtext trong từng ô về giữa ô. Khi đó nếu trong ô có nhiều text thì chúng sẽ đè lên nhau. Tôi đoán là ý bạn không phải thế. Có lẽ bạn muốn nếu ô có nhều dòng text thì chúng không đè lên nhau mà vẫn cách nhau theo từng hàng(?). Nếu là đúng ý bạn thì y/c của bạn đưa ra là chưa đầy đủ, vì còn nhiều vấn đề liên quan khác, chẳng hạn:

- Khoảng cách giữa các hàng?

- Khoảng cách của hàng trên/dưới so với đường bao?

Nói chung là hơi khổ đấy.

Nếu đoán sai thì thôi nhé!

Thân thương!

Ý mình như thế này,có 2 dòng text(hoặc n dòng text) cách nhau 1 đoạn có sẵn.Khi sử dụng lisp sẽ đưa 2 dòng text này vào giữa 1 hcn hoặc 1 hình bất kỳ,trung điểm của khoảng cách 2 dòng text sẽ là tâm của hình đó.Nếu nhiều dòng text thì trung điểm của khoảng cách text đầu và text cuối sẽ là tâm của hình.Cảm ơn các bác đã quan tâm.

Tháng 2 20, 2012

Ý mình như thế này,có 2 dòng text(hoặc n dòng text) cách nhau 1 đoạn có sẵn.Khi sử dụng lisp sẽ đưa 2 dòng text này vào giữa 1 hcn hoặc 1 hình bất kỳ,trung điểm của khoảng cách 2 dòng text sẽ là tâm của hình đó.Nếu nhiều dòng text thì trung điểm của khoảng cách text đầu và text cuối sẽ là tâm của hình.Cảm ơn các bác đã quan tâm.

Vậy yêu cầu của bạn khác hẳn với lisp đầu topic. Mục đích của Lisp bác Thái viết là tự động sắp các Text (nhiều text) vào chính giữa ô mà nó đang đứng <=> bạn quét chọn 1 loạt Text, lisp sẽ xử lý từng thằng Text một. Còn bạn yêu cầu là coi tất cả các nhóm bạn chọn là 1, tống nó vào "tâm" 1 hình bất kỳ nào đó.

Thực ra yêu cầu của bạn cũng không khó, chỉ là kết hợp của 2 lisp xác định tâm BoundingBox tập chọn và TÂM của 1 hình bất kỳ - cả 2 đều có thể tìm thấy trong diễn đàn. Tuy nhiên, bạn hãy đưa ra định nghĩa Tâm của 1 hình bất kỳ - của bạn - và - hình đó được tạo ra như thế nào ^^

Trước đó, hãy ngó qua cái nội quy yêu cầu trong Box Autolisp ^^

Tháng 2 20, 2012

Vậy yêu cầu của bạn khác hẳn với lisp đầu topic. Mục đích của Lisp bác Thái viết là tự động sắp các Text (nhiều text) vào chính giữa ô mà nó đang đứng <=> bạn quét chọn 1 loạt Text, lisp sẽ xử lý từng thằng Text một. Còn bạn yêu cầu là coi tất cả các nhóm bạn chọn là 1, tống nó vào "tâm" 1 hình bất kỳ nào đó.

Thực ra yêu cầu của bạn cũng không khó, chỉ là kết hợp của 2 lisp xác định tâm BoundingBox tập chọn và TÂM của 1 hình bất kỳ - cả 2 đều có thể tìm thấy trong diễn đàn. Tuy nhiên, bạn hãy đưa ra định nghĩa Tâm của 1 hình bất kỳ - của bạn - và - hình đó được tạo ra như thế nào ^^

Trước đó, hãy ngó qua cái nội quy yêu cầu trong Box Autolisp ^^

Hình đã có sẵn và move text vào chính giữa hình đó bạn ah.Thanks.

Tháng 2 20, 2012

- Đó là xét theo phương Y, còn theo phương X thì sao? trong số n dòng đó, mỗi anh 1 kiểu, dài ngắn khác nhau thì bạn tính thế nào?

- Yêu cầu này của bạn nếu thực sự là nếu có ai đó viết dùm thì bạn nên cảm ơn người đó rất nhiều đấy.

Mình nói thể bởi vì đó chính xác là việc làm cực kỳ vô nghĩa. Bạn sai ngay ở cách thức bạn giải quyết công việc dẫn đến việc bạn đưa ra 1 yêu cầu tối nghĩa và.. vô nghĩa. Và cũng có thể (mình thì cho là như vậy), rằng bạn cũng chưa có cái nhu cầu ngớ ngẩn đó đâu, nhưng vì thử dùng lisp trên bạn thấy nó chưa làm được việc này, việc kia.. bạn đưa ra yêu cầu cốt để chỉ tăng thêm tính năng cho nó, nhưng bản thân bạn thì cũng chưa chắc là mình có sử dụng nó hay không.

Mình có thể viết lisp phụ vụ công việc, nhưng nếu mình có nhu cầu trên thì mình dùng lệnh Move là OK rồi. (có thể mình nói hơi khó nghe, mong bạn không giận)

Tháng 2 20, 2012

Hình đã có sẵn và move text vào chính giữa hình đó bạn ah.Thanks.

Có 1 cách để bạn không làm cho diễn đàn rối rắm vì không hiểu ý bạn, đó là: bạn post 1 bản vẽ ví dụ lên, trong đó thể hiện cái hiện hữu và cái bạn muốn đạt đến sau khi dùng lisp. Hy vọng từ đó mọi điều sẽ sáng tỏ.

Tháng 7 21, 2012

Nhờ các bác chỉnh giúp em lisp của Bác ThaiStreetZ căn chỉnh text, Mtext vào giữa 2 đường line, polyline

Tháng 7 21, 2012

Nhờ các bác chỉnh giúp em lisp của Bác ThaiStreetZ căn chỉnh text, Mtext vào giữa 2 đường line, polyline

Tháng 7 21, 2012

Nhờ các bác chỉnh giúp em lisp của Bác ThaiStreetZ căn chỉnh text, Mtext vào giữa 2 đường line, polyline

Hề hề hề,

Hãy post bản vẽ lên để mọi người biết thế nào là giữa nhé...

Tháng 7 21, 2012

Bản vẽ VD đây . Bác Giúp em nhé!http://www.cadviet.com/upfiles/3/72353_xap_text_1.dwg

Tháng 7 22, 2012

Bản vẽ VD đây . Bác Giúp em nhé!http://www.cadviet.c..._xap_text_1.dwg

Bạn dùng thử lisp này. Lệnh là TM dùng được cho Text lẩn MText. Have fun!

;;;============================[ TM.lsp ]=============================;;;
;;; Cong dung: ALign Text Middle =====================================;;;
;;; Version: 1.0 =====================================================;;;
;;; Create by damvinhduy =============================================;;;
(defun C:TM (/ Txt PTxt PTX SS n OSMLAST lstpoint1 lstpoint2 pc pt pp)
(vl-load-com)
(setq SS (ssget "I" '((0 . "*TEXT"))))
(command ".undo" "BE")
 (if (not SS)
 (progn
  (prompt "- Select text object")
  (setq SS (ssget '((0 . "*TEXT"))))
  );progn
);if
(setq OSMLAST (getvar "osmode"))
(setvar "OSMODE" 0)
(setq n 0)
(repeat (sslength SS)
 (setq txt (ssname SS n))
 (if (= (DXF 0 txt) "TEXT")
  (progn
(setq PTxt (GET_MIDTEXT txt))
(setq lstpoint1 (lstpoint (UOject txt)))
(setq lstpoint2 (lstpoint (AOject txt)))
(setq pt (pmin lstpoint1))
(setq pp (pmax lstpoint2))
(setq PTX (CV:Geom-Midpoint pt pp))
(setq Pc (list (car PTxt) (cadr PTX) 0.0))
(vl-cmdf "move" txt "" PTxt Pc)
  )
  (progn
(TM txt)
(setq PTxt (DXF 10 txt))
(setq lstpoint1 (lstpoint (UOject txt)))
(setq lstpoint2 (lstpoint (AOject txt)))
(setq pt (pmin lstpoint1))
(setq pp (pmax lstpoint2))
(setq PTX (CV:Geom-Midpoint pt pp))
(setq Pc (list (car PTxt) (cadr PTX) 0.0))
(entmod (subst (cons 10 Pc) (cons 10 PTxt) (entget txt)))
  )
 )
 (setq n (1+ n))
);repeat
(command ".undo" "E")
(princ "\n***Copyright © 2012 damvinhduy***")
(setvar "osmode" OSMLAST)
(princ)
);end TC
;;;---------------------------------------------------------------------
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
 (setq TB (textbox (entget EN))
 PTxt (CV:Geom-Midpoint (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 TM (txt / p pl hor at atnew)
(setq ver (cdr (assoc 43 (entget txt))))
(setq at (cdr (assoc 71 (entget txt))))
(setq P (cdr (assoc 10 (entget txt))))
(if
 (and (/= at 4) (/= at 5) (/= at 6))
 (progn
  (cond
((or (= at 1) (= at 2) (= at 3))
(setq p1 (polar p (* 1.5 pi) (* ver 0.5)))
)
((or (= at 7) (= at 8) (= at 9))
(setq p1 (polar p (* 0.5 pi) (* ver 0.5)))
)
  )
  (cond
((or (= at 1) (= at 7))
(setq atnew 4)
)
((or (= at 2) (= at 8))
(setq atnew 5)
)
((or (= at 3) (= at 9))
(setq atnew 6)
)
  )
  (entmod (subst (cons 10 p1) (cons 10 p) (entget txt)))
  (entmod (subst (cons 71 atnew) (cons 71 at) (entget txt)))
  (setq txt txt)
 )
 (setq txt txt)
)
)
;;;---------------------------------------------------------------------
(defun AOject (txt / h l p0 p1 ss1 LOj)
(setq h (DXF 40 txt))
(setq l (* 70 h))
(setq p0 (DXF 10 txt))
(setq p1 (polar p0 (* 0.5 pi) l))
(setq ss1 (ssget "F" (list p0 p1) (list (cons 0 "*LINE"))))
(setq AOj (ssname ss1 0))
AOj
)
;;;---------------------------------------------------------------------
(defun UOject (txt / h l p0 p2 ss2 ROj)
(setq h (DXF 40 txt))
(setq l (* 70 h))
(setq p0 (DXF 10 txt))
(setq p2 (polar p0 (* 1.5 pi) l))
(setq ss2 (ssget "F" (list p0 p2) (list (cons 0 "*LINE"))))
(setq UOj (ssname ss2 0))
UOj
)
;;;---------------------------------------------------------------------
(defun lstpoint (eline)
(cond
 (
  (wcmatch (cdr (assoc 0 (entget eline))) "LINE")
  (append (list (vlax-curve-getStartPoint eline) (vlax-curve-getEndPoint eline)))
 )
 (
  (wcmatch (cdr (assoc 0 (entget eline))) "LWPOLYLINE")
  (getvert-en eline)
 )
)
)
;;;---------------------------------------------------------------------
(defun pmin (lstpoint)
(apply 'mapcar (cons 'min lstpoint))
)
;;;---------------------------------------------------------------------
(defun pmax (lstpoint)
(apply 'mapcar (cons 'max lstpoint))
)
;;;---------------------------------------------------------------------
(defun getvert-en (en / i L)
(setq i -1 L nil)
(repeat (fix (1+ (vlax-curve-getEndParam en)))
 (setq i (1+ i) L (append L (list (vlax-curve-getPointAtParam en i))))
)
)
;;;---------------------------------------------------------------------
(defun CV:Geom-Midpoint (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))

Tháng 6 24, 2018

Vào lúc 22/7/2012 tại 10:12, damvinhduy đã nói:

Bạn dùng thử lisp này. Lệnh là TM dùng được cho Text lẩn MText. Have fun!

tm.lsp
[✎]


;;;============================[ TM.lsp ]=============================;;;
;; Cong dung: ALign Text Middle =====================================;;;
;; Version: 1.0 =====================================================;;;
;; Create by damvinhduy =============================================;;;
(defun C:TM (/ Txt PTxt PTX SS n OSMLAST lstpoint1 lstpoint2 pc pt pp)
(vl-load-com)
(setq SS (ssget "I" '((0 . "*TEXT"))))
(command ".undo" "BE")
 (if (not SS)
 (progn
  (prompt "- Select text object")
  (setq SS (ssget '((0 . "*TEXT"))))
  );progn
);if
(setq OSMLAST (getvar "osmode"))
(setvar "OSMODE" 0)
(setq n 0)
(repeat (sslength SS)
 (setq txt (ssname SS n))
 (if (= (DXF 0 txt) "TEXT")
  (progn
(setq PTxt (GET_MIDTEXT txt))
(setq lstpoint1 (lstpoint (UOject txt)))
(setq lstpoint2 (lstpoint (AOject txt)))
(setq pt (pmin lstpoint1))
(setq pp (pmax lstpoint2))
(setq PTX (CV:Geom-Midpoint pt pp))
(setq Pc (list (car PTxt) (cadr PTX) 0.0))
(vl-cmdf "move" txt "" PTxt Pc)
  )
  (progn
(TM txt)
(setq PTxt (DXF 10 txt))
(setq lstpoint1 (lstpoint (UOject txt)))
(setq lstpoint2 (lstpoint (AOject txt)))
(setq pt (pmin lstpoint1))
(setq pp (pmax lstpoint2))
(setq PTX (CV:Geom-Midpoint pt pp))
(setq Pc (list (car PTxt) (cadr PTX) 0.0))
(entmod (subst (cons 10 Pc) (cons 10 PTxt) (entget txt)))
  )
 )
 (setq n (1+ n))
);repeat
(command ".undo" "E")
(princ "\n***Copyright © 2012 damvinhduy***")
(setvar "osmode" OSMLAST)
(princ)
);end TC
;;---------------------------------------------------------------------
(defun GET_MIDTEXT (EN / TB PTxt PT0 PTA)
 (setq TB (textbox (entget EN))
 PTxt (CV:Geom-Midpoint (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 TM (txt / p pl hor at atnew)
(setq ver (cdr (assoc 43 (entget txt))))
(setq at (cdr (assoc 71 (entget txt))))
(setq P (cdr (assoc 10 (entget txt))))
(if
 (and (/= at 4) (/= at 5) (/= at 6))
 (progn
  (cond
((or (= at 1) (= at 2) (= at 3))
(setq p1 (polar p (* 1.5 pi) (* ver 0.5)))
)
((or (= at 7) (= at 8) (= at 9))
(setq p1 (polar p (* 0.5 pi) (* ver 0.5)))
)
  )
  (cond
((or (= at 1) (= at 7))
(setq atnew 4)
)
((or (= at 2) (= at 8))
(setq atnew 5)
)
((or (= at 3) (= at 9))
(setq atnew 6)
)
  )
  (entmod (subst (cons 10 p1) (cons 10 p) (entget txt)))
  (entmod (subst (cons 71 atnew) (cons 71 at) (entget txt)))
  (setq txt txt)
 )
 (setq txt txt)
)
)
;;;---------------------------------------------------------------------
(defun AOject (txt / h l p0 p1 ss1 LOj)
(setq h (DXF 40 txt))
(setq l (* 70 h))
(setq p0 (DXF 10 txt))
(setq p1 (polar p0 (* 0.5 pi) l))
(setq ss1 (ssget "F" (list p0 p1) (list (cons 0 "*LINE"))))
(setq AOj (ssname ss1 0))
AOj
)
;;;---------------------------------------------------------------------
(defun UOject (txt / h l p0 p2 ss2 ROj)
(setq h (DXF 40 txt))
(setq l (* 70 h))
(setq p0 (DXF 10 txt))
(setq p2 (polar p0 (* 1.5 pi) l))
(setq ss2 (ssget "F" (list p0 p2) (list (cons 0 "*LINE"))))
(setq UOj (ssname ss2 0))
UOj
)
;;;---------------------------------------------------------------------
(defun lstpoint (eline)
(cond
 (
  (wcmatch (cdr (assoc 0 (entget eline))) "LINE")
  (append (list (vlax-curve-getStartPoint eline) (vlax-curve-getEndPoint eline)))
 )
 (
  (wcmatch (cdr (assoc 0 (entget eline))) "LWPOLYLINE")
  (getvert-en eline)
 )
)
)
;;;---------------------------------------------------------------------
(defun pmin (lstpoint)
(apply 'mapcar (cons 'min lstpoint))
)
;;;---------------------------------------------------------------------
(defun pmax (lstpoint)
(apply 'mapcar (cons 'max lstpoint))
)
;;;---------------------------------------------------------------------
(defun getvert-en (en / i L)
(setq i -1 L nil)
(repeat (fix (1+ (vlax-curve-getEndParam en)))
 (setq i (1+ i) L (append L (list (vlax-curve-getPointAtParam en i))))
)
)
;;;---------------------------------------------------------------------
(defun CV:Geom-Midpoint (p1 p2)(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))

Lisp này canh giữa theo trục Y, Huynh nào chỉnh dùm mình theo truc X được không ? Cám ơn nhiều !

Đăng nhập

[Nhờ chỉnh sửa] Xin lisp căn Text vào chính giữa ô

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

risusu 11

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

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

risusu 11

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

hoan2182 842

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

risusu 11

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

hoangtung_91hn 0

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

Doan Van Ha 3.191

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

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

t031285 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

phamthanhbinh 3.146

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

t031285 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

phamthanhbinh 3.146

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

Doan Van Ha 3.191

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

t031285 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

ketxu 2.984

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

t031285 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

Thaistreetz 539

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

Doan Van Ha 3.191

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

banbe0274 0

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

banbe0274 0