Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
7 replies to this topic

#1 study_forever

study_forever

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 September 2009 - 10:21 PM

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)
)

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

  • 0

#2 hai_1401

hai_1401

    biết lệnh rotate

  • Members
  • PipPipPip
  • 134 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 01 October 2009 - 10:04 AM

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
  • 0

#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 01 October 2009 - 10:40 AM

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)
)

  • 1

#4 hai_1401

hai_1401

    biết lệnh rotate

  • Members
  • PipPipPip
  • 134 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 01 October 2009 - 01:51 PM

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
  • 0

#5 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 01 October 2009 - 01:59 PM

Hoặc cái này. một cách căn lề kiểu khác :cheers:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 01 October 2009 - 02:12 PM

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 <0.0000>:
Specify width factor <0.8000>:

Specify obliquing angle <0>:
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
  • 2

#7 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 01 October 2009 - 06:53 PM

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)
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#8 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 02 October 2009 - 08:34 AM

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)
)

  • 2