Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hhhhgggg

Yêu cầu lisp căn chỉnh vị trí Text !

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

Tôi muốn có 1 lisp căn chỉnh được vị trí của các dòng text (viết bằng các lệnh khác nhau )cho thẳng lề...Theo trục X:trái,phải, giữa ,Căn được theo trục Y, Z .Nếu có lisp này sẽ phục vụ rất hữu ích cho việc làm Thiết kế của các kỹ sư .

Ví dụ : Yêu cầu lisp phải làm được việc sau :

Trước khi căn chỉnh : tôi có 3 dòng chữ viết bằng 3 lệnh như sau :

''''''''''''''''''Dòng1

 

''''''''''''''''''''''''''''''''''''''''''''''''''''''Dòng2

dòng3

Sau căn chỉnh:Ví dụ tôi chọn căn trái:

Dòng1

Dòng2

dòng3

 

Nếu bác nào viết được thì thông báo giúp mình qua Mail để mình bit vào Down về dùng nhé : KS_Giang@yahoo.com hoặc KS_Giang 0985.136.988

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ôi muốn có 1 lisp căn chỉnh được vị trí của các dòng text (viết bằng các lệnh khác nhau )cho thẳng lề...Theo trục X:trái,phải, giữa ,Căn được theo trục Y, Z .Nếu có lisp này sẽ phục vụ rất hữu ích cho việc làm Thiết kế của các kỹ sư .

Ví dụ : Yêu cầu lisp phải làm được việc sau :

Trước khi căn chỉnh : tôi có 3 dòng chữ viết bằng 3 lệnh như sau :

Dòng1

 

Dòng2

dòng3

Sau căn chỉnh:Ví dụ tôi chọn căn trái:

Dòng1

Dòng2

dòng3

 

Nếu bác nào viết được thì thông báo giúp mình qua Mail để mình bit vào Down về dùng nhé : KS_Giang@yahoo.com hoặc KS_Giang 0985.136.988

lệnh Mtext làm được hết mà bạn, cái gì Cad có lệnh thì ko nên viết lisp

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

Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.

Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)

lft: căn lề trái ( "" "" )

cct : căn giữa cho cột text

crt : căn giữa cho hàng text

Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)

(defun myerror (s)
 (cond
   ((= s "quit / exit abort") (princ))
   ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
 )
 (setvar "cmdecho" CMD)		; Restore saved modes
 (setvar "osmode" OSM)
 (setq *error* OLDERR)			; Restore old *error* handler
 (princ)
)




;;;==============================================================
;;; Can le fai text
;;;==============================================================
(defun c:rt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)

 (command "UCS" "W" "")

 (setq	sstxt (ssget '((-4 . "<and")
	       (-4 . "<OR")
	       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le phai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 2) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )

     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can le trai text
(defun c:lft (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "<and")
	       (-4 . "<OR")
	       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 0) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)
;;;=====================================================
;;; Can giua cot text
(defun c:cct (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "<and")
	       (-4 . "<OR")
	       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can giua hang text
(defun c:crt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "<and")
	       (-4 . "<OR")
	       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem can giua cho hang text")
XRtxt (car P1)
YRtxt (cadr P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list (car Ptxt) YRtxt  ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo ) :leluoi:

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

Bác vào trang www.cad-app.com chọ cadapp.zip download về nhé

+ Căn chỉnh mọi đối tượng Line, Polyline, text....

Lệnh: CANLE

Chọn các đối tượng cần căn chỉnh sau đó nhập:

-1: Căn trái

0: Can giữa

1: Căn phải

Áp dụng cho AutoCAD 2004,2005,2006;

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
Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.

Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)

lft: căn lề trái ( "" "" )

cct : căn giữa cho cột text

crt : căn giữa cho hàng text

Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)

Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo ) :leluoi:

 

