(defun C:HTT (/ ss i)
(princ "\nChon cac Text/Mtext can thay doi chieu cao...")
(if (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vl-load-com)
(prompt (strcat "\nChieu cao chu hien tai = " (vl-princ-to-string (vla-get-height (vlax-ename->vla-object (ssname ss 0))))))
(or #h (setq #h (getvar "textsize")))
(setq #h (cond ((getdist (strcat "\nChieu cao moi <"...

(defun C:HTT (/ ss i)
(princ "\nChon cac Text/Mtext can thay doi chieu cao...")
(if (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vl-load-com)
(prompt (strcat "\nChieu cao chu hien tai = " (vl-princ-to-string (vla-get-height (vlax-ename->vla-object (ssname ss 0))))))
(or #h (setq #h (getvar "textsize")))
(setq #h (cond ((getdist (strcat "\nChieu cao moi <" (vl-princ-to-string #h) ">: ")))(#h)) i -1)
(repeat (sslength ss)
(vla-put-height (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) #h)
)))
(princ))

Xin lỗi đã để thanhDuan phải đợi lâu.
Sau đây là lời giải cho bài toán này :

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi...

Xin lỗi đã để thanhDuan phải đợi lâu.
Sau đây là lời giải cho bài toán này :

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi ạ.
Tue_NV đã bẩy được cái lỗi tắt chế độ bắt điểm nhưng chưa thành công trong việc trả về trạng thái "ban đầu" của ProgBar ạ. Nhờ anh gia_bach hướng dẫn giúp ạ.
Cảm ơn anh.

mình làm bên thiết kế vì vẽ tường toàn dùng lệnh Xline và lệnh oset đối tượng

mình có thể nói rõ thế này

ví dụ mình có đường tim,có tường dầy 200 thay vì oset 2 lần 100 thì mình chỉ cần oset 1 lần sang 2 bên cách tim 100 (nếu mà nó thay thế được được Xline thì càng tốt) và có thể oset theo trục chéo .......

lisp mình tìm được này chỉ oset được đường...

mình làm bên thiết kế vì vẽ tường toàn dùng lệnh Xline và lệnh oset đối tượng

mình có thể nói rõ thế này

ví dụ mình có đường tim,có tường dầy 200 thay vì oset 2 lần 100 thì mình chỉ cần oset 1 lần sang 2 bên cách tim 100 (nếu mà nó thay thế được được Xline thì càng tốt) và có thể oset theo trục chéo .......

lisp mình tìm được này chỉ oset được đường line mình vẽ chứ kg làm được đường xline và kg oset được theo trục chéo,chỉ theo mỗi trục x và y.... >_<


;;OFFSET VE 2 BEN CUA 1 DOI TUONG ( )
(defun c:oo(/ data_m)
(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Khoang cach line cach deu sang hai ben (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)
(defun process(/ ent check)
(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)
(defun p_d_offset(/ p1 p2 p3 p4)
(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))
(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))
))
(princ)
)
(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)
(SETVAR "osmode" 16383)
(setvar "pickbox" 6)
(setvar "aperture" 6)
(setvar "orthomode" 1)



nhờ các bạn sửa lại dùm! để có thể oset theo trục chéo và dùng đc xline thay cho đường line mình vẽ

thank các bạn rất nhiều

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)

(Defun c:o2 ()
(vl-load-com)
(command "undo" "be")

(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)

>>

THử cái này xem (mình chưa thử với xline nhưng arc, circle, plinespline thì đc)

(Defun c:o2 ()
(vl-load-com)
(command "undo" "be")

(if (= droff nil)
(setq droff1 2.00)
(setq droff1 droff)
)
(setq
droff (GETREAL (strcat "\nNhap do rong offset: <" (rtos droff1 2 2) ">"))
)
(if (= droff nil)
(setq droff droff1)
)



(setq SS (ssget (list (cons 0 "ellipse,lwpolyline,spline,line,circle"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)

(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01))
(setq goc (angle diemchuan diemdinhhuong))
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) droff))
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) droff))

(command ".offset" droff textent diembentrai textent diembenphai "")

(setq i (1+ i))
(setvar "osmode" luubatdiem)
)

(command "undo" "end")
(princ)
)

Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp cv.Khi chạy lisp yêu cầu chọn phương án nhập kết quả:
1-Chọn điểm để nhập kết quả thì e muốn text ra là Style hiện hành, chiều cao là 200 và text ghi ra sẽ có dạng L= ???
2-Chọn text để gán kết quả thì cũng có dạng như trên
Két thúc lệnh.
Thanhks các Pro...

Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp cv.Khi chạy lisp yêu cầu chọn phương án nhập kết quả:
1-Chọn điểm để nhập kết quả thì e muốn text ra là Style hiện hành, chiều cao là 200 và text ghi ra sẽ có dạng L= ???
2-Chọn text để gán kết quả thì cũng có dạng như trên
Két thúc lệnh.
Thanhks các Pro nhiều!!

