Gửi bạn dùng thử

;; Free lisp code from CADViet - Edit by mathan
;;;;;;;;;;;;;;;;;;;;;;;; Doi huong tuyen
(defun c:rev (/ ss count lwp ent obj oname sss revlwpl revln)
(defun revlwpl(/ eo el len)
(setq eo ent)
(setq el (list(assoc 210 ent)))
(while (member (assoc 10 ent) ent)
(if (= 0.0 (assoc 42 ent))
(setq el (cons (assoc 42 ent) el))
(setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
)
...

Gửi bạn dùng thử

;; Free lisp code from CADViet - Edit by mathan
;;;;;;;;;;;;;;;;;;;;;;;; Doi huong tuyen
(defun c:rev (/ ss count lwp ent obj oname sss revlwpl revln)
(defun revlwpl(/ eo el len)
(setq eo ent)
(setq el (list(assoc 210 ent)))
(while (member (assoc 10 ent) ent)
(if (= 0.0 (assoc 42 ent))
(setq el (cons (assoc 42 ent) el))
(setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
)
(setq el (cons (assoc 41 ent) el))
(setq el (cons (assoc 40 ent) el))
(setq el (cons (assoc 10 ent) el))
(setq ent (member (assoc 10 ent) ent))
(setq ent (cdr ent))
)
(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
(while (>= len 0)
(setq el (cons (nth len eo) el))
(setq len (- len 1))
)
(setq ent el)
(entmod ent)
(princ "\n Da thay doi xong huong tuyen ")
)
(defun revln (/ pt1 pt2)
(setq pt1 (cons 10 (cdr (assoc 11 ent))))
(setq pt2 (cons 11 (cdr (assoc 10 ent))))
(setq ent (subst pt1 (assoc 10 ent) ent))
(setq ent (subst pt2 (assoc 11 ent) ent))
(entmod ent)
(princ "\n Da thay doi xong huong tuyen ")
)

(princ "\n Chon duong can doi huong....")
(setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))

(setvar "CMDECHO" 0)
(command "._UNDO" "_BEgin")
(if ss
(progn
(setq count 0 lwp 0)
(while (> (sslength ss) count)
(setq ent (ENTGET (ssname ss count))
obj (vlax-ename->vla-object (ssname ss count))
oname (vlax-get-property obj 'ObjectName)
)
(cond
((= oname "AcDb3dPolyline")(setq lwp(+ 1 lwp)))
((= (cdadr ent) "LWPOLYLINE")(revlwpl))
((= (cdadr ent) "POLYLINE")
(progn
(setq sss (ssadd (ssname ss count)))
(vl-cmdf "convertpoly" "Light" sss "")
(setq ent (ENTGET (ssname sss 0)))
(revlwpl)
)
)
((= (cdadr ent) "LINE")(revln))
)
(setq count (+ count 1))
)
)

)
(command "._UNDO" "_End")
(if(> lwp 0)
(if(> lwp 1)
(princ(strcat "\n Khong doi chieu duoc " (itoa lwp) " 3dPolylines."))
(princ"\n Khong the doi chieu duoc cac duong 3dPolyline.")
)
)

(princ)
)
;;;;;;;;;;;;;;;; Phan chinh
(defun c:rait ()
(vl-load-com)
(princ "\n Chon pline....")
(setq pl1 (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))
(setq pl (ssname pl1 0))
(command "lengthen" pl "")
(setq chieudai (getvar "PERIMETER"))
(setq caotext (getreal"\nNhap chieu cao text :"))
(setq sobd (getreal"\nNhap so bat dau :"))
(setq sogia (getreal"\nNhap buoc so tang :"))
(setq kcl (getreal"\nNhap khoang cach le :"))
(setq ngan (getreal"\nNhap khoang cach ngan :"))
(setq dai (getreal"\nNhap khoang cach dai :"))
(mathan)
)
;;;;;;;;;;;;;; xac dinh goc cua doan thang tinh tu diem ke vuong goc voi duong tim so voi duong chuan
(defun Vg (curve1 pt d2x / dvs)
(vl-load-com)
(setq VS d2x)
(setq pt (vlax-curve-getClosestPointTo curve1 (trans pt 1 0))
ang (angle '(0 0) (Vlax-curve-getfirstderiv curve1 (vlax-curve-getParamAtPoint curve1 pt))) )
(setq pt2 (polar pt (- ang (/ pi 2)) vs))
(princ)
)
;;;;;;;;;;;;;;;;;;;;; Phan nhap ly trinh va offset
(defun mathan (/ d1 curve po ktra)
(vl-load-com)
(command "._UNDO" "_BEgin")
(setq osm (getvar "osmode" ))
(setvar "osmode" 0)
(setq dem 0 dodai 0 ktra "OK")
(while (< dodai chieudai)
(setq dodai (* dem kcl))
(if (= ktra "OK") (setq ktra "NOT OK" kc ngan) (setq ktra "OK" kc dai))
(setq po (vlax-curve-getPointAtDist pl dodai))
(vg pl po kc)
(setq a pt2 goc (/ (* ang 180) pi))
(setq stt (+ sobd (* dem sogia)))
(setq text (rtos stt 2 0))
(command "_TEXT" a caotext goc text)
(setq dem (+ dem 1))
); end while
(command "._UNDO" "_End")
(setvar "osmode" osm)
(princ)
)

Mình định viết code này cho bạn từ hôm qua mà bận quá giờ mới gửi được
Lưu ý 1 chút, nếu rải chưa đúng hướng bạn cần chỉnh
- Đổi hướng pline lệnh REV
- Nếu text nhầm bên, bạn nhập lại khoảng cách offset âm là được
Chúc bạn vui với lisp này
P/s: code còn hơi rườm rà, có thời gian mình sẽ chau chuốt lại sau

Giải quyết nốt cho bạn 3 vấn đề là:
1. Tiếng Việt
2. Điểm đặt DIM
3. Kích thước khung, bạn tìm tới dòng CODE - (setq di (* 8 h) sửa số 8 thành số khác là khung sẽ to bé theo ý bạn ngay thui
Sorry bạn vì mình cũng khá vội

;; free lisp from cadviet.com
;;; Edit by mathan
----------------------------------------------
(defun C:tkd ()
(setvar "cmdecho" 0 )

>>

Giải quyết nốt cho bạn 3 vấn đề là:
1. Tiếng Việt
2. Điểm đặt DIM
3. Kích thước khung, bạn tìm tới dòng CODE - (setq di (* 8 h) sửa số 8 thành số khác là khung sẽ to bé theo ý bạn ngay thui
Sorry bạn vì mình cũng khá vội

;; free lisp from cadviet.com
;;; Edit by mathan
----------------------------------------------
(defun C:tkd ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq TP (getint (strcat "\nSo chu so thap phan :")))
(setq tapx '() tapy '() stt '())
(command "CECOLOR" 0)
;;; Phan dim
(setq ktra "OK")
(While (= ktra "OK")
(setvar "osmode" 125)
(setq DD (getpoint"\nPick diem dau"))
(setq TDD (getstring"\nNhap ten diem dau:"))
(setq DC (getpoint"\nPick diem cuoi"))
(setq TDC (getstring"\nNhap ten diem cuoi:"))
(setvar "osmode" 0)

(setq kc (distance DD DC))

(setq textdim (rtos kc 2 tp))
(setq textdiem (strcat TDD "-" TDC))
(setq ghichu "\U+0110o TT")
(command "_DIMALIGNED" DD DC pause)
(setq ktra (getstring"\nBan muon dung lai nhap - de tiep tuc :"))
(if (or (= ktra "S") (= ktra "s")) (setq ktra "NOT OK") (setq ktra "OK"))

(setq
tapx (append tapx (list textdim))
tapy (append tapy (list ghichu))
stt (append stt (list textdiem))
);setq
);;end while

;;;;;;;;;;;;; Phan lap bang thong ke
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuat bang toa do? <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (* 8 h) ;; Ty le bang bieu thong ke
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
"text" "m" p11 h 0 "\U+0110i\U+1EC3m \U+0111o"
"text" "m" p22 h 0 "Chi\U+1EC1u d\U+00E0i"
"text" "m" p33 h 0 "Ghi ch\U+00FA"
"text" "m" pTB (* 1.3 h) 0 "B\U+1EA3ng th\U+1ED1ng k\U+00EA chi\U+1EC1u d\U+00E0i")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n by Thaistreetz - Edit by Mathan")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do


Chúc cả nhà cuối tuần vui vẻ nha
P/s: Font chữ chọn không có chiều cao và chọn font chữ cho mã UNICODE nhé

Bạn dùng thử
Lệnh 1: KB để khai báo tỷ lệ
Lệnh 2: DAL1 để thực hiện dimaligned
Còn về dimlinear thì mình chưa rõ ý bạn lắm khi nhập vào khoảng cách thì nó sẽ theo phương nào đứng, ngang hay xiên
Bạn rõ ràng vấn đề để nếu có thể mình sẽ giúp bạn

;; Free lisp code...

Bạn dùng thử
Lệnh 1: KB để khai báo tỷ lệ
Lệnh 2: DAL1 để thực hiện dimaligned
Còn về dimlinear thì mình chưa rõ ý bạn lắm khi nhập vào khoảng cách thì nó sẽ theo phương nào đứng, ngang hay xiên
Bạn rõ ràng vấn đề để nếu có thể mình sẽ giúp bạn

;; Free lisp code from CADViet - Edit by mathan
(defun c:kb ()
(setq tyle (getreal"\nNhap ty le :"))
(setq tyle (/ 1 tyle))
)
;;;;
(defun c:dal1 ()
(setq diem1 (getpoint "\nChon diem dau.."))
(setq diem1x (car diem1))
(setq diem1y (cadr diem1))
(setq ktra "NOT OK")
(while (= ktra "NOT OK")
(setq diem2 (getpoint "\nChon diem thu 2.."))
(setq diem2x (car diem2))
(setq diem2y (cadr diem2))
(command "LINE" diem1 diem2 "")
(setq ktra1 (getstring "\nBan dong y huong nhu vay khong "))
(if (or (= ktra1 "k") (= ktra "K") )
(progn
(setq ktra "NOT OK")
(command "ERASE" "last" "")
)
(progn
(setq ktra "OK")
(command "ERASE" "last" "")
(setq kc (getreal "\nNhap khoang cach dim thuc: "))
(setq kc (* kc tyle))
(setq kcg (distance diem1 diem2))
(setq boiso (/ kc kcg))
(setq diem3 (list (+ diem1x (* boiso (- diem2x diem1x))) (+ diem1y (* boiso (- diem2y diem1y))) 0))
(command "_dimaligned" diem1 diem3 pause)


)
);; end if

);; end while
)

Hề hề hề,
Bạn hãy post cả file bản vẽ drawing và file excel lên để mọi người tiện kiểm tra bạn ạ.
Hình ảnh bạn post quá nhỏ, khó đọc quá, Tuy mình có thể hiểu chút chút nhưng thực sự chưa biết cấu tạo các text của bạn trong bản vẽ là gì để làm lisp.
Vì bạn chưa có file excel nên mình làm tạm cái này để bạn test. nếu cần gì sẽ bổ sung sau
Chú ý file excel...

Hề hề hề,
Bạn hãy post cả file bản vẽ drawing và file excel lên để mọi người tiện kiểm tra bạn ạ.
Hình ảnh bạn post quá nhỏ, khó đọc quá, Tuy mình có thể hiểu chút chút nhưng thực sự chưa biết cấu tạo các text của bạn trong bản vẽ là gì để làm lisp.
Vì bạn chưa có file excel nên mình làm tạm cái này để bạn test. nếu cần gì sẽ bổ sung sau
Chú ý file excel phải được save as lại dưới dạng file csv. Các text trên bản vẽ phải đúng với các text trên file csv cả về chữ hoa và chữ thường. File csv chỉ có hai cột dữ liệu như hình ảnh bạn đã post.

Chúc bạn vui.

Hề hể hề,
Đây là code bổ sung vào lisp trên với chức năng thêm xử lý cả khi đối tượng là circle đồng thời hiển thị luôn các đối tượng được chọn trên màn hình

Trong đoạn code trên có sử dụng một phần lisp biến đường tròn thành lwpolyline của bác SSG nhưng thay vì vẽ pline thì mình chuyển lại chỉ tạo points list cho đỡ phải vẽ rồi lại xóa đi.
Bạn nhớ...

Hề hể hề,
Đây là code bổ sung vào lisp trên với chức năng thêm xử lý cả khi đối tượng là circle đồng thời hiển thị luôn các đối tượng được chọn trên màn hình

Trong đoạn code trên có sử dụng một phần lisp biến đường tròn thành lwpolyline của bác SSG nhưng thay vì vẽ pline thì mình chuyển lại chỉ tạo points list cho đỡ phải vẽ rồi lại xóa đi.
Bạn nhớ cám ơn bác ấy nếu thấy dùng được cái lisp này nhé.

Thì lúc đó code của bác gia_bach còn thế này thôi , mình chưa test do bạn lười post file txt lên :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
;| By : Gia Bach, gia_bach @ www.CadViet.com Edited @Ketxu |;
(vl-load-com)
(if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
(or (tblsearch "layer" "Point") (command...

Thì lúc đó code của bác gia_bach còn thế này thôi , mình chưa test do bạn lười post file txt lên :

(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
;| By : Gia Bach, gia_bach @ www.CadViet.com Edited @Ketxu |;
(vl-load-com)
(if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
(or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
(setq f (open (findfile ten) "r"))
(while (setq Line (read-line f))
(setq pt (read (strcat "(" Line ")")))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
(progn
(vla-put-Layer (vla-addpoint spc (setq pXY (vlax-3d-point (list (car pt)(cadr pt))))) "Point")
(vla-put-Layer (vla-addtext spc (rtos (last pt) 2 2) pXY h) "Caodo")
)
)
)
)
)
(princ))

Chào bạn hiepmeo,
Bạn xài thử cái này xem nhé.

Lệnh draworder bring to back là drob, còn bring to front là drof bạn nhé.
Có điều bạn cần lưu ý như sau:
1/- lệnh này có nhanh hơn cái việc dùng toolbar là do kỹ năng xài cad của bạn. Bởi lệnh này cũng cần xài tới 4 ký tự và một phát enter. Nếu bạn muốn nhanh hơn có thể bỏ bớt ký tự trong hàm lệnh.
2/- Đây cũng là...

Chào bạn hiepmeo,
Bạn xài thử cái này xem nhé.

Lệnh draworder bring to back là drob, còn bring to front là drof bạn nhé.
Có điều bạn cần lưu ý như sau:
1/- lệnh này có nhanh hơn cái việc dùng toolbar là do kỹ năng xài cad của bạn. Bởi lệnh này cũng cần xài tới 4 ký tự và một phát enter. Nếu bạn muốn nhanh hơn có thể bỏ bớt ký tự trong hàm lệnh.
2/- Đây cũng là cấu trúc chung cho các hàm lệnh sử dụng các lệnh sẵn có của cad. Việc sử dụng các hàm lệnh này thực ra chưa chắc đã hay hơn việc nhập lệnh trên dòng command. Không nên quá lạm dụng nó vì nó có thể gấy rối cho cad nhất là khi có quá nhiều các lệnh kiểu này.
3/- Dựa vào cấu trúc này bạn có thể tạo bất cứ hàm lệnh cad nào mà bạn muốn, miễn là bạn phải hiểu rõ cấu trúc, trình tự thực hiện của từng lệnh trong Cad. Hy vọng rằng bạn sẽ có thể tự tạo được các lệnh phù hợp với yêu cầu của bạn.

Chúc bạn thành công.

đây là chương trình chuyển mã phục vụ cho công việc riêng của mình, nên có 1 số phần bạn sẽ không dùng tới, nhưng ko sao nó cũng không ảnh hưởng tới công việc của bạn đâu. Chương trình này mình chưa TEST nên có thể chưa thể chuyển mã được 100%, nếu khi sử dụng bạn thấy mã nào chưa chuyển được thì bạn gửi bản vẽ đó cho mình nhé để mình cập nhật mã nhé.

bạn...

đây là chương trình chuyển mã phục vụ cho công việc riêng của mình, nên có 1 số phần bạn sẽ không dùng tới, nhưng ko sao nó cũng không ảnh hưởng tới công việc của bạn đâu. Chương trình này mình chưa TEST nên có thể chưa thể chuyển mã được 100%, nếu khi sử dụng bạn thấy mã nào chưa chuyển được thì bạn gửi bản vẽ đó cho mình nhé để mình cập nhật mã nhé.

bạn hãy lưu đoạn mã này với tên file ACADFUN.DCL và chép vào chung với thư mục chứa file chm.lsp nhé, nhớ phải đánh đường dẫn trong option của cad thì nó mới chạy êm ái được.

Mình đang sử dụng lisp tính tổng diện tích các vùng chọn của bạn nhưng bị báo lỗi. Bạn xem lại giúp mình (cái này rất hay, mình đang cần)
Khi thực hiện lệnh thì Lisp chạy bình thường nhưng khi đến đoạn lisp hỏi nhập chiều cao chữ , mình nhập vào xong -> Enter thì bị thoát luôn và báo lỗi như sau:
; error: too many arguments
Bạn có thể xem lại lisp và hướng dẫn giúp mình. Cảm ơn...

Mình đang sử dụng lisp tính tổng diện tích các vùng chọn của bạn nhưng bị báo lỗi. Bạn xem lại giúp mình (cái này rất hay, mình đang cần)
Khi thực hiện lệnh thì Lisp chạy bình thường nhưng khi đến đoạn lisp hỏi nhập chiều cao chữ , mình nhập vào xong -> Enter thì bị thoát luôn và báo lỗi như sau:
; error: too many arguments
Bạn có thể xem lại lisp và hướng dẫn giúp mình. Cảm ơn bạn

Hề hề hề,
Chuyện này với lisp không quá khó, song bạn đã tìm kiếm chưa, trên diễn đàn đã có khá bộn các lisp tương tự, bạn la61y về dùng thử và thấy cái nào gần đáp ứng tốt nhất yêu cầu của bạn thì post lên, mọi người sẽ giúp bạn hoàn chỉnh nó.
Những yêu cầu kiểu này lặp đi lặp lại quá nhiều rồi, mà mỗi người lại thích một kiểu riêng nên khó có thể đáp...

Hề hề hề,
Chuyện này với lisp không quá khó, song bạn đã tìm kiếm chưa, trên diễn đàn đã có khá bộn các lisp tương tự, bạn la61y về dùng thử và thấy cái nào gần đáp ứng tốt nhất yêu cầu của bạn thì post lên, mọi người sẽ giúp bạn hoàn chỉnh nó.
Những yêu cầu kiểu này lặp đi lặp lại quá nhiều rồi, mà mỗi người lại thích một kiểu riêng nên khó có thể đáp ứng toàn bộ được.
cách tốt nhất là bạn nên tìm cái gần đúng nhất để chỉnh sửa thì sẽ nhanh hơn là ngồi lọ mọ lại từ đầu.
hề hề hề.
Tỷ dụ, đây là một cái lisp có sẵng trên diễn đàn, bạn dùng thử coi nó có ưng cái bụng không nhé.

Lưu ý bạn là đây chỉ là một đoạn code để nhập các text chứ chưa có tạo bảng như bạn muốn. Song việc này không quá khó nữa sau khi bạn đã có các dòng text. Bạn có thể tự bổ sung thêm phần tạo bảng hoặc nếu bạn thấy nó dùng được thì post lên mọi người sẽ giúp bạn hoành chỉnh.
Mặt khác trên diễn đàn cũng đã có những lisp có tạo bảng hoàn chỉnh rồi. Có thể chúng chưa thật vừa ý nhưng bạn cứ dùng thử sẽ thấy nó cần bổ siung gì cho hoàn chỉnh cái bạn mong muốn.
Chúc bạn vúi.