lisp của bác Snowman ko đúng rùi, Các bác chưa hiểu ý của em rùi , Ở đây em gọi là căn lề nhưng thực ra là Move vị trí của các Text cho thẳng hàng bên trái và thẳng hàng bên phải.Vì ở đây các Text viết bằng các lệnh khác nhau mà.Cho nên chúng là các đối tượng khác nhau.Vậy nên em mong có bác Pro nào viết cho em một cái lisp để có thể move các text thẳng hàng bên trái, bên phải, giữa tim mỗi text...

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
Đây là lisp để bạn tham khảo và có thể phát triển thêm, trước đây tôi viết chơi nhưng chẳng mấy khi dùng đến.

Lệnh rt: căn lề phải (cho các text xếp theo dạng cột)

lft: căn lề trái ( "" "" )

cct : căn giữa cho cột text

crt : căn giữa cho hàng text

Bạn có thể chỉnh sửa lại tuỳ theo yêu cầu sử dụng (căn theo x, y, z ...)

(defun myerror (s)
 (cond
   ((= s "quit / exit abort") (princ))
   ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
 )
 (setvar "cmdecho" CMD)		; Restore saved modes
 (setvar "osmode" OSM)
 (setq *error* OLDERR)			; Restore old *error* handler
 (princ)
)
;;;==============================================================
;;; Can le fai text
;;;==============================================================
(defun c:rt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)

 (command "UCS" "W" "")

 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le phai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 2) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
     )

     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can le trai text
(defun c:lft (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 0) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)
;;;=====================================================
;;; Can giua cot text
(defun c:cct (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can giua hang text
(defun c:crt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W" "")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem can giua cho hang text")
XRtxt (car P1)
YRtxt (cadr P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
)

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq Ptxt   (cdr (assoc 11 object))
      NPtxt  (list (car Ptxt) YRtxt  ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))
(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

Dạo này vào quý IV, các bác nhà mình bận Tổng kết với ...đi đòi nợ hay sao mà thấy diễn đàn ... vắng vẻ (Ít có những yêu cầu kích thích sáng tạo ) -_-

 

Chào Snowman, vừa rồi tôi có tải đoạn lisp của anh về dùng, nhưng khi sử dụng không hiểu sao các text bị văng đâu mất. Bác Hoành nói là đoạn code viết anh sửa giúp. File cad, file lisp tôi đã thể hiện ở mục http://www.cadviet.com/forum/index.php?showtopic=205&pid=40506&st=1260entry40506. Anh giúp tôi với nhé.

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

Mình tìm thấy 3 lisp này, các bạn sài tạm nhé. Thanks tác giả nhiều.

 

Lệnh cdo

http://www.cadviet.com/upfiles/cdo_Canh_dong_text.fas

Lệnh cha

http://www.cadviet.com/upfiles/cha_Canh_hang_text.fas

Lệnh cle

http://www.cadviet.com/upfiles/cle_Canh_le_text.fas

  • 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
Chào Snowman, vừa rồi tôi có tải đoạn lisp của anh về dùng, nhưng khi sử dụng không hiểu sao các text bị văng đâu mất. Bác Hoành nói là đoạn code viết anh sửa giúp. File cad, file lisp tôi đã thể hiện ở mục http://www.cadviet.com/forum/index.php?showtopic=205&pid=40506&st=1260entry40506. Anh giúp tôi với nhé.

Text văng có thể là do bạn dùng Mtext.

Đây là Lisp tôi viết để dùng. Cái này giúp trình bày bản vẽ ngay ngắn hơn.

;CAN THANG HANG TEXT THEO PHUONG X VA PHUONG Y
(defun C:TX ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong X...")
	pt	(getpoint "\n Chon diem can dat cac dong text /
                                      An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	Tj	(TEXTJ (nth dem Lst))
	   		Vtriold (POS_L0 Lst dem)
			VtriNew (THAYTD Vtriold (cons Tj pt) "x")
	)
  	(entmod (subst VtriNew Vtriold (entget (nth dem Lst))))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)

(defun C:TXC ( / ss pt Lst  dem Tj X Pnew Vtriold VtriNew le Tnew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong X (can le center)...")
	pt	(getpoint "\n Chon diem can dat cac dong text / 
                                      An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	le		(assoc 72 (entget (nth dem Lst)))
	   		Vtriold (assoc 10 (entget (nth dem Lst)))
			VtriNew (THAYTD Vtriold (cons 11 pt) "Tj")
			VtriNew (THAYTD VtriNew (cons 11 pt) "x")
			Vtriold (assoc 11 (entget (nth dem Lst)))
			Tnew	(subst VtriNew Vtriold (entget (nth dem Lst)))
	)
   	(entmod (subst (cons 72 1) le Tnew))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)


(defun C:TYH ( / ss1 ss2 pt Lst1 Lst2 Y1 Y2 Yp)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss1	(C_CHU "\n Chon cac hang text thu nhat can can deu theo phuong Y...")
	ss2	(C_CHU "\n Chon cac hang text thu 2 can can deu theo phuong Y...")
	pt	(getpoint "\n Chon diem can dat cac hang text / 
                                       An enter se chon dong text dau tien hang chon lan 1 lam chuan...")
	Lst1	(SORT_Y ss1)
	Lst2	(SORT_Y ss2)
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst1 0))))
 	(setq	Y1 		(POS_L_Y Lst1 0)
		Y2 		(POS_L_Y Lst2 0)
		Yp		(cadr pt)
)
  	(command "move" ss1 "" pt (strcat "@0," (rtos (- Yp Y1))))
(command "move" ss2 "" pt (strcat "@0," (rtos (- Yp Y2))))
  	(RESTORE)
  	(DONE)
)


