S­ửa lại cho bạn đây:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0&#entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; free lisp from cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho...

S­ửa lại cho bạn đây:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0&#entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; free lisp from cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)
;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------
;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:HSKT (/ h p et p0 p00 p01 p02 pt pvL pvL1 n j pv num txtL ss bn ntp p11 p12 p13 p14)
(setvar "cmdecho" 0)
;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")
;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))
;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))
;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))

;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = M1): " )
)

;(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(initget "T t N n")
(setq chieu (getkword "\nLua chon chieu ghi toa do < T/N >"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 "")
(setq Lkqua nil)
(command "style" "CadViet" ".VnArialH" "" "" "" "" "")
(wtxtMC "B&#182;ng k&#170; t&#228;a &#174;&#233; v&#181; kho&#182;ng c&#184;ch"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
(* 1.2 h) nil)
(wtxtMC "H&#214; t&#228;a &#174;&#233; VN - 2000"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "Y (m)" "X (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
;;;MAKE RECORDS
(if (or (= chieu "N") (= chieu "n")) (setq pvL (reverse pvL)) )
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p11 (polar p0 (* 1.5 pi) (* 2.5 h)))
(setq P12 (polar p11 0 (* 25 h)))
(setq P13 (polar p11 0 (* 31 h)))
(setq P14 (polar p11 0 (* 32 h)))
(command "LINE" p11 p12 "")
(command "LINE" p13 p14 "")
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)
(command "LINE" p11 p14 "")
(linepy p00 (- (distance p00 (polar p0 (* 1.5 pi) (* 0.5 h)) )))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "HATCH" "solid" "L" "")
(command "erase" vtron "")
(setq j (1+ j))
)
;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)
;;;FINISH
(savef)
(setvar "osmode" oldos)
;(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
;;; )
(setvar "cmdecho" 1)
(princ)
)
;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)
;;;PHAN BO SUNG
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a )
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 2)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a )
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a )
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 2)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a )
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp mp1)
(setq
i 0
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
;(Text_canh_TCA (rtos dist 2 2) mp rad)
)
;(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq mp1 (polar mp (angle p mp) (* 2 h)) )
(command "DIMALIGNED" p1 p2 mp1)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------

