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

Lisp căn lề - nhờ các bác sửa giúp 1 ít

Bởi study_forever , trong AutoLisp

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

study_forever    0

study_forever
Đã đăng

Có cái lisp căn lề rất hay, em đưa lên cho anh em nào chưa biết thì dùng, với cả nhờ bác nào thạo về lisp sửa giúp em để lệnh CLG (căn lề giữa) có thể áp dụng cho cả Mtext, thanks

 

;Viet boi: KTS_DUY  BINH SON - QUANG NGAI
;Dien dan: tailieukythuat.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(Defun c:clt ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT,MTEXT"))))

(setq diemcanhle (getpoint "\nChon diem canh le :"))

(setq i 0)
(setq N (sslength ss))
(while (< i N)

 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)

  (setq DT (ssname ss i))
  (setq DTT (entget DT))
  (setq TEXT (cdr (assoc 10 DTT)))
  (setq Xcanhle (list (car diemcanhle)(cadr text))) 
  (command ".move" DT "" TEXT Xcanhle)

 (setvar "osmode" luubatdiem) 

  (setq i (1+ i))

)
(command "undo" "end")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
     (Princ)
) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(Defun c:cln ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT,MTEXT"))))

(setq diemcanhle (getpoint "\nChon diem canh le :"))

(setq i 0)
(setq N (sslength ss))
(while (< i N)

 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)

  (setq DT (ssname ss i))
  (setq DTT (entget DT))
  (setq TEXT (cdr (assoc 10 DTT)))
  (setq Xcanhle (list (car text)(cadr diemcanhle)))  
  (command ".move" DT "" TEXT Xcanhle)

 (setvar "osmode" luubatdiem) 

  (setq i (1+ i))

)
(command "undo" "end")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
     (Princ)
) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(Defun c:clp ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(setvar "mirrtext" 0)
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT,MTEXT"))))

(setq diemcanhle (getpoint "\nChon diem canh le :"))

(setq i 0)
(setq N (sslength ss))
(while (< i N)

 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)

  (setq DT (ssname ss i))
  (setq DTT (entget DT))
  (setq TEXT (cdr (assoc 10 DTT)))
  (setq Xcanhle (list (car diemcanhle)(cadr text))) 
  (command ".move" DT "" TEXT Xcanhle)
  (command ".mirror" DT "" Xcanhle diemcanhle "y")

 (setvar "osmode" luubatdiem) 

  (setq i (1+ i))

)
(command "undo" "end")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
     (Princ)
) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(Defun c:clg ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
;(setvar "mirrtext" 0)
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT"))))

(setq diemcanhle (getpoint "\nChon diem canh le :"))

(setq i 0)
(setq N (sslength ss))
(while (< i N)

 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)

  (setq DT (ssname ss i))
  (setq DTT (entget DT))
  (setq TEXT (cdr (assoc 10 DTT)))
  (setq Xcanhle (list (car diemcanhle)(cadr text))) 
  (command ".move" DT "" TEXT Xcanhle)
  (command ".mirror" DT "" Xcanhle diemcanhle "y")

  (setq DTTG (entget DT))
  (setq TEXTG (cdr (assoc 10 DTTG)))
 (setq  daitextg (distance Xcanhle TEXTG))
 (setq goctextg(angle Xcanhle TEXTG))
 (setq dainuatextg (/ daitextg 2))
 (setq diemquayg (polar Xcanhle goctextg dainuatextg))
 ;(setq diemlatg (list (car diemquayg) (+ (cadr diemquayg) 100)))
  (command ".move" DT "" diemquayg Xcanhle)
  ;(command ".mirror" DT "" diemquayg diemlatg "y")

 (setvar "osmode" luubatdiem) 

  (setq i (1+ i))

)
(command "undo" "end")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
     (Princ)
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;
;---------------------------------------
(defun nstr (stri def)
(princ stri)
(princ "<")
(princ " ")
(princ def)
(princ ">")
(princ ":")
(princ " ")
);defun nstr
;--------------------
(defun nstr1 (stri)
(princ stri)
(princ "<")
(princ "Nhap vao")
(princ ">")
(princ ":")
(princ " ")
);defun nstr1
;---------------------
(defun nint (prompt def / temp)
(if def
 (setq temp (getint (nstr prompt def)))
 (setq def (getint (nstr1 prompt)))
);if def
(if temp
 (setq def temp)
 def
);if temp
);defun nint
;---------------------
(defun dnint (prompt def / temp)
(if def
 (setq temp (getreal (nstr prompt def)))
 (setq def (getreal (nstr1 prompt)))
);if def
(if temp
 (setq def temp)
 def
);if temp
);defun nint
;--------------------
(defun ndist (po prompt def / temp) ;nhan kh/cach va luu gia tri mac dinh
(if def
 (setq temp (getdist po (nstr prompt def)))
 (setq def (getdist po (nstr1 prompt)))
)if def
(if temp
   (setq def temp)
   def
);if temp
);defun ndist
;-----------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;


(Defun zoomduy ( )
 (command ".zoom" "")
   (Princ)) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;


(Defun thoi ()
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
     (Princ)
)  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;

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

hai_1401    30

hai_1401
Đã đăng

Em chẳng biết 1 tí j về lisp cả, nhưng em thấy lisp này có 4 lệnh thì 3 lệnh có cái cấu trúc Text và Mtext là (setq SS (ssget '((0 . "TEXT,MTEXT")))), cái CLG (căn lề giữa) thấy khác (setq SS (ssget '((0 . "TEXT")))) chỉ có text ko thôi nên em nghĩ bác thử thay đổi lại xem có được ko

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