(defun C:TY ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew Tnew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong Y...")
	pt	(getpoint "\n Chon diem can dat cac dong text / 
                                     An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	le	(assoc 73 (entget (nth dem Lst)))
	   	Tj	(TEXTJ (nth dem Lst))
	   	Vtriold (POS_L0 Lst dem)
		VtriNew (THAYTD Vtriold (cons Tj pt) "y")
		Tnew	(subst VtriNew Vtriold (entget (nth dem Lst)))
	)
  	(entmod (subst (cons 73 0) le Tnew))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)

; HAM BAY LOI
(defun INIT ()
 	(setq 	OLD_ERROR 	*error*
		*error* 	MYERROR
)
  	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

 	(cond
   		(	(= errmsg "quit / exit abort")
	 	(princ)
	)
   		(	(/= errmsg "Function cancelled")
	 	(princ (strcat "\n Co loi: " errmsg))
	)
 	)
 	(command "Undo" 20)
 	(setvar "osmode" OLD_OSMODE)
(command "CECOLOR" OLD_CECOLOR)
	(DONE)
 	(prompt "\n Da thuc hien ham error, Reset lai thiet lap ban dau")
  	(command "Undo" "end")

)

(defun DONE ()
 	(if OLD_ERROR (setq *error* OLD_ERROR))
)
;;;;;----------------------------------------------------------
; HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE()

 	(command "Undo" "begin")
