Lisp miễn phí mã nguồn mở căn chỉnh text theo phương ngang đứng HT HP VT | AutoLISP Reviewer

Ứng dụng được phát triển/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản

   

Thông tin thêm: 👉👉👉

Lisp căn chỉnh Text

HT HP căn chỉnh text theo phương ngang

VT căn chỉnh text theo phương thẳng đứng

1 Thêm class HT HP VT can chinh text by AJS_.lsp

Lưu mã sau dưới dạng tệp tin HT HP VT can chinh text by AJS_.lsp

Code:

;--------------------------------------Can chinh chu theo phuong dung ben phai-----------------------------------
(defun c:hp ( / sset ssl temp ed old new )
  (setq sset (ssget))
  (setq ssl (sslength sset) 
        nsset (ssadd)
  )
  (print ssl)
  (princ "entities found. ")  
(print)
;(text_u_ssget)
(setq ssl (sslength sset))
(if (> ssl 0) 
(setq pt1 (getpoint "New aligned point of the selected entities : ")))
  (while (> ssl 0)
    (progn
      (setq temp (ssname sset (setq ssl (1- ssl))))
      (setq ed (entget temp))
;;;TEXT
      (if (= (DXF 0 ed) "TEXT")
      (progn
         (setq 
             old2(nth (xdtt 10 ed) ed)
             old1 (nth (xdtt 72 ed) ed)
             new1 (cons 72 2)
             ed (subst new1 old1 ed)
                     old3 (nth (xdtt 73 ed) ed)
                     new3 (cons 73 0)
                     ed (subst new3 old3 ed)
             old (nth (xdtt 11 ed) ed)
             new (list (nth 0 old) (car pt1) (nth 2 old2) (nth 3 old))
             ed (subst new old ed)
             ed (subst new1 old1 ed)
                     
          )
      (entmod ed)  
      )  
  )

;;;MTEXT
      (if (= (DXF 0 ed) "MTEXT")
      (progn
         (setq 
             old1 (nth (xdtt 71 ed) ed)
             new1 (cons 71 3)
             ed (subst new1 old1 ed)           
             old (nth (xdtt 10 ed) ed)
             new (list (nth 0 old) (car pt1) (nth 2 old) (nth 3 old))
             ed (subst new old ed)                            
          )
      (entmod ed)  
      )  
  )      
 )
)


(setq pt1 nil)
 (princ)
);defun

(defun RAD (degree)
  (setq radian (/ (* degree 3.141592654) 180))
  radian
)

(defun DEG (Rad)
  (setq degree (/ (* rad 180) 3.141592654))
  degree
)

(defun tangent (Rad)
  (setq tang (/ (sin rad) (cos rad)))
  tang
)
(defun DXF (code elist)
  	(cdr (assoc code elist))
)

(defun CDXF (tt elist)
  (car (nth tt elist))
)
;CDXF - xac dinh thu tu cua tieu danh sach

(defun xdtt (code elist)
(setq i 0)
(while (/= code (cdxf i elist))
;(progn
  (setq i (+ 1 i))
);while
)
;--------------------------------------Can chinh chu theo phuong dung ben trai-----------------------------------
(defun c:ht( / sset ssl temp ed old new )
  (setq sset (ssget))
  (setq ssl (sslength sset) 
        nsset (ssadd)
  )
  (print ssl)
  (princ "entities found. ")  
(print)
;(text_u_ssget)
(setq ssl (sslength sset))
(if (> ssl 0) 
(setq pt1 (getpoint "New aligned point of the selected entities : ")))
  (while (> ssl 0)
    (progn
      (setq temp (ssname sset (setq ssl (1- ssl))))
      (setq ed (entget temp))
;;;TEXT
     (if  (= (DXF 0 ed) "TEXT")
      (progn
       (setq 
             old1 (nth (xdtt 72 ed) ed)
             new1 (cons 72 0)
             old (nth (xdtt 10 ed) ed)
                     old3 (nth (xdtt 73 ed) ed)
                     new3 (cons 73 0)
                     ed (subst new3 old3 ed)
             new (list (nth 0 old) (car pt1) (nth 2 old) (nth 3 old))
             ed (subst new old ed)
             ed (subst new1 old1 ed)   
           )
      (entmod ed)  
      )  
  )

;;;MTEXT
      (if (= (DXF 0 ed) "MTEXT")
      (progn
         (setq 
             old1 (nth (xdtt 71 ed) ed)
             new1 (cons 71 1)
             ed (subst new1 old1 ed)           
             old (nth (xdtt 10 ed) ed)
             new (list (nth 0 old) (car pt1) (nth 2 old) (nth 3 old))
             ed (subst new old ed)                            
          )
       (entmod ed)  
      )  
  )   
)
)
(setq pt1 nil)
 (princ)
);defun

;--------------------------------------Can chinh chu theo phuong ngang----------------------------------
(defun c:vt( / sset ssl temp ed old new )
  (setq sset (ssget))
  (setq ssl (sslength sset) 
        nsset (ssadd)
  )
  (print ssl)
  (princ "entities found. ")  
(print)
;(text_u_ssget)
(setq ssl (sslength sset))
(if (> ssl 0) 
(setq pt1 (getpoint "New aligned point of the selected entities : ")))
  (while (> ssl 0)
    (progn
      (setq temp (ssname sset (setq ssl (1- ssl))))
      (setq ed (entget temp))
;;;TEXT
     (if  (= (DXF 0 ed) "TEXT")
      (progn
       (setq 
             old1 (nth (xdtt 72 ed) ed)
             new1 (cons 72 0)
             old (nth (xdtt 10 ed) ed)
                     old3 (nth (xdtt 73 ed) ed)
                     new3 (cons 73 0)
                     ed (subst new3 old3 ed)
             new (list (nth 0 old) (nth 1 old) (cadr pt1) (nth 3 old))
             ed (subst new old ed)
             ed (subst new1 old1 ed)   
           )
      (entmod ed)  
      )  
  )
;;;MTEXT
      (if (= (DXF 0 ed) "MTEXT")
      (progn
         (setq 
             old1 (nth (xdtt 71 ed) ed)
             new1 (cons 71 7)
             ed (subst new1 old1 ed)           
             old (nth (xdtt 10 ed) ed)
             new (list (nth 0 old) (nth 1 old) (cadr pt1) (nth 3 old))
             ed (subst new old ed)                            
          )
       (entmod ed)  
      );progn  
      );if
 );while
);if

(setq pt1 nil)
 (princ)
);defun

Link tải (MediaFire)

📥 https://www.mediafire.com/

---------------------------------------------------------------------------------------------

Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!

Cảm ơn bạn đã theo dõi!