(defun c:lt(/ lst lt pt curve txtsiz msp i cen r tmp)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(setq txtsiz (cond ((zerop (setq tmp (* (getvar "dimtxt")(getvar "dimscale")))) 1)
(T tmp))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (<...

(defun c:lt(/ lst lt pt curve txtsiz msp i cen r tmp)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(setq txtsiz (cond ((zerop (setq tmp (* (getvar "dimtxt")(getvar "dimscale")))) 1)
(T tmp))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (< (distance (vlax-curve-getStartPoint curve) pt)(distance (vlax-curve-getEndPoint curve) pt)) i 0
ln (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve ))
)
(while (and (setq lt (getreal (strcat "\nNhap ly trinh diem thu " (itoa (setq i (1+ i))) " : "))) (< lt ln))
(entmake
(list (cons 0 "CIRCLE")
(cons 10 (setq cen (vlax-curve-getPointAtDist curve (if isFirst lt (- ln lt)))))
(cons 40 (setq r 0.1)) ;Kich thuoc vong tron
)
)
(vla-addtext msp (strcat (itoa i) " " (rtos lt 2 2)) (vlax-3d-point (mapcar '+ cen (list 0 (* 2 r) 0))) txtsiz)
(setq lst (cons (cons i lt) lst))
)
(setq pt (getpoint "\nDiem dat bang thong ke:"))

(foreach e (reverse lst)
(vla-addtext msp (itoa (car e)) (vlax-3d-point pt) txtsiz)
(vla-addtext msp (rtos (cdr e) 2 2) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))
)
(command "undo" "en")
)

Đôi khi ta cần biết những biến hệ thống nào đã bị thay đổi khi thực hiện 1 lệnh nào đó trong quá trình vẽ. Việc lấy ra danh sách giá trị của tất cả biến hệ thống trước và sau khi thực hiện lệnh rồi so sánh thực sự vất vả.
Lisp này có tác dụng theo dõi và thống kê cho bạn biết những biến hệ thống nào của cad đã bị thay đổi khi thực hiện 1 lệnh cad, 1 lệnh lisp hay bất kỳ...

Đôi khi ta cần biết những biến hệ thống nào đã bị thay đổi khi thực hiện 1 lệnh nào đó trong quá trình vẽ. Việc lấy ra danh sách giá trị của tất cả biến hệ thống trước và sau khi thực hiện lệnh rồi so sánh thực sự vất vả.
Lisp này có tác dụng theo dõi và thống kê cho bạn biết những biến hệ thống nào của cad đã bị thay đổi khi thực hiện 1 lệnh cad, 1 lệnh lisp hay bất kỳ lệnh nào gây ra sự thay đổi biến hệ thống, đồng thời ghi ra luôn giá trị trước và sau khi thay đổi là bao nhiêu để bạn nắm được sự thay đổi đó.
;;;Copyright 2011 Thaistreetz from Cadviet.com

(defun C:RSV nil
(if (vlr-reactors :VLR-SysVar-Reactor)
(and (vlr-remove-all :VLR-SysVar-Reactor)
(prompt "<< Da Tat che do theo doi bien he thong >>"))
(and (vlr-sysvar-reactor "Sysvar Reactor: Sysvar Change" '((:vlr-sysvarwillchange . callback-sysvarchang) (:vlr-sysvarchanged . callback-sysvarchang)))
(prompt "<< Da Bat che do theo doi bien he thong >>"))) (princ))
(defun callback-sysvarchang (reactor sysvar)
(if (= (vlr-current-reaction-name) :vlr-sysvarwillchange)
(setq *sysvar* (getvar (car sysvar)))
(if (not (equal *sysvar* (getvar (car sysvar))))
(progn (princ (strcat "\n" (car sysvar) " : <" )) (princ *sysvar*) (princ ">") (princ " ----> <" ) (princ (getvar (car sysvar))) (princ ">")))))
Lưu ý: Hiện tại lisp này không nhận biết được sự thay đổi biến hệ thống qua việc thay đổi các lựa chọn trong hộp thoại Option của cad nhé. Mình dùng cad 2010 nó không nhận. các bản Cad khác thì mình chưa thử. Còn với command hay các lệnh lisp hoặc lệnh tạo bằng các ngôn ngữ khác nó nhận biết bình thường.
Bạn có thể bật hoặc tắt chế độ theo dõi bằng 1 lệnh duy nhất là RSV (reactor Sysvar)

Chào bác PhamThanhBinh
1./Đường Line, Pline còn 1 điểm chưa được đó là khi vẽ đường Line hay Pline từ phải sang trái. Tức là bác vẽ line hay pline từ phải sang trái đó thì khi chạy Lisp các cột điện bị chổng vó lên liền (các cột diện bị lộn ngược khi vẽ từ phải sang trái) và do đó các điểm chèn Text di chuyển về gần đường chuẩn hơn. Điều này là chưa được. Đối với Spline...

Chào bác PhamThanhBinh
1./Đường Line, Pline còn 1 điểm chưa được đó là khi vẽ đường Line hay Pline từ phải sang trái. Tức là bác vẽ line hay pline từ phải sang trái đó thì khi chạy Lisp các cột điện bị chổng vó lên liền (các cột diện bị lộn ngược khi vẽ từ phải sang trái) và do đó các điểm chèn Text di chuyển về gần đường chuẩn hơn. Điều này là chưa được. Đối với Spline thì khi vẽ từ phải sang trái thì các cột điện cũng bị lộn đầu liền. Hơn nữa với Spline còn có điều chưa được là : Khi chạy với đường thật cong thì các Text sẽ bị lỗi ngay. Hướng của Text rất lộn xộn không trùng với phương tiếp tuyến của đường cong nữa.
Cái này mình nghĩ phải đi theo phương pháp của bác ndtnv
2./ Quy luật thay đổi Text của bạn làm cho bạn dũng không có gì sai. Nhưng giả sử bạn Dũng bắt đầu đánh số trụ đèn có 9 kí tự trở lên thì lỗi ngay. Trường hợp đánh số trụ đèn có 9 kí tự trên 1 đường tiếp theo chẳng hạn.
Theo hình vẽ thì Text mẫu cần tách có 3 loại cần tách:
a. Đó là chuỗi text1 chứa 6 kí tự cố định và kí tự đầu tiên được xác định từ vị trí đầu tiên của chuỗi.
b. Đó là chuỗi text2 chứa các kí tự là text số và thay đổi theo điểm chèn text (Với text 2 chứa toàn kí tự là số không có chữ)
c. Đó là chuỗi text3 chứa các kí tự là text chữ và thay đổi theo điểm chèn text (Với text 3 có thể chứa cả chữ và số).
Đoạn Code sau đây mình mày mò viết được theo yêu cầu trên, bác có thể tham khảo, và có thể tuỳ biến. AutoLisp là "thiên biến vạn hoá" mà :

Chúc bác vui và thành công

Tên lệnh: THS.

(defun c:ths (/ Ename Elist Msg Oldtext Oldlist Newtext Newlist)
(command "undo" "be")
(setq donvi (/ (getvar "viewsize") 40))
(setq ddd (entsel "\nChon text bi tru"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text bi...

Tên lệnh: THS.

(defun c:ths (/ Ename Elist Msg Oldtext Oldlist Newtext Newlist)
(command "undo" "be")
(setq donvi (/ (getvar "viewsize") 40))
(setq ddd (entsel "\nChon text bi tru"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text bi tru"))
)

(setq DTDTT (car ddd))
(setq DTTT (entget DTDTT))
(setq NDTTT (cdr (assoc 1 DTTT)))
(setq NDTTT (atof NDTTT))
(setq DIEMVIETTEXT (cdr (assoc 10 DTTT)))
(setq diemvt1 (polar DIEMVIETTEXT pi donvi))
(setq diemvt2 (polar DIEMVIETTEXT (* 2 pi) donvi))
(setq diemvt3 (polar DIEMVIETTEXT (/ pi 2) donvi))
(setq diemvt4 (polar DIEMVIETTEXT (- 0 (/ pi 2)) donvi))
(grdraw diemvt1 diemvt2 3)
(grdraw diemvt3 diemvt4 3)
(if (= droffln nil)
(setq droffln1 2.00)
(setq droffln1 droffln)
)
(setq
droffln (GETREAL (strcat "\nNhap hang so tru: <" (rtos droffln1 2 2) ">"))
)
(if (= droffln nil)
(setq droffln droffln1)
)

(setq ketquaxuat (- NDTTT droffln))
(setq ketquaxuat (rtos ketquaxuat 2 2))
(setq dddsn (entsel "\nChon text xuat ket qua"))
(while
(or
(null dddsn)
(/= "TEXT" (cdr (assoc 0 (entget (car dddsn)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq dddsn (entsel "\nChon text tru"))
)

(setq DTDTTsn (car dddsn))
(setq DTMs (entget DTDTTsn))
(setq DTMs (subst (cons 1 ketquaxuat) (assoc 1 DTMs) DTMs))
(entmod DTMs)

(command "undo" "end")
(Princ))

Mình có 1 lisp này cũng có thể dùng được này.
Lisp có khả năng đếm số lần xuất hiện của 1 Dtext rồi lập thành bảng thống kê.
Nhưng mấy bác cao thủ chỉnh lại giùm em một chút này cho nó hay đi:
+ Có thể đếm được tất cả các loại text: Mtext, Dtext, Text.
+ Có dòng thông báo nhập chiều cao text trong bảng thống kế, nếu Enter thi dùng chiều cao chữ hiện hành.
+ Cuối...

Mình có 1 lisp này cũng có thể dùng được này.
Lisp có khả năng đếm số lần xuất hiện của 1 Dtext rồi lập thành bảng thống kê.
Nhưng mấy bác cao thủ chỉnh lại giùm em một chút này cho nó hay đi:
+ Có thể đếm được tất cả các loại text: Mtext, Dtext, Text.
+ Có dòng thông báo nhập chiều cao text trong bảng thống kế, nếu Enter thi dùng chiều cao chữ hiện hành.
+ Cuối cùng thì kẽ thành 1 bảng thống kê có dòng tổng số text.

Lisp này em sưu tầm trên mạng không biết của tác già nào nửa.



(defun c:tkt (/ lst msp pt ss str txtsiz)
(vl-load-com)
(setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) lst (list))
(prompt (strcat "\nChon Text de Liet ke hay ENTER de chon tat ca :"))
(if (null (setq ss (ssget(list (cons 0 "TEXT"))))) (setq ss (ssget "_X" (list(cons 410 (getvar "Ctab")) (cons 0 "TEXT")))))
(if ss
(progn
(foreach e (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq str (vla-get-TextString e))
(if (not (assoc str lst))
(setq lst (cons (cons str 1) lst))
(setq lst (subst (cons str (1+ (cdr (assoc str lst))))
(assoc str lst) lst)))
)
(setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))

pt (getpoint "\nDiem dat Bang :" )
txtsiz (* (getvar "dimtxt")(getvar "dimscale")))
(foreach e lst
(vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz )
(vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz ) ; khoang cach tu so thong ke toi text
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz))) ; khoang cach 2 dong text cua bang thong ke
)
)
(alert "Khong chon duoc Text.")
)
(princ))

(defun c:xtd(/ lay fn lst)
;Free lisp @ketxu
(setq lay "diemmia")
(cond
(
(and (ssget (list (cons 0 "TEXT")(cons 8 lay)))
(setq fn (getfiled "Where to save:" "toado" "txt" 1))
)
(vl-load-com)
(vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lst (append lst (list (cons (atof (vla-get-TextString obj))(list (vlax-get obj...

(defun c:xtd(/ lay fn lst)
;Free lisp @ketxu
(setq lay "diemmia")
(cond
(
(and (ssget (list (cons 0 "TEXT")(cons 8 lay)))
(setq fn (getfiled "Where to save:" "toado" "txt" 1))
)
(vl-load-com)
(vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lst (append lst (list (cons (atof (vla-get-TextString obj))(list (vlax-get obj 'InsertionPoint))))))
)
(setq fn (open fn "w"))
(mapcar '(lambda(l)(write-line (vl-princ-to-string (cadr l)) fn))
(vl-sort lst '(lambda(x y)(< (car x)(car y))))
)
(close fn)
(princ))
)
)

- hiện tại em phải dùng 5 thao tác diêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:
+ Dùng lệnh chế biến File (CB) để chế biến File từ dạng thô của máy đo sang File tọa độ góc, cạnh dạng .TXT
+ Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.
+ Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.
+ Dùng lệnh...

- hiện tại em phải dùng 5 thao tác diêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:
+ Dùng lệnh chế biến File (CB) để chế biến File từ dạng thô của máy đo sang File tọa độ góc, cạnh dạng .TXT
+ Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.
+ Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.
+ Dùng lệnh lấy trạm máy (TM) để lấy tọa độ của trạm máy, sau đó copy tọa độ đó dán vào tram máy trong file .TXT.

;******\\\\\\\\\**chuong trinh che bien cho may TOPCON 223*********\\\\\\\\\\\\\\*********////////
;khong dung chenh cao, chi su dung de thanh lap ban do dia chinh
(defun c:cb (/ ch i FN FD sosanh j trammay
ccmay tramdh ccguong canhng hm hg goctd
canhb gocdung cd dem tam
)
(setq
FN (getfiled "Nh&#203;p file ngu&#229;n : "
""
""
4
)
)
(setq i (strlen FN))
(setq ch "")
(while (/= ch "\\")
(setq ch (substr FN i 1))
(setq i (- i 1))
)
(setq xuat (substr FN 1 (+ i 1)))
(setq FD (getstring "Nhap ten file ket qua : "))
(setq FD (strcat xuat FD))
(setq FD (open FD "w"))
; (setq mo (getreal "Nhap sai so MO cua may (giay) : "))
(if (= mo nil)
(progn (setq mo 0)
(princ "\n")
(princ " Lay MO=0")
(princ "\n")
)
)
(setq mo (/ mo 3600))
(setq FN (open FN "r"))
(while (and (setq PR (read-line FN)) (/= PR ""))
(progn
(setq i 1)
(setq sosanh "")
(setq ch "")
(while (/= ch " ")
(setq ch (substr PR i 1))
(setq i (+ i 1))
)
(setq sosanh (substr PR 1 (- i 2)))
(cond ((= sosanh "STN")
(progn
;///////////////////////lay ten tram may//////////
(setq j i)
(while (/= ch ",")
(setq ch (substr PR j 1))
(setq j (+ j 1))
(if (or (= ch "`") (= ch " "))
(setq i j)
)
)
(setq trammay (substr PR i (- j i 1)))
;//////////////////////lay chieu cao may/////////
(setq i j)
(while (/= ch "")
(setq ch (substr PR j 1))
(setq j (+ j 1))
)
(setq ccmay (substr PR i (- j i 2)))
(write-line (strcat "TR " trammay) FD)
) ;end progn
) ;end cond1
((= sosanh "BS")
(progn
;///////////////////////lay ten tram dinh huong//////////
(setq j i)
(while (/= ch ",")
(setq ch (substr PR j 1))
(setq j (+ j 1))
(if (or (= ch "`") (= ch " "))
(setq i j)
)
)
(setq tramdh (substr PR i (- j i 1)))
;//////////////////////lay chieu cao guong/////////
(setq i j)
(while (/= ch "")
(setq ch (substr PR j 1))
(setq j (+ j 1))
)
(setq ccguong (substr PR i (- j i 2)))
(setq tam "bs")
) ;end progn
) ;end cond2
((= sosanh "SD")
(progn
(setq j i)
(while (/= ch ",")
(setq ch (substr PR j 1))
(setq j (+ j 1))
(if (= ch " ")
(setq i j)
)
)
(setq gocbang (substr PR i (- j i 1)))
;///////////////////////////////
(setq i j)
(setq j (+ j 2))
(setq ch "")
(while (/= ch ",")
(setq ch (substr PR j 1))
(setq j (+ j 1))
)
(setq goctd (substr PR i (- j i 1)))
;////////////////////////////////
(setq i j)
(setq j (+ j 2))
(setq ch " ")
(while (/= ch "")
(setq ch (substr PR j 1))
(setq j (+ j 1))
)
(setq canhng (substr PR i (- j i 1)))
;/////////////////////////////////////
(setq hg (atof ccguong))
(setq hm (atof ccmay))
(setq gocdung (- (- 90.0 (dpgtod (atof goctd))) mo))
(setq gocdung (/ (* gocdung pi) 180))
(setq canhng (atof canhng))
(setq canhb (* canhng (cos gocdung)))
(setq h (+ (- hg hm) (* canhng (sin gocdung))))
(setq cd (strlen gocbang))
(setq i cd)
(setq dem 0)
(setq ch "")
(while (/= ch ".")
(setq ch (substr gocbang i 1))
(setq i (- i 1))
(setq dem (+ dem 1))
)
(if (= dem 6)
(setq gocbang (substr gocbang 1 (- cd 1)))
)
(if (= tam "bs")
(write-line
(strcat "DH "
(dd tramdh)
(dd gocbang)
" "
(rtos canhb 2 3)
)
FD
)
(write-line
(strcat (dd stt)
(dd gocbang)
" "
(rtos canhb 2 3)
)
FD
)
)
) ;end progn
) ;end cond3
((= sosanh "SS")
(progn
(setq j i)
(while (/= ch ",")
(setq ch (substr PR j 1))
(setq j (+ j 1))
(if (or (= ch "`") (= ch " "))
(setq i j)
)
)
(setq stt (substr PR i (- j i 1)))
(setq i j)
(while (/= ch "")
(setq ch (substr PR j 1))
(setq j (+ j 1))
)
(setq ccguong (substr PR i (- j i 2)))
(setq tam "ss")
) ;end progn
) ;end cond4
)
) ;end progn
) ;end while
(close FN)
(close FD)
(princ "\n")
(princ "\nOK!")
(princ)
)
------------------------------------------------------------------------------------------------------------------------------------------------------------------
;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
; DUNG CHO BAN DO DIA CHINH *
;* TR DCII-04 1014424.593 516275.846 *
;* TR DCII-07 1014339.861 516213.914 *
;* TR DCII-03 1014491.054 516180.297 *
;* TR DCII-06 1014670.141 516433.592 *
;* TR DCTI-04 *
;* DH DCII-03 *
;* 1 355.1447 66.896 *
;* 2 355.1519 47.576 *
;* 3 1.4545 48.375 *
;************************************************************************
(defun c:pdm (/ tam ms PR FN thunhat
tentram caodotram xtram ytram htram
tentrammay tendh
)
(bdau)
(setq tam ())
(setq ms (getreal "Nhap vao mau so ty le : "))
(setq
FN (getfiled "Nh&#203;p file ngu&#229;n : "
""
""
4
)
)
(progn
(command "-osnap" "")
(setvar "cmdecho" 0)
(setvar "luprec" 8)
(setvar "pdmode" 0)
(command "-layer" "m" "diem" "c" "red" "" "")
; (command "-layer" "m" "caodo" "c" "cyan" "" "")
(command "-layer" "m" "sothutu" "c" "magenta" "" "")
(command "-layer" "m" "khongche" "c" "red" "" "")
(setq st (/ ms 1000))
(setq st1 st)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
(setq FN (open FN "r"))
(while (and (setq PR (read-line FN)) (/= PR ""))
(progn
(setq PR (strcat "(" PR ")"))
(setq PR (read PR))
(setq thunhat (nth 0 PR))
(if
(numberp thunhat)
(gapsoA)
(gaptramA)
)
) ;end progn
) ;end while
) ;end progn
;;;;;ket thuc viet lenh
(close FN)
(command "zoom" "e")
(kthuc)
(princ "\nVAY LA XONG!)*****")
(princ)
)
(defun gaptramA (/ x y)
(setq thunhat (convtostr thunhat))
(if (= thunhat "TR")
(progn
(setq ktra (nth 3 PR))
(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
(progn
(setq tentram (convtostr (nth 1 PR)))
(setq Y (nth 2 PR))
(setq X ktra)
; (setq h (nth 4 PR))
(setq tam (append tam (list (list tentram x y ))))
) ;GAP TRAM DO THUC TE
(progn
(setq tentrammay (convtostr (nth 1 PR)))
; (if (/= (nth 2 PR) nil)
; (setq caodotram (nth 2 PR))
; (setq caodotram 0)
; )
(laytdgoc tentrammay)
(setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
(setq xxtram xtram)
(setq yytram ytram)
(setq tdtram (list xtram ytram))
(command "-layer" "s" "khongche" "")
;(command "point" tdtram)
(command "insert" "cdkc" tdtram st st "")
(setq sss (strlen tentrammay))
(setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
(- ytram (* 0.65 st))
)
)
; (command "insert"
; "l"
; tdtram1
; (* st sss)
; (* st sss)
; ""
; )
(command "-style"
"mota"
"txt.shx"
st
"1"
"0"
"n"
"n"
"n"
)
(command "text" "j" "bl" tdtram1 "" tentrammay)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
; (command "-layer" "s" "khongche" "")
; (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
)
)
) ;end progn
(if (= thunhat "DH") ;else
(progn
(setq tendh (convtostr (nth 1 PR)))
(laytdgoc tendh)
(setq tddh (list xtram ytram ))
(setq tddh1 (list (+ xtram (* 2 st)) ytram ))
(command "-layer" "s" "khongche" "")
(command "insert" "cdkc" tddh st st "")
;(command "point" tddh)
(setq sss (strlen tendh))
(setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
(- ytram (* 0.65 st))
)
)
;(command "insert"
; "l"
; tddh1
; (* st sss)
; (* st sss)
; ""

(command "-style"
"mota"
"txt.shx"
st
"1"
"0"
"n"
"n"
"n"
)
(command "text" "j" "bl" tddh1 "" tendh)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
; (command "-layer" "s" "khongche" "")
; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
)
)
)
)
(defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
(setq gocbang (nth 1 PR))
(setq kc (nth 2 PR))
; (setq dentah (nth 3 PR))
(setq gocbang (dpgtod gocbang))
(setq gocbang (- 360 gocbang))
(setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
(setq tdX (+ xxtram (* kc (cos gocbang))))
(setq tdY (+ yytram (* kc (sin gocbang))))
; (if (/= dentah nil)
; (setq tdz (+ caodotram (nth 2 tdtram) dentah))
; (setq tdz 0)
; )
(setq td (list tdx tdy))
(setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
(setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
(command "-layer" "s" "diem" "")
;(command "insert" "cdc" td st st "")
(command "point" td)
(command "-style"
"mota"
"txt.shx"
(* st 2)
"1"
"0"
"n"
"n"
"n"
)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
(command "-layer" "s" "sothutu" "")
(command "text" td "" thunhat)
; (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
; (command "-layer" "s" "caodo" "")
; (command "text" "tl" td "" (rtos tdz 2 1))
)
------------------------------------------------------------------------------------
chuong trinh tinh toa do diem dua vao goc va canh nhap vao
(defun c:vl () ;/ diemgoc diemdh goc canh)
(bdau)
(command "-layer" "m" "veluoi" "c" "cyan" "" "")
(command "-layer" "m" "point" "c" "red" "" "")
(command "-layer" "m" "text" "c" "yellow" "" "")
(setq diemgoc (getpoint "\nChon diem goc : "))
(setq diemdh (getpoint "\nChon diem dinh huong : "))
(setq goc (getreal "\nNhap goc(do.phutgiay) : "))
(setq canh (getreal "\nNhap chieu dai canh : "))
(setq tendiem (getstring "Nhap ten diem : "))
(setq goc2 (dpgtod goc))
(setq goc1 (/ (* goc2 pi) 180))
(setq gocbang (- (* 2 pi) goc1))
(setq gocbang (+ gocbang (angle diemgoc diemdh)))
(setq x1 (nth 0 diemgoc))
(setq y1 (nth 1 diemgoc))
(setq x2 (nth 0 diemdh))
(setq y2 (nth 1 diemdh))
(setq x3 (+ x1 (* canh (cos gocbang))))
(setq y3 (+ y1 (* canh (sin gocbang))))
(setq td3 (list x3 y3))
(command "-layer" "s" "point" "")
(command "point" td3)
(command "-layer" "s" "veluoi" "")
(command "line" diemgoc td3 "")
(command "-layer" "s" "text" "")
(command "-style" "mota" "txt.shx" 2 "1" "0" "n" "n" "n")
(command "text" td3 "" tendiem)
(kthuc)
)
------------------------------------------------------------------------------------
; CHUONG TRINH LAY TOA DO 1 DIEM SAP XEP THEO X : Y : Z XUAT TRANG TEXT
(defun C:TM (/ DIEM)
(command "osnap" "endpoint")
(setq DIEM (getpoint "Chon tram may can lay toa do"))
(princ "\n TOA DO TRAM MAY: ")
(princ (rtos (cadr DIEM) 2 3))
(princ " ")
(princ (rtos (car DIEM) 2 3))
(princ " ")
(princ (rtos (caddr DIEM) 2 3))
(princ)
) ;END DEFUN
---------------------------------------------------------------------------------------

+ Sau đó mới dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.

Nhờ các anh em trên diễn đàn giúp em hoàn thiện lisp phun tọa độ lên màn hình Autocad là gộp các lisp riêng lẻ thành 1 lệnh chế biến (CB) với nội dung như sau:
Mở AutoCAD ra và gõ lệnh chế biến (CB) sau đó tìm đến đường dẫn chứa File thô trút số liệu từ máy đo ra là có thể xuất tọa độ điểm đo ra ngoài màn hình và chỉ việc nối các điểm mia là xong mà không phải thực hiện từng thao tác như trước nữa!
cảm ơn các anh em rất nhiều!

Em mới code được đoạn lisp sau:

(Defun C:ds ( )
;chon duong thu nhat
(setq DT (entsel "\nChon LINE mau1"))
(while
(or
(null DT)
(/= "LINE" (cdr (assoc 0 (entget (car DT)))))
)
(princ "\nDoi tuong khong phai la LINE! Chon lai")
(setq DT (entsel "\nChon LINE mau 1"))
)
(setq DT (car DT));loc chon doi tuong
(setq DT (entget DT))
(setq DD (cdr (assoc 10...

Em mới code được đoạn lisp sau:

(Defun C:ds ( )
;chon duong thu nhat
(setq DT (entsel "\nChon LINE mau1"))
(while
(or
(null DT)
(/= "LINE" (cdr (assoc 0 (entget (car DT)))))
)
(princ "\nDoi tuong khong phai la LINE! Chon lai")
(setq DT (entsel "\nChon LINE mau 1"))
)
(setq DT (car DT));loc chon doi tuong
(setq DT (entget DT))
(setq DD (cdr (assoc 10 DT)))
(setq DC (cdr (assoc 11 DT)))
(setq gocdc(angle DD DC))
(setq daidc (distance DD DC))
;chon duong thu 2
(setq DT1 (entsel "\nChon LINE mau2"))
(while
(or
(null DT1)
(/= "LINE" (cdr (assoc 0 (entget (car DT1)))))
)
(princ "\nDoi tuong khong phai la LINE! Chon lai")
(setq DT1 (entsel "\nChon LINE2 mau"))
)
(setq DT1 (car DT1))
(setq DT1 (entget DT1))
(setq DD1 (cdr (assoc 10 DT1)))
(setq DC1 (cdr (assoc 11 DT1)))
(setq gocdc1(angle DD1 DC1))
(setq daidc1 (distance DD1 DC1))
;Ket thuc chon duong thu 2
;(command "line" dd dd1 "" )
;(command "line" dc dc1 "" )
(command "Pline" dd dc dc1 dd1 dd "" )
(command "hatch" "solid" (ssget) "")
(princ)
)

Lisp thực hiện như sau:
- Chọn đường thứ nhất, chọn đường thứ 2
- Vẽ polyline qua 4 điếm của đường thẳng
- Hatch vùng bao.
Lisp trên đã thực hiện được nhưng hơi dài
Em muốn rút gọn như sau: để không phải chọn đối tượng sau khi hatch mà lisp tự lấy cái polyline cuối cùng để hatch luôn.
Em cám ơn !

Hề hề hề,
Đây rồi, nín đi nha.
Dùng thử coi có gì chưa ưng ý thì post lên nhé. Nhưng mà nhớ đọc kỹ hướng dẫn trước khi dùng kẻo mà lại khóc oan đó.
Hướng dẫn sủ dụng như sau:
1/- Load lisp vô bản vẽ
2/- Gõ lệnh brpl rùi enter.
3/- Khi lisp yêu cầu chọn điểm break thứ nhất thì nhớ phải chọn sao cho nó gần với điểm đầu của polyline (có cái dây tóc...

Hề hề hề,
Đây rồi, nín đi nha.
Dùng thử coi có gì chưa ưng ý thì post lên nhé. Nhưng mà nhớ đọc kỹ hướng dẫn trước khi dùng kẻo mà lại khóc oan đó.
Hướng dẫn sủ dụng như sau:
1/- Load lisp vô bản vẽ
2/- Gõ lệnh brpl rùi enter.
3/- Khi lisp yêu cầu chọn điểm break thứ nhất thì nhớ phải chọn sao cho nó gần với điểm đầu của polyline (có cái dây tóc chỉ rõ điểm đầu ở mô đó) hơn là cái điểm break thứ hai sẽ được chọn sau đó. Cái ni mà chọn lộn là lisp nó nỏ biết đường đi mô, Rứa là nó chạy ra cái chi ráng chịu cái đó nha.
4/- Nếu như thấy cái kết quả chưa ưng thì hãy gõ undo để trả bản vẽ về nguyên trạng thái ban đầu nghen.

Hề hề hề, lisp đây ạ:


Chúc bạn vui và đừng bao giờ nhè nữa nghen.....

Lại hỏi mọi người 1 câu nữa cũng liên quan đến cái (LM:GrText) ni. Nếu mình muốn text hiển thị trong hàm (LM:GrText) có kích thước to hơn thì chỉnh ở chổ nào nhỉ?
Trong hàm (LM:GrText) hay trong hàm chính. ví dụ như hàm chính của chính tác giả Lee dưới đây.

(defun c:test ( / *error* vl g s )
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
...

Lại hỏi mọi người 1 câu nữa cũng liên quan đến cái (LM:GrText) ni. Nếu mình muốn text hiển thị trong hàm (LM:GrText) có kích thước to hơn thì chỉnh ở chổ nào nhỉ?
Trong hàm (LM:GrText) hay trong hàm chính. ví dụ như hàm chính của chính tác giả Lee dưới đây.

(defun c:test ( / *error* vl g s )
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw) (princ)
)

(setq vl (LM:GrText "www.cadviet.com" 2 ))
(while (= 5 (car (setq g (grread nil 13 0)))) (redraw)
(setq s (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) g (trans (cadr g) 1 3))
(grvecs vl
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s (+ (car g) (* 15 s)) (- (cadr g) (* 31 s))
)
)
)
(redraw) (princ)
)

Sửa lại 1 chút theo ý bạn, còn nguyên lý làm việc vẫn giữ nguyên ý bác Tuệ, chạy mượt hay không bạn tìm bác ấy nhé

(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh ent fl)
(setq fl "")
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt tle goc)
(setvar...

Sửa lại 1 chút theo ý bạn, còn nguyên lý làm việc vẫn giữ nguyên ý bác Tuệ, chạy mượt hay không bạn tìm bác ấy nhé

(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh ent fl)
(setq fl "")
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" (getvar "hpname") tle goc "S" dt "" "")
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(while (setq ent (entsel "\nDoi tuong chua layer mau :"))
(setq lay (Tue-dxf 8 (car ent))
fl (cond ((not (wcmatch lay fl))(strcat fl lay ",")))
)
)
(setq fl (vl-string-left-trim "," fl))
(if (setq ss (ssget (list (cons 0 "*POLYLINE")
(cons 8 (cond ((setq tmp (vl-string-search "," fl)) (substr fl 1 (vl-string-search "," fl)))
(fl)
)))))
(Progn
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq ss2 (ssget "f" (Tue-ent-Lpoint ename) (list (cons 0 "*POLYLINE") (cons 8 fl))))
(lh ss2 "1" "0")
)
))
)