Mình làm cái lisp này bạn xem phải sửa những gì nữa nhé. Đế lisp chạy được bạn copy 3 block "Nut goc", "Nut canh" và "Nut canh dung" trong file mình gửi kèm đây vào các bản vẽ mới nhé. http://www.mediafire.com/?aziat8pathma09x (sao không dùng được up file cua CV nhi).
Riêng khung bản vẽ bạn nên tập làm theo block thuộc tính xem ntn.
(defun c:KDB ( / TLe P1 P2 P3 P4 X1 Y1 X2 Y2 Q1 Q2 Q3 Q4 Lx...

Mình làm cái lisp này bạn xem phải sửa những gì nữa nhé. Đế lisp chạy được bạn copy 3 block "Nut goc", "Nut canh" và "Nut canh dung" trong file mình gửi kèm đây vào các bản vẽ mới nhé. http://www.mediafire.com/?aziat8pathma09x (sao không dùng được up file cua CV nhi).
Riêng khung bản vẽ bạn nên tập làm theo block thuộc tính xem ntn.
(defun c:KDB ( / TLe P1 P2 P3 P4 X1 Y1 X2 Y2 Q1 Q2 Q3 Q4 Lx Ly mQ14 mQ23 mQ24 mQ13 Nx Ny
i Qi Xi Yi)
(batdau)
(setq TLe (/ (getint "\nNhap ty le ban do <500>: ") 10)
P1 (getpoint "\nPick diem dau: ")
P2 (getpoint "\nPick diem cuoi: ")
X1 (getreal "\nNhap toa do X diem dau: ")
Y1 (getreal "\nNhap toa do Y diem dau: ")
Q1 (polar P1 (/ pi 4) (sqrt 72))
Q2 (polar P2 (* 5 (/ pi 4)) (sqrt 72))
Q3 (polar Q1 0 (- (car Q2) (car Q1)) )
Q4 (polar Q2 0 (- (car Q1) (car Q2)) )
Lx (abs (- (car Q1) (car Q2)) )
Ly (abs (- (cadr Q1) (cadr Q2)) )
mQ14 (polar Q1 (/ pi 2) (/ Ly 2))
mQ23 (polar Q3 (/ pi 2) (/ Ly 2))
mQ24 (polar Q4 0 (/ Lx 2))
mQ13 (polar Q1 0 (/ Lx 2))
X2 (+ Lx X1)
Y2 (+ Ly Y1)
Nx (fix (/ Lx TLe))
Ny (fix (/ Ly TLe))
)
(setvar "osmode" 0)
(command "RECTANG" P1 P2)
(command "PEDIT" "L" "W" 0.5 "")
(command "RECTANG" Q1 Q2)
(command "-INSERT" "Nut goc" Q1 1 1 0 "1349" (rtos Y1 2 2) (rtos X1 2 2) "589")
(command "-INSERT" "Nut goc" Q3 1 1 0 "1349" (rtos Y1 2 2) (rtos X2 2 2) "589")
(command "MIRROR" "L" "" Q3 Q2 "Y")
(command "-INSERT" "Nut goc" Q4 1 1 0 "1349" (rtos Y2 2 2) (rtos X1 2 2) "589")
(command "MIRROR" "L" "" Q4 Q2 "Y")
(command "-INSERT" "Nut goc" Q2 1 1 0 "1349" (rtos Y2 2 2) (rtos X2 2 2) "589")
(command "MIRROR" "L" "" Q3 Q2 "Y")
(command "MIRROR" "L" "" Q4 Q2 "Y")
(setq i 1)
(repeat Nx
(setq Qi (polar Q1 0 (* i TLe))
Xi (+ X1 (* i TLe))
i (1+ i)
)
(command "-INSERT" "Nut canh" Qi 1 1 0 "589" (rtos Xi 2 2))
(command "MIRROR" "L" "" mQ14 mQ23 "N")
)
(setq i 1)
(repeat Ny
(setq Qi (polar Q1 (/ pi 2) (* i TLe))
Yi (+ Y1 (* i TLe))
i (1+ i)
)
(command "-INSERT" "Nut canh dung" Qi 1 1 0 (rtos Yi 2 2) "1389")
(command "MIRROR" "L" "" mQ24 mQ13 "N")
)
(ketthuc)
)
;*******************
(defun batdau ( )
(setvar "MODEMACRO" "VoHoan")
(setvar "CMDECHO" 0)
(command "undo" "be")
(setq osl (getvar "osmode"))
(setvar "osmode" 5031)
)
;********************
(defun ketthuc ( )
(setvar "osmode" osl)
(command "undo" "end")
(princ loichao)
(princ)
)

Bạn có thể thử

;;HD su dung
;;1 Ten lenh: cong
;;2 Neu hay dung chon Text chen thi giu nguyen lisp nhu cu
;;;;;;Neu hay dung chon diem viet Text hon thi doi lai thu tu 2 vong Progn
;;chieu cao chu trong lisp duoc xac dinh bang Tich cua DIMScale va DIMtxt
;;sua lai bang cach thay
;;;;;;;;;;;;;;(cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
;;;;;;;;;;boi (cons 40 250) chang han se co chieu cao la...

Bạn có thể thử

;;HD su dung
;;1 Ten lenh: cong
;;2 Neu hay dung chon Text chen thi giu nguyen lisp nhu cu
;;;;;;Neu hay dung chon diem viet Text hon thi doi lai thu tu 2 vong Progn
;;chieu cao chu trong lisp duoc xac dinh bang Tich cua DIMScale va DIMtxt
;;sua lai bang cach thay
;;;;;;;;;;;;;;(cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
;;;;;;;;;;boi (cons 40 250) chang han se co chieu cao la 250
;;;Lisp khong kiem tra tinh dung dan cua viec nguoi dung cho data dau (chon dau dung doi tuong chua
;;;;doi tuong da la Text chua, Text da bao gom chi la so chua
;;Vi nhan thay khong can thiet, nguoi dung tu kiem tra tinh dung dan khi su dung, neu can minh se sua sau
(defun c:cong ( / value #k Text xText p)
(or #cong (setq #cong 1))
(setq #cong (cond ((getreal (strcat "Gia tri cong: <" (rtos #cong 2 2) "> :")))(#cong)))
(setq value (entsel "\nChon Text dau")
value (cdr(assoc 1 (entget(car value)))))
(setq text nil p nil)
(while (or (setq Text (entsel "\nNhap Text sua or "))
(setq p (getpoint "\nNhap vi tri chen Text")))
(If Text
(progn ;;Chen len Text
(setq xText (cdr(assoc 1 (entget(car Text))))
value (rtos(+ (atof value) #cong )))
(entmod (subst (cons 1 value) (assoc 1 (entget(car Text))) (entget(car Text))))
)
(progn ;;;chon diem chen Text
(setq value (rtos(+ (atof value) #cong )))
(entmake
(list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1 value)
(cons 7 (getvar "textstyle"))
(cons 8 (getvar "clayer"))
(cons 62 256)
(cons 10 p)
(cons 11 p)
(cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
(cons 41 1.0)
(cons 50 0.0)
(cons 51 0.0)
'(71 . 0)
'(72 . 0)
'(73 . 0)
))
);end_progn2
);end_IF
) ;end_While
(princ)
)

Chào các bác, mình đang tập làm cái lisp tạo mục lục bản vẽ bằng cách ghi số hiệu bản vẽ và tên bản vẽ từ cad sang excel, nhưng vấn đề rắc rối là phông chữ tiếng việt ko ổn, thấy cái lisp của bác hoành nhưng ko hiểu thế nào để lắp ghép vào được, nhờ các cao thủ chỉnh sửa hộ mình với, cảm ơn các bác nhiều, chúc các bác cùng gia đình nhiều niềm vui.



...

Chào các bác, mình đang tập làm cái lisp tạo mục lục bản vẽ bằng cách ghi số hiệu bản vẽ và tên bản vẽ từ cad sang excel, nhưng vấn đề rắc rối là phông chữ tiếng việt ko ổn, thấy cái lisp của bác hoành nhưng ko hiểu thế nào để lắp ghép vào được, nhờ các cao thủ chỉnh sửa hộ mình với, cảm ơn các bác nhiều, chúc các bác cùng gia đình nhiều niềm vui.



(DEFUN C:mlbv ( )
(setq fn (getfiled "Select file" "" "xls" 1))
(while
(princ "chon so hieu ban ve")
(setq ss (ssget '((0 . "TEXT"))))
(setq e (ssname ss 0))
(setq t1 (strcat (cdr (assoc 1 (entget e))) "\t"))
(princ "chon ten ban ve")
(setq ss (ssget '((0 . "TEXT"))))
(setq stt 0
cd (sslength ss)
)
(repeat cd
(setq e (ssname ss stt))
(setq t2 (cdr (assoc 1 (entget e))))
(setq t1 (strcat t1 t2))
(setq stt (1+ stt))
)
(setq f0 (open fn "a"))
(write-LINE T1 F0)
(close f0)
)
)

Việc tìm ra 873 hay 871 thường do sai số nhỏ của một vài điểm tọa độ, việc cho ra kq 871 hay 873 đôi lúc cũng gây khó hiểu. VD với hàm trên nếu mình kiểm tra bẳng tọa độ thì nó tạo 871 đểm, nếu chuyển tọa độ thành chuỗi với 3 số lẽ vẫn cho 871 điểm nhưng với 2 số lẽ cho 873 điểm. Thật khó hiểu. Nhưng thời gian thì kg thay đổi lắm. Từ 0.328 lên 0.360s. Đây là code mới :

>>

Việc tìm ra 873 hay 871 thường do sai số nhỏ của một vài điểm tọa độ, việc cho ra kq 871 hay 873 đôi lúc cũng gây khó hiểu. VD với hàm trên nếu mình kiểm tra bẳng tọa độ thì nó tạo 871 đểm, nếu chuyển tọa độ thành chuỗi với 3 số lẽ vẫn cho 871 điểm nhưng với 2 số lẽ cho 873 điểm. Thật khó hiểu. Nhưng thời gian thì kg thay đổi lắm. Từ 0.328 lên 0.360s. Đây là code mới :

Tuy nhiên, code trên chỉ nhanh khi bv nhỏ thôi. Nếu bv lớn việc tạo nhiều list sẽ làm tốc độ giảm đáng kể.
Bây giờ nếu bạn nào cảm thấy đầu óc quá nhàm chán hãy thử tìm giao (chứ kg phải điểm đầu và cuối line, -mình có thể kéo dài các line ra 1 đoạn để chúng chỉ cắt nhau) của bv 42200đt ở #6 sao cho nó có thể chạy với hiệu suất từ 350s (chạy theo code chia ô kết hợp tìm giao của bác Ha mà mình đã post ở #89) giảm đến 250s hay ít hơn nữa (tuỳ máy) , với khoảng 35680 điểm đc tạo. Máy mình đạt đc hiện nay là từ 350s xuống 250s, mình sẽ cố gắng giảm xuống tiếp. Mình sẽ test trên máy mình để đánh giá. Các bạn có thể nhào nặn từ bất cứ code nào tìm đc tính tử đây trở về trước. Bạn nào cảm thấy buốn thì nhào zdô. Sau 3 ngày mình sẽ post đáp án lên

Trước khi nói đến chủ đề mới mình sẽ đưa cái đáp án cũ lên để các bạn tham khảo. Dưới đấy là code tìm và chèn point vào vị trí giao các đối tượng. Khi thực hiện trên bv có 42200đt ở #6 chỉ mất dưới 30''. Có thể đây là kết quả khó có thể đạt đc nếu kg có PP chia ô và một số PP khác. Các bạn có thể thắc mắc tại sao mình cứ quần tới quần lui vđ này, vì nó là nội dung...

Trước khi nói đến chủ đề mới mình sẽ đưa cái đáp án cũ lên để các bạn tham khảo. Dưới đấy là code tìm và chèn point vào vị trí giao các đối tượng. Khi thực hiện trên bv có 42200đt ở #6 chỉ mất dưới 30''. Có thể đây là kết quả khó có thể đạt đc nếu kg có PP chia ô và một số PP khác. Các bạn có thể thắc mắc tại sao mình cứ quần tới quần lui vđ này, vì nó là nội dung chính (nói cx hơn là công đoạn chính của chủ đề tiếp theo) nên mình muốn nó thật chuẩn và thật nhanh. Đoạn code dưới đây sd PP chia ô của bác Thai, PP tìm giao của bác Ha và một ít công sức của mình.

Code trên chỉ có một vđ nhỏ như mình và bác Thai đã nêu ở PP chia ô. Nếu tập chọn kg có đối tượng thì vòng lặp kg thoát. Mình cũng muốn chỉnh lại đoạn này cho nó an toàn hơn nhưng chưa làm đc. Bác Thai hoặc bạn nào có thể thì chỉnh giúp cho nó thoát khi kg chọn đc đt nào.

Chủ đề 4 : Viết Lệnh tạo đường bao tương tự lệnh boundary của Cad (nhưng cách làm hoàn toàn khác).
Tại sao lại viết lại lệnh này khi Cad đã có. Vì những lý do sau :
- Lệnh Cad chạy kg được những TH phức tạp
- Thông tin trả về chưa đầy đủ.
Phần lớn các bạn đều biết lệnh boundary của Cad chỉ tính tốt trong TH các đối tượng tương đối thoáng, còn lại thường báo lỗi. Đã có nhiều lần một số cao thủ muốn viết lại lệnh này nhưng chưa đủ kiên trì. Hôm nay mình muốn nhờ các bạn hỗ trợ hết mình để viết lại lệnh này, thậm chí nó sẽ có thể chạy tốt hơn và nhanh hơn Cad, thông tin đưa về cũng nhiều hơn. Mình sẽ đưa ra một số yêu cầu tương đối khó, mong tìm đc những đoạn code tốt nhất để ráp lại thành một lệnh hoàn chỉnh. Để viết đc lệnh trên cần rất nhiều thứ. Nếu đưa ra nhiều yêu cầu một lúc sẽ làm rối vđ và các bạn cũng ngán. Trước hết mình nhờ các bạn giúp :
- Lập danh sách quản lý tọa độ điểm giao và các đối tượng giao tại điểm này (lưu trong biến toàn cục). Mục đích để truy xuất các đối tượng giao nhau tại một điểm bất kỳ khi cung cấp tọa độ của nó.
Đây là hàm rất quan trọng nên rất cần sự chuẩn xác và tốc độ. Mong các cao thủ ra tay.
Theo mình thì có thể lưu danh sách tọa độ và đối tượng như sau : lis=((p1 h1 h2 h3) (p2 h1 h4 h5) ...) (trong đó pi là tọa độ, hi : mã dxf=5 của đt)
Khi dùng hàm truy xuất có dạng AAA( p lis) (assoc p lis)). Khi gọi (AAA p) -> (p h1 h2 h3)
Đó là suy nghĩ của mình. Còn cách nào hay hơn tùy các bạn.

Thực ra lệnh này trước đây mình đã viết bằng lisp và arx, tuy nhiên mình chỉ đủ sức viết với dữ liệu line và cũng chưa thật tốt, nhưng mình hoàn toàn làm chủ đc nó. Hôm nay có Cadviet hỗ trợ hy vọng sẽ cùng nhau viết đc một lệnh chạy trên nhiều loại đối tượng như lệnh của Cad nhưng mức độ sâu hơn và hoàn chỉnh hơn. Cám ơn các bạn trước.

P/S : Theo góp ý của bác Thai ở dưới, chủ đề này đã được lập riêng ở đây : http://www.cadviet.com/forum/index.php?showtopic=65055

Của bạn đây.

;Write by avi612
(defun c:thei(/ s height layer ss1 #ct_height k uu count en eg)
(prompt "\n>>Ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng TEXT m\U+1EABu: ")
(setq s (car (entsel)))
(setq height (assoc 40 (entget s)))
(setq layer (assoc 8 (entget s)))
(setq ss1 (ssget "X" (list (cons 0 "TEXT") height layer)))
(setq #ct_height (getreal "\n>>TEXT height: "))

>>

Của bạn đây.

;Write by avi612
(defun c:thei(/ s height layer ss1 #ct_height k uu count en eg)
(prompt "\n>>Ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng TEXT m\U+1EABu: ")
(setq s (car (entsel)))
(setq height (assoc 40 (entget s)))
(setq layer (assoc 8 (entget s)))
(setq ss1 (ssget "X" (list (cons 0 "TEXT") height layer)))
(setq #ct_height (getreal "\n>>TEXT height: "))
(setq height nil)
(setq k nil)
(setq uu 0)
(while (< uu (sslength ss1))
(redraw (ssname ss1 uu) 3)
(setq uu (1+ uu))
)
(setq count 0)
(repeat (sslength ss1)
(setq en (ssname ss1 count))
(setq eg (entget en))
(setq eg (subst (cons 40 #ct_height) (assoc 40 eg) eg))
(setq count (1+ count))
(entmod eg)
)
(princ)
(princ)
)

Chào các bác,
Với góp ý của bác ndtnv, mình lọ mọ đọc lại các hàm vl-string-?????? và liều mạng làm thử lại cái lisp đã gửi bạn Truongthanh thì thấy ra được cái lisp mới như sau:


Về cơ bản vẫn cho ra kết quả giống hệt cái lisp cũ và khi mình xài cái hàm testtime của bác Giabach để test thử tốc độ chạy của hai cái lisp cũ và mới thì thấy kết quả cũng gần gần...

Chào các bác,
Với góp ý của bác ndtnv, mình lọ mọ đọc lại các hàm vl-string-?????? và liều mạng làm thử lại cái lisp đã gửi bạn Truongthanh thì thấy ra được cái lisp mới như sau:


Về cơ bản vẫn cho ra kết quả giống hệt cái lisp cũ và khi mình xài cái hàm testtime của bác Giabach để test thử tốc độ chạy của hai cái lisp cũ và mới thì thấy kết quả cũng gần gần như nhau nếu bỏ qua sai số do người thao tác (tốc độ pick chuột ấy mà).
Vậy nên việc dùng cái nào thì tùy bác Truongthanh lựa chọn. Tuy nhiên cái lisp thứ hai này có vẻ như oai hơn vì nó có xài mấy thằng vl-?????. Hề hề hề.
Thế là cũng vọc thêm được một tí về các hàm vl-string-???? , cho dù chưa kỹ lắm nhưng cũng đã biết xài. Hề hề hề ..... Khoái, khoái, khoái........

PS: Cái lisp thứ hai này thì nó chạy chấp luôn cả cái lỗi nhập thiếu khoảng trắng trong text của bạn truongthanh như trường hợp vừa rồi bạn ạ. Hề hề hề. Chỉ cần bạn nhập đúng các ký tự đường kính và chiều dài cũng như gạch nối và ký tự độ dốc.
Tuy nhiên dù dùng lisp nào thì bạn cũng vẫn nên nhập text cho chuẩn mực vì như vậy bản vẽ mới đẹp và thống nhất bạn ạ. Và nó còn OAI nữa, hề hề hề.....