Rated 5/5 based on 240179 internet user reviews

Jump to content


Change Photo
- - - - -

[Đ xong] - Lisp thay thế lệnh textmask của Express tool


  • Please log in to reply
4 replies to this topic

#1 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 901 posts
Danh tiếng: 492 (tốt)

Gửi vào 26 April 2012 - 04:17 PM

Lệnh Textmask của express tool "hơi bị ngu". Nó sẽ xử đẹp đối tượng text nếu text của bạn là Annotative text. (Hoặc có thể mình ngu vì kiếm hoài không ra chỗ để thiết lập cho nó chạy suôn sẻ với Annotative text.)
Thế nên mình viết lại lệnh này để có thể dùng với cả text thường lẫn Annotative text. khỏi sợ vô tình text bay đâu mất.
;;; Textmask for Annotative Text - Copyright 2012 Thaistreetz - Cadviet.com
(defun c:TMK (/ DXF MakeWipeout ss->list MakeGroup ss pt1 dk oset wipeout)
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun MakeWipeout (listpoint Layer Color xdata / dxf10 max_dist cen dxf14)
(if (and (< (atof (getvar "acadver")) 19) (not (member "acwipeout.arx" (arx)))) (arxload "acwipeout.arx"))
(setq dxf10 (list(apply'min(mapcar'car listpoint))(apply'min(mapcar'cadr listpoint))(if(caddar listpoint)(caddar listpoint)0))
	max_dist(float(apply'max(mapcar'-(apply'mapcar(cons'max listpoint))dxf10)))
	cen (mapcar'+ dxf10(list(/ max_dist 2)(/ max_dist 2) 0.0))
	dxf14 (mapcar'(lambda(p)(mapcar'/(mapcar'- p cen)(list max_dist(- max_dist)1.0)))listpoint)
	dxf14 (reverse(cons(car dxf14)(reverse dxf14))))
(entmakex (append (list
	'(0 . "WIPEOUT")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 62 (if Color Color 256))
	'(100 . "AcDbWipeout")'(90 . 0)
	(cons 10 (trans dxf10 (list 0 0 1) 0))
	(cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0))
	(cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0))
	'(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2)
	(cons 91 (length dxf14)))
	(mapcar'(lambda(p)(cons 14 p))dxf14)
	(list (cons -3 (if xdata (list xdata) nil))))))
(defun ss->list (ss / i lst)
(if ss (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)))))
(defun MakeGroup (lstEname Description / dict ind)
  (setq dict (dictsearch (namedobjdict) "ACAD_GROUP") ind "GRP1")
  (while (member (cons 3 ind) dict) (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4)))))))
  (dictadd (cdr (assoc -1 dict)) ind (entmakex (append (list '(0 . "GROUP")'(100 . "AcDbGroup")(cons 300 Description)'(70 . 0)'(71 . 1))(mapcar'(lambda(x)(cons 340 x))lstEname)))));end
(command "undo" "begin")
(prompt (Strcat "<< he so [O]ffset hien hanh = "
          (rtos (setq OSET (if (acet-getvar '("acet_textmask_offset")) (acet-getvar '("acet_textmask_offset")) 0.25)) 2 4)
      	" >>\nChon text: "))
(setq dk (grread nil 14 2))
(while DK
  (if (= (car DK) 3)
   (setq PT1 (cadr DK) ss (ss->list (ssget "C" PT1 (getcorner PT1) '((0 . "TEXT")))) dk nil)
   (if (or (equal DK '(2 111)) (equal DK '(2 79)))
	(progn
	(prompt "[Offset]")
	(grread nil 14 2) (setq oset (getreal " - nhap he so: "))
	(acet-setvar (list "acet_textmask_offset" oset 3))
	(setq dk (grread nil 14 2)))
	(setq dk (grread nil 14 2)))))
(foreach ss ss
  (setq wipeout (MakeWipeout (mapcar'(lambda (x) (trans x 1 0)) (acet-geom-textbox(entget ss) oset)) (dxf 8 ss) nil nil))
  (command "DRAWORDER" ss "" "f")
  (MakeGroup (list wipeout ss) (DXF 1 ss)))
(command "undo" "end")(princ))

Lưu ý:
- Lệnh này viết mục đích thay thế lệnh textmask, nhưng không có nghĩa là bạn không cần cài đặt express tool. Do lisp sử dụng chung hệ số offset với lệnh textmask và một số hàm của express tool nên bạn bắt buộc fải cài mới dùng được.
- Để điều chỉnh hệ số offset, nhấn fím O trước khi chọn đối tượng.
- Lisp này tạo ra đối tượng y hệt lệnh TextMask nên có thể dùng lệnh TextUnMask để đưa đối tượng về trạng thái cũ bình thường.
Similar topics from web:

  • 2

Posted Image
IN HIM, I TRUST. THE TRUST IN MY GOD


#2 hoangkimoanh

hoangkimoanh

    biết vẽ polygon

  • Members
  • PipPip
  • 76 posts
Danh tiếng: 1 (bnh thường)

Gửi vào 26 April 2012 - 05:40 PM

anh Thaistreetz ơi cho em hỏi 1 chút là cái khung textmask có màu trắng bao quanh Text có cách nào ẩn đi mà chỉ nhìn thấy chữ mặc dù vẫn có textmask? cảm ơn anh nhiều!
  • 0

#3 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 901 posts
Danh tiếng: 492 (tốt)

Gửi vào 26 April 2012 - 06:06 PM

Bạn tắt wipeout đi: gõ lệnh wipeout -> frames -> off
hoặc muốn nhanh hơn thì dùng lisp mình post ở đây
  • 0

Posted Image
IN HIM, I TRUST. THE TRUST IN MY GOD


#4 hakhoailang

hakhoailang

    biết lệnh rotate

  • Members
  • PipPipPip
  • 131 posts
Danh tiếng: 2 (bnh thường)

Gửi vào 05 May 2012 - 10:18 AM

bác Thaistreetz có thể cho e Nick yahoo hay sdt dc ko . e cũng là dân giao thông , có nhiều vấn đề em còn kém nên cần học hỏi , mới ra trường bác à .
  • 0

#5 hoanghai0000

hoanghai0000

    biết zoom

  • Members
  • Pip
  • 18 posts
Danh tiếng: 0 (bnh thường)

Gửi vào 04 October 2012 - 04:27 PM

giúp e với : làm sao để đưa text đã dùng textmask về trạng thái ban đầu vậy >>thank
  • 0