(command "UCS" "W" "")
	(setq OLD_OSMODE 		(getvar "OSMODE")
			OLD_CECOLOR 	(getvar "CECOLOR")
		OLD_AUTOSNAP	(getvar "AUTOSNAP")
		OLD_ORTHOMODE	(getvar "ORTHOMODE")
)
 	(command "cmdecho" 0)

)
(defun RESTORE()

 	(command "Undo" "end")			
 	(setvar "osmode" 	OLD_OSMODE)
(setvar "AUTOSNAP"	OLD_AUTOSNAP)
(setvar	"ORTHOMODE" OLD_ORTHOMODE)
	(command "CECOLOR" OLD_CECOLOR)
 	(command "cmdecho" 1)
(Grtext -1 "Lisp's written by Nataca - 0983.715.333")
)
------------------------------------------
;;; CHON TEXT KEM DONG NHAC (BAT BUOC CHON)
(defun C_CHU (dongnhac / ss)
(while 	(and	(not (prompt dongnhac))
 						(not (setq ss	(ssget 
							'((-4 . ""))
										)
						  )
			  		)
			)
)
ss
)
;------------------------------------------
; SAP XEP LIST THEO THU TU TANG DAN CUA TOA DO X
(defun SORT_X (ss)
(setq 	lst 	(SS2LST ss)
	lst 	(vl-sort lst
			'(lambda (e1 e2)
			   	(<
					(cadr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e1))) 0.0)
									(= (caddr (assoc 11 (entget e1))) 0.0)
								)
 								10 11)
							  	(entget e1)))
					(cadr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e2))) 0.0)
									(= (caddr (assoc 11 (entget e2))) 0.0)
								)
 								10 11)
							   	(entget e2)))
				)
			)
		)
)
)
;------------------------------------------
;;;TOA DO DIEM CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L0 (Lst c / ob) 

(setq ob (entget (nth c Lst)))
(assoc
	(if	(and 	(= (cadr 	(assoc 11 	ob)) 0.0)
				(= (caddr 	(assoc 11 	ob)) 0.0)
		)
		10 11
	) 	
	ob
)
)
;------------------------------------------
;;;XAC DINH JUSTIFY CUA TEXTS
(defun TEXTJ (ent)
(if 	(and 	(= (cadr (assoc 11 (entget ent))) 0.0)
					(= (caddr (assoc 11 (entget ent))) 0.0)
		)
		10 11
)
)
------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun THAYTD (TdOld TdNew vtri / Tj x y z)
(cond 	(	(= vtri "x")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdNew)
					y	(caddr	TdOld)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
		(	(= vtri "y")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdOld)
					y	(caddr	TdNew)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
		(	(= vtri "z")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdOld)
					y	(caddr	TdOld)
					z	(caddr	TdNew)
			)
			(list Tj x y z)
		)
		(	(= vtri "Tj")	
			(setq 	Tj	(car	TdNew)
					x 	(cadr 	TdOld)
					y	(caddr	TdOld)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
)
)
; SAP XEP LIST THEO THU TU GIAM DAN CUA TOA DO Y
(defun SORT_Y (ss)
(setq 	lst 	(SS2LST ss)
	lst 	(vl-sort lst
			'(lambda (e1 e2)
			   	(>
					(caddr (assoc
						 (if 	(and 	(= (cadr (assoc 11 (entget e1))) 0.0)
	 							(= (caddr (assoc 11 (entget e1))) 0.0)
							)
 							10 11)
							(entget e1)))
					(caddr (assoc
						 (if 	(and 	(= (cadr (assoc 11 (entget e2))) 0.0)
	 							(= (caddr (assoc 11 (entget e2))) 0.0)
							)
 							10 11)
							(entget e2)))
				)
			)
		)
)
)
;------------------------------------------
;;;TOA DO Y CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L_Y (Lst c / ob ts nd) 

(setq ob (entget (nth c Lst))
		ts (assoc
				(if	(and 	(= (cadr 	(assoc 11 	ob)) 0.0)
						(= (caddr 	(assoc 11 	ob)) 0.0)
					)
					10 11
				) 	ob)

)
(caddr ts)

)

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
Text văng có thể là do bạn dùng Mtext.

Đây là Lisp tôi viết để dùng. Cái này giúp trình bày bản vẽ ngay ngắn hơn.

;CAN THANG HANG TEXT THEO PHUONG X VA PHUONG Y
(defun C:TX ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong X...")
	pt	(getpoint "\n Chon diem can dat cac dong text / 
                                       An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	Tj		(TEXTJ (nth dem Lst))
	   		Vtriold (POS_L0 Lst dem)
			VtriNew (THAYTD Vtriold (cons Tj pt) "x")
	)
  	(entmod (subst VtriNew Vtriold (entget (nth dem Lst))))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)