Lisp đó đây ạh!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=9681
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

Hờ hờ, cám ơn bác đã cho em thấy nhiều em chân dài đến thế, nổ hết cả đom đóm mắt.
Em sửa đoạn lisp để có thể chỉnh chiều cao text theo hướng dẫn được thế này:

bang
: Ha Van Khanh 3/2003
;
; * Chuong trinh duoc lap bang ngon ngu AUTOLISP.
; ------------------------------------------------------------------------------
(vmon)
(defun C:bang (/ 1x 1y a1 2x 2y a2 3x 3y a3 b p1 p2 p3 p4...

Hờ hờ, cám ơn bác đã cho em thấy nhiều em chân dài đến thế, nổ hết cả đom đóm mắt.
Em sửa đoạn lisp để có thể chỉnh chiều cao text theo hướng dẫn được thế này:

bang
: Ha Van Khanh 3/2003
;
; * Chuong trinh duoc lap bang ngon ngu AUTOLISP.
; ------------------------------------------------------------------------------
(vmon)
(defun C:bang (/ 1x 1y a1 2x 2y a2 3x 3y a3 b p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16x p16y p16 p17x p17y p17)
(setvar "cmdecho" 0)
(initget 7)
(setq osm (getvar "osmode" ))
(setvar "osmode" 0)
(command "-Style" "hoatbif" "hoatbif " "2.5" "" "" "" "" "")
(styleset)
(command "-Layer" "n" "Text" "c" "4" "Text" "")
(setq ht (getreal "\n Nhap chieu cao text ban muon: "))
(setq p1 (getpoint "\nCh&#228;n di&#211;m d&#198;t b&#182;ng th&#232;ng k&#170; :"))
(setq S (getint "\nS&#232; &#174;i&#211;m c&#199;n t&#221;nh to&#185; &#174;&#233; :"))
(setq p2 (polar p1 (/ (* Pi 3) 2) (+ 16 (* 8 S))))
(setq p3 (polar p2 0 91))
(setq p4 (polar p1 0 91))
(setq p5 (polar p1 0 21))
(setq p6 (polar p2 0 21))
(setq p7 (polar p5 0 35))
(setq p8 (polar p6 0 35))
(setq p9 (polar p5 (/ (* Pi 3) 2) 8))
(setq p10 (polar p4 (/ (* Pi 3) 2) 8))
(setq p12 (polar p9 0 35))
(setq p11 (polar p9 0 -10.5))
(setq p13 (polar p1 (/ (* Pi 3) 2) 16))
(setq p14 (polar p4 (/ (* Pi 3) 2) 16))
(setq p15 (polar p7 (/ (* pi 3 ) 2) 4))
(setq p16x (/ (+ (car p5) (car p7)) 2))
(setq p16y (/ (+ (cadr p9) (cadr p13)) 2))
(setq p17x (/ (+ (car p4) (car p7)) 2))
(setq p17y (/ (+ (cadr p9) (cadr p13)) 2))
(setq p16 (list p16x p16y))
(setq p17 (list p17x p17y))
(command "Plinewid" "0.5")
(command "Pline" p1 p2 p3 p4 p1 "")
(command "Line" p5 p6 "")
(command "Line" p12 p8 "")
(command "Line" p9 p10 "")
(command "Line" p13 p14 "")
(command "Array" "l" "" "Rec" S "1" "-8")
(command "text" "j" "mc" p11 ht "0" "T&#170;n n&#243;t" )
(command "text" "j" "mc" p15 ht "0" "To&#185; &#174;&#233;" )
(command "text" "j" "mc" p16 ht "0" "X" )
(command "text" "j" "mc" p17 ht "0" "Y" )
(setvar "osmode" 1)
;-------------------------------------------------
; Ph&#199;n s&#246; l&#253; ch&#247;
(setq b 0)
(while (< b s )
(setq b (+ b 1))
(setq td (getstring "\Nh&#203;p t&#170;n &#174;i&#211;m l&#202;y to&#185; d&#233; : "))
(if (or (= td "") (= td " "))
(setq td (cdr (assoc 1 (entget (car (entsel "\n Chon text san co tren ban ve"))))))
)
(setq tp (getpoint "\Ch&#228;n &#174;i&#211;m : "))
(setq tx (rtos (car tp) 2 4 ))
(setq ty (rtos (cadr tp) 2 4 ))
(setq 1x (/ (+ (car p1) (car p5)) 2))
(setq 1y (- (- (cadr p11) 4) (* 8 ))
(setq a1 (list 1x 1y))
(setq 2x (/ (+ (car p5) (car p7)) 2))
(setq 2y (- (cadr p16) (* 8 ))
(setq a2 (list 2x 2y))
(setq 3x (/ (+(car p7) (car p4)) 2))
(setq 3y (- (cadr p17) (* 8 ))
(setq a3 (list 3x 3y))
(command "text" "j" "mc" a1 "0" td "" )
(command "text" "j" "mc" a3 "0" tx "" )
(command "text" "j" "mc" a2 "0" ty "" )
)
)
(defun styleset (/ stl h)
(setq stl (getvar "textstyle")
h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)


Bác xem giúp em xem lỗi ở đâu mà khi đến bước chọn tên điểm, chọn điểm xong lại ra tiếp thông báo như thế này:
; error: Function cancelled
Specify height <2.00>:
Mà nó không tiếp tục lệnh để chọn điểm tiếp được luôn, bác nhỉ.
File cad để test: http://www.cadviet.com/upfiles/3/40304_binh_do_tnm_3.rar

- Chào diễn đàn, mình mới biết căn bản về lisp và có viết 1 đoạn lisp theo tài liệu của diễn đàn để phục vụ công việc vẽ 1 đường thẳng bằng cách nhập chiều cao và khoảng cách từng đoạn thẳng. Nhưng không có khả năng code phần nhập khoảng cách và lập đi lại nhiều lần nên nhờ diễn đàn chỉnh sửa giúp. Mình đính kèm file cad và phần code của mình nhờ mọi người giúp đỡ.

>>

- Chào diễn đàn, mình mới biết căn bản về lisp và có viết 1 đoạn lisp theo tài liệu của diễn đàn để phục vụ công việc vẽ 1 đường thẳng bằng cách nhập chiều cao và khoảng cách từng đoạn thẳng. Nhưng không có khả năng code phần nhập khoảng cách và lập đi lại nhiều lần nên nhờ diễn đàn chỉnh sửa giúp. Mình đính kèm file cad và phần code của mình nhờ mọi người giúp đỡ.
(defun c:dpl ()
(setq P1 (getpoint "cho diem dau: "))
(setq L (getreal "nhap chieu dai: "))
(setq D 80.000)
(setq D1 (* (- L D) 1000))
(setq P2 (polar P1 (/ Pi 2) D1))
(command "line" P1 P2 "")
(princ)
)

http://www.cadviet.c...35974_banve.dwg

- xong.

Dễ như bắt cua trong hang!

Ở vd trên hàm get_Dictionary đọc dữ liệu lưu trong từ điển với :
- vla_filename : là tên file kiểu VLA_object
- dic : là tên từ điển.
Trong hàm get_Dictionary tôi có sử dụng hàm vl-catch-all-error-p để bẫy lỗi trong t/hợp file cần đọc không có từ điển tên là dic.

Để đọc các loại dữ liệu khác, các bạn viết lại...

- xong.

Dễ như bắt cua trong hang!

Ở vd trên hàm get_Dictionary đọc dữ liệu lưu trong từ điển với :
- vla_filename : là tên file kiểu VLA_object
- dic : là tên từ điển.
Trong hàm get_Dictionary tôi có sử dụng hàm vl-catch-all-error-p để bẫy lỗi trong t/hợp file cần đọc không có từ điển tên là dic.

Để đọc các loại dữ liệu khác, các bạn viết lại hàm get_Dictionary .

Đóng gói toàn bộ các dòng trên (bắt chuớc ketxu)

Em thêm như này đúng chưa ah?

;-----------------Lap bang thong ke ga ----------------------------
; Free lisp code from CADViet - edit by Mathan
(defun C:LBHG (/ TX TY kcach)
(setq diem (getpoint "\Chon vi tri lap bang... "))
(setq kcach (getreal "\n Nhap chieu cao text trong bang: "))
(prompt "\nBan can pick tung text theo thu tu Ten ho ga; cao do day va cao do dinh ga: ")
(setq dem 1 sdt 1)

>>

Em thêm như này đúng chưa ah?

;-----------------Lap bang thong ke ga ----------------------------
; Free lisp code from CADViet - edit by Mathan
(defun C:LBHG (/ TX TY kcach)
(setq diem (getpoint "\Chon vi tri lap bang... "))
(setq kcach (getreal "\n Nhap chieu cao text trong bang: "))
(prompt "\nBan can pick tung text theo thu tu Ten ho ga; cao do day va cao do dinh ga: ")
(setq dem 1 sdt 1)
(setq ss null)
(while (/= ss nil)
(if (= dem 1)
(progn
(setq ss (car (entsel "\nDS> Ten ho ga: ")))
(setq noidung (cdr (assoc 1 (entget ss))))
(setq diem1 (list (car diem) (- (cadr diem) (* sdt kcach))))
(command "TEXT" diem1 kcach "" "" noidung)
))
(if (= dem 2)
(progn
(setq ss (car (entsel "\nDS> Cao do dinh H1: ")))
(setq noidung (cdr (assoc 1 (entget ss))))
(setq diem2 (list (+ (* 2 kcach) (car diem)) (- (cadr diem) (* (- sdt 1) kcach))))
(command "TEXT" diem2 kcach "" "" noidung)
))
(if (= dem 3)
(progn
(setq ss (car (entsel "\nDS> Cao do day H2: ")))
(setq noidung (cdr (assoc 1 (entget ss))))
(setq diem3 (list (+ (* 4 kcach) (car diem)) (- (cadr diem) (* (- sdt 2) kcach))))
(command "TEXT" diem3 kcach "" "" noidung)
(setq dem 0)
))
(setq dem (+ 1 dem))
(setq sdt (+ 1 sdt))
(princ)
)
)


Nhưng test lại nó không lập được bảng mà báo lỗi thế này:
Ban can pick tung text theo thu tu Ten ho ga; cao do day va cao do dinh ga:
DS> Ten ho ga: Unknown command "LBHG". Press F1 for help.
Unknown command "G16B". Press F1 for help.

DS> Cao do dinh H1: Unknown command "LBHG". Press F1 for help.
Unknown command "6.05". Press F1 for help.

DS> Cao do day H2: Unknown command "LBHG". Press F1 for help.
Unknown command "4.48". Press F1 for help.

mình đã kiểm tra và sửa toàn bộ lỗi rồi nhưng mà nó báo khi thi hành lệnh là hok hiểu. Hik hok co hiểu tại sao luôn
còn đây là code mình đã sửa lại

(defun C:ccb (/ ename ename1 ename2 ename3 ename4 ename5
x1 x2 x3 x4 y1 y2 y3 y4 p1 p2 p3 p4)
(setq
ename (entsel "\n Chon doi tuong :")
ename1 (car ename)
ename2 (entget ename1)
ename3 (cdr (assoc 340 ename2))
ename4...

mình đã kiểm tra và sửa toàn bộ lỗi rồi nhưng mà nó báo khi thi hành lệnh là hok hiểu. Hik hok co hiểu tại sao luôn
còn đây là code mình đã sửa lại

(defun C:ccb (/ ename ename1 ename2 ename3 ename4 ename5
x1 x2 x3 x4 y1 y2 y3 y4 p1 p2 p3 p4)
(setq
ename (entsel "\n Chon doi tuong :")
ename1 (car ename)
ename2 (entget ename1)
ename3 (cdr (assoc 340 ename2))
ename4 (entget ename3)
);end setq
(ssget
'((-4 . "<or")
(0 . "RBCRENBARSHAPEDESC")
(0 . "RBCR_ENDE_BARDDESC")
(-4 . "or>")
)'
)
p3 (nth 50 ename3)
p2 (nth 47 ename3)
p1 (nth 44 ename3)
x1 (cadr
(nth 44 ename3)
)
x2 (cadr
(nth 47 ename3)
)
x3 (cadr
(nth 50 ename3)
)
(if (> x3 x2)
(setq x4 (- x2 kcach))
(setq x4 (+ x2 kcach))
)
(setq
ename5 (subst p4 p3 ename4)
ename1 (append enam1 neame5)
(entmod ename1)
)
(Command: "_.mirror" ss "" p1 p2)
(princ)
)