Tue_NV    3.912

Tue_NV
Đã đăng
Em chẳng biết 1 tí j về lisp cả, nhưng em thấy lisp này có 4 lệnh thì 3 lệnh có cái cấu trúc Text và Mtext là (setq SS (ssget '((0 . "TEXT,MTEXT")))), cái CLG (căn lề giữa) thấy khác (setq SS (ssget '((0 . "TEXT")))) chỉ có text ko thôi nên em nghĩ bác thử thay đổi lại xem có được ko

Không được bạn hai_1401 à

Bạn Hai và study sử dụng code này thử xem nhé : 

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq dcle (getpoint "\n Chon diem canh le :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car dcle) (cadr dcuoi) 0))  
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)
;
(defun ss2ent (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)
)

  • 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

hai_1401    30

hai_1401
Đã đăng
Không được bạn hai_1401 à

Bạn Hai và study sử dụng code này thử xem nhé : 

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq dcle (getpoint "\n Chon diem canh le :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car dcle) (cadr dcuoi) 0))  
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)
;
(defun ss2ent (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)
)

Em lại thấy đuợc bác Tue ạ, và lạ hơn nữa là em có cái bản vẽ, khi áp dụng cả 2 cái lisp (cái của bác và cái của bạn study) thì không thế sử dụng đuợc mấy cái lệnh căn lề ấy (áp dụng với Mtext), mỗi khi dùng thì Mtext lại biến đi đâu hết ấy. Nhưng khi copy hết các Mtext ra 1 file bản vẽ khác thì lại có thể dùng cả 2 lisp trên để căn lề đuợc. Em nghĩ tại cái bản vẽ của em nó bị làm sao ấy, nhờ các bác xem giúp cái nhé Ban ve day

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

Tue_NV    3.912

Tue_NV
Đã đăng
Hoặc cái này. một cách căn lề kiểu khác :cheers:

Chào Thaistreetz

Lisp của bạn không còn đúng đối với font chữ shx nữa. Bạn cứ thử với font shx mà bạn hải đã post mà xem

Lỗi ở dòng( Command style ...

Command: -style

Enter name of text style or [?] :

 

Existing style.

Specify full font name or font filename (TTF or SHX) :

Specify height of text :

Specify width factor :

 

Specify obliquing angle :

Display text backwards? [Yes/No] :

Display text upside-down? [Yes/No] :

Vertical? : đối với font shx -> thì có thêm dòng này nữa còn các loại font khác không có => bị lỗi

  • Vote tăng 2

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
Chào Thaistreetz

Lisp của bạn không còn đúng đối với font chữ shx nữa. Bạn cứ thử với font shx mà bạn hải đã post mà xem

Đúng rồi đấy anh Tuệ. Em quên mất chưa sửa lỗi này vào lisp post trên diễn đàn. sở dĩ bị lỗi này là vì với các font shx thì ta có thêm lựa chọn Vertical (viết chữ theo hàng dọc) khi thiết lập textstyle. để sửa lỗi này ta chỉ cần thêm một cặp dấu nháy kép như sau là có thể chạy tốt với cả SHX và TTF:

Từ: (command "-style" txt_st "" "" txt_fctr "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)

Sửa thành: (command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 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

gia_bach    1.549

gia_bach
Đã đăng
Có cái lisp căn lề rất hay, em đưa lên cho anh em nào chưa biết thì dùng, với cả nhờ bác nào thạo về lisp sửa giúp em để lệnh CLG (căn lề giữa) có thể áp dụng cho cả Mtext, thanks

..................

Lisp căn lề (Center/Left/Right/Top/Bottom) áp dụng cho cả Text và Mtext.

(defun c:CanLe (/ ActDoc Opt Pt ss Cen LL UR)
 (vl-load-com)
 (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (vla-StartUndoMark ActDoc)
 (if
   (and
     (setq Pt (getpoint "\n Chon diem can le :"))
     (princ "\nChon doi tuong can can le (Text,MText) : ")
     (setq ss (ssget '((0 . "*TEXT"))))
     (not (initget "L R C T B"))
     (setq Opt (if (setq Opt (getkword "\n Chon kieu can le [Center/Left/Right/Top/Bottom] : < Center > "))  Opt "C" ) )
     )
   (foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (vla-GetBoundingBox e 'LL 'UR)
     (setq LL (safearray-value LL)
    UR (safearray-value UR))
     (cond
((= Opt "C")
 (setq Cen (mapcar '* (mapcar '+ LL UR) '(0.5 0.5 0.5))) 
 (vlax-invoke e 'Move Cen (list (car Pt)(cadr Cen)(caddr Cen) ) ) )
((= Opt "L")
 (vlax-invoke e 'Move LL (list (car Pt)(cadr LL)(caddr LL) ) ))
((= Opt "R")
 (vlax-invoke e 'Move UR (list (car Pt)(cadr UR)(caddr UR) ) ))
((= Opt "T")
 (vlax-invoke e 'Move UR (list (car UR)(cadr Pt)(caddr UR) ) ))
((= Opt "B")
 (vlax-invoke e 'Move LL (list (car LL)(cadr Pt)(caddr LL) ) ))
)
     )
   )
   (vla-EndUndoMark ActDoc)
   (princ)
)

  • Vote tăng 2

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
×