(defun C:TXC ( / ss pt Lst  dem Tj X Pnew Vtriold VtriNew le Tnew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong X (can le center)...")
	pt	(getpoint "\n Chon diem can dat cac dong text /
                                     An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	le		(assoc 72 (entget (nth dem Lst)))
	   		Vtriold (assoc 10 (entget (nth dem Lst)))
			VtriNew (THAYTD Vtriold (cons 11 pt) "Tj")
			VtriNew (THAYTD VtriNew (cons 11 pt) "x")
			Vtriold (assoc 11 (entget (nth dem Lst)))
			Tnew	(subst VtriNew Vtriold (entget (nth dem Lst)))
	)
   	(entmod (subst (cons 72 1) le Tnew))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)
(defun C:TYH ( / ss1 ss2 pt Lst1 Lst2 Y1 Y2 Yp)
  	(SAVE_MODE)
  	(INIT)
  	(setq 	ss1	(C_CHU "\n Chon cac hang text thu nhat can can deu theo phuong Y...")
		ss2	(C_CHU "\n Chon cac hang text thu 2 can can deu theo phuong Y...")
		pt	(getpoint "\n Chon diem can dat cac hang text /
                                             An enter se chon dong text dau tien hang chon lan 1 lam chuan...")
		Lst1	(SORT_Y ss1)
		Lst2	(SORT_Y ss2)
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst1 0))))
 	(setq	Y1 		(POS_L_Y Lst1 0)
		Y2 		(POS_L_Y Lst2 0)
		Yp		(cadr pt)
)
  	(command "move" ss1 "" pt (strcat "@0," (rtos (- Yp Y1))))
(command "move" ss2 "" pt (strcat "@0," (rtos (- Yp Y2))))
  	(RESTORE)
  	(DONE)
)
(defun C:TY ( / ss pt Lst dem Tj X Pnew Vtriold VtriNew Tnew)
  	(SAVE_MODE)
  	(INIT)
  	(setq ss	(C_CHU "\n Chon cac hang text can can deu theo phuong Y...")
	pt	(getpoint "\n Chon diem can dat cac dong text / 
                                     An enter se chon dong text dau tien lam chuan...")
	Lst	(SORT_X ss)
	dem 0
)
  	(if (null pt) (setq pt (cdr (POS_L0 Lst 0))))
  	(repeat (length Lst)
  	(setq	le		(assoc 73 (entget (nth dem Lst)))
	   		Tj		(TEXTJ (nth dem Lst))
	   		Vtriold (POS_L0 Lst dem)
			VtriNew (THAYTD Vtriold (cons Tj pt) "y")
			Tnew	(subst VtriNew Vtriold (entget (nth dem Lst)))
	)
  	(entmod (subst (cons 73 0) le Tnew))
   	(setq dem (1+ dem))
)
  	(RESTORE)
  	(DONE)
)

; HAM BAY LOI
(defun INIT ()
 	(setq 	OLD_ERROR 	*error*
		*error* 	MYERROR
)
  	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

 	(cond
   		(	(= errmsg "quit / exit abort")
	 	(princ)
	)
   		(	(/= errmsg "Function cancelled")
	 	(princ (strcat "\n Co loi: " errmsg))
	)
 	)
 	(command "Undo" 20)
 	(setvar "osmode" OLD_OSMODE)
(command "CECOLOR" OLD_CECOLOR)
	(DONE)
 	(prompt "\n Da thuc hien ham error, Reset lai thiet lap ban dau")
  	(command "Undo" "end")

)

(defun DONE ()
 	(if OLD_ERROR (setq *error* OLD_ERROR))
)
;;;;;----------------------------------------------------------
; HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE()

 	(command "Undo" "begin")
(command "UCS" "W" "")
	(setq OLD_OSMODE 		(getvar "OSMODE")
			OLD_CECOLOR 	(getvar "CECOLOR")
		OLD_AUTOSNAP	(getvar "AUTOSNAP")
		OLD_ORTHOMODE	(getvar "ORTHOMODE")
)
 	(command "cmdecho" 0)

)
(defun RESTORE()

 	(command "Undo" "end")			
 	(setvar "osmode" 	OLD_OSMODE)
(setvar "AUTOSNAP"	OLD_AUTOSNAP)
(setvar	"ORTHOMODE" OLD_ORTHOMODE)
	(command "CECOLOR" OLD_CECOLOR)
 	(command "cmdecho" 1)
(Grtext -1 "Lisp's written by Nataca - 0983.715.333")
)
------------------------------------------
;;; CHON TEXT KEM DONG NHAC (BAT BUOC CHON)
(defun C_CHU (dongnhac / ss)
(while 	(and	(not (prompt dongnhac))
 						(not (setq ss	(ssget 
							'((-4 . ""))
										)
						  )
			  		)
			)
)
ss
)
;------------------------------------------
; SAP XEP LIST THEO THU TU TANG DAN CUA TOA DO X
(defun SORT_X (ss)
(setq 	lst 	(SS2LST ss)
	lst 	(vl-sort lst
			'(lambda (e1 e2)
			   	(<
					(cadr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e1))) 0.0)
									(= (caddr (assoc 11 (entget e1))) 0.0)
								)
 								10 11)
							  	(entget e1)))
					(cadr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e2))) 0.0)
									(= (caddr (assoc 11 (entget e2))) 0.0)
								)
 								10 11)
							   	(entget e2)))
				)
			)
		)
)
)
;------------------------------------------
;;;TOA DO DIEM CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L0 (Lst c / ob) 

(setq ob (entget (nth c Lst)))
(assoc
	(if	(and 	(= (cadr 	(assoc 11 	ob)) 0.0)
				(= (caddr 	(assoc 11 	ob)) 0.0)
		)
		10 11
	) 	
	ob
)
)
;------------------------------------------
;;;XAC DINH JUSTIFY CUA TEXTS
(defun TEXTJ (ent)
(if 	(and 	(= (cadr (assoc 11 (entget ent))) 0.0)
					(= (caddr (assoc 11 (entget ent))) 0.0)
		)
		10 11
)
)
------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun THAYTD (TdOld TdNew vtri / Tj x y z)
(cond 	(	(= vtri "x")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdNew)
					y	(caddr	TdOld)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
		(	(= vtri "y")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdOld)
					y	(caddr	TdNew)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
		(	(= vtri "z")	
			(setq 	Tj	(car	TdOld)
					x 	(cadr 	TdOld)
					y	(caddr	TdOld)
					z	(caddr	TdNew)
			)
			(list Tj x y z)
		)
		(	(= vtri "Tj")	
			(setq 	Tj	(car	TdNew)
					x 	(cadr 	TdOld)
					y	(caddr	TdOld)
					z	(caddr	TdOld)
			)
			(list Tj x y z)
		)
)
)
; SAP XEP LIST THEO THU TU GIAM DAN CUA TOA DO Y
(defun SORT_Y (ss)
(setq 	lst 	(SS2LST ss)
	lst 	(vl-sort lst
			'(lambda (e1 e2)
			   	(>
					(caddr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e1))) 0.0)
	 								(= (caddr (assoc 11 (entget e1))) 0.0)
								)
 								10 11)
							  	(entget e1)))
					(caddr (assoc
						 	(if 	(and 	(= (cadr (assoc 11 (entget e2))) 0.0)
	 								(= (caddr (assoc 11 (entget e2))) 0.0)
								)
 								10 11)
							   	(entget e2)))
				)
			)
		)
)
)
;------------------------------------------
;;;TOA DO Y CUA DOI TUONG TRONG LIST TAP HOP
(defun POS_L_Y (Lst c / ob ts nd) 

(setq ob (entget (nth c Lst))
		ts (assoc
				(if	(and 	(= (cadr 	(assoc 11 	ob)) 0.0)
							(= (caddr 	(assoc 11 	ob)) 0.0)
					)
					10 11
				) 	ob)

)
(caddr ts)

)

 

Khi tôi sử dụng lisp của a Nacata thì có báo lỗi như sau. Bác xem lỗi ở đâu nhé. Nghe nói bác có lisp dãn dòng cột của text đã up lên diễn đàn rồi mà tôi tìm không biết ở đâu.Chỉ giúp tôi đường link với.

 

Chon cac hang text can can deu theo phuong X...

Select objects: Specify opposite corner: 7 found

 

Select objects:

Chon diem can dat cac dong text / An enter se chon dong text dau tien lam

chuan...

Co loi: no function definition: SS2LST

Da thuc hien ham error, Reset lai thiet lap ban dau

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
Khi tôi sử dụng lisp của a Nacata thì có báo lỗi như sau. Bác xem lỗi ở đâu nhé. Nghe nói bác có lisp dãn dòng cột của text đã up lên diễn đàn rồi mà tôi tìm không biết ở đâu.Chỉ giúp tôi đường link với.

 

Chon cac hang text can can deu theo phuong X...

Select objects: Specify opposite corner: 7 found

 

Select objects:

Chon diem can dat cac dong text / An enter se chon dong text dau tien lam

chuan...

Co loi: no function definition: SS2LST

Da thuc hien ham error, Reset lai thiet lap ban dau

Hx. Copy thiếu mất 1 hàm con SS2LST. Phiền bạn thêm dòng code này nữa

; CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun SS2LST (ss / sodt index lstent)
(setq
	sodt (if ss (sslength ss) 0)
	index 0
)
(repeat sodt
	(setq 	ent 	(ssname ss index)
			index 	(1+ index)
			lstent 	(cons ent lstent)
	)
)
(reverse lstent)
)

Hoặc bạn dùng luôn cái này cho nó đỡ sợ bị copy thiếu.

http://www.mediafire.com/?zjymceyymwz

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
Hx. Copy thiếu mất 1 hàm con SS2LST. Phiền bạn thêm dòng code này nữa

; CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun SS2LST (ss / sodt index lstent)
(setq
	sodt (if ss (sslength ss) 0)
	index 0
)
(repeat sodt
	(setq 	ent 	(ssname ss index)
			index 	(1+ index)
			lstent 	(cons ent lstent)
	)
)
(reverse lstent)
)

Hoặc bạn dùng luôn cái này cho nó đỡ sợ bị copy thiếu.http://www.mediafire.com/?zjymceyymwz

 

Cám ơn a Nacata, anh đã có lisp DDT (dãn dòng text) rồi, có thể bổ sung thêm tính năng dãn cột text được không. Cám ơn anh nhiều.

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
Cám ơn a Nacata, anh đã có lisp DDT (dãn dòng text) rồi, có thể bổ sung thêm tính năng dãn cột text được không. Cám ơn anh nhiều.

Đã trả lời ở topic này rồi mà :leluoi:

http://www.cadviet.com/forum/index.php?sho...20&start=20

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
Mình tìm thấy 3 lisp này, các bạn sài tạm nhé. Thanks tác giả nhiều.

 

Lệnh cdo

http://www.cadviet.com/upfiles/cdo_Canh_dong_text.fas

Lệnh cha

http://www.cadviet.com/upfiles/cha_Canh_hang_text.fas

Lệnh cle

http://www.cadviet.com/upfiles/cle_Canh_le_text.fas

 

 

Lisp này mình muốn sửa lại lệnh như thế nào?có thể chuyển sang file *.lsp ko har bạn?

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

Đăng nhập để thực hiện theo  

×