Yêu cầu của bạn toàn Pline nằm ngang ? hãy nhớ để dựng hình thì thằng ngang khác với thằng k ngang (dễ hơn ^^)

Ví dụ nhanh với Pline ngang :


(defun c:p2r(/ massocV eRec isSame id tmp lst lstObj ov)
(defun massocV (id data)
(mapcar 'cdr (vl-remove-if-not '(lambda(x)(eq id (car x))) data))

>>

Yêu cầu của bạn toàn Pline nằm ngang ? hãy nhớ để dựng hình thì thằng ngang khác với thằng k ngang (dễ hơn ^^)

Ví dụ nhanh với Pline ngang :


(defun c:p2r(/ massocV eRec isSame id tmp lst lstObj ov)
(defun massocV (id data)
(mapcar 'cdr (vl-remove-if-not '(lambda(x)(eq id (car x))) data))
)
(defun eRec (p1 p2 hw / lst)(setq lst (list 0 hw 0))
(entmake
(append
(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 8 (getvar 'cLayer))
(cons 90 4)(cons 70 1)
)
(mapcar '(lambda (x) (cons 10 x)) (mapcar '(lambda(x y)(mapcar x y lst)) '(+ + - -) (list p1 p2 p2 p1)))
)
)
)
(defun isSame (lst)(and (not (zerop (car lst)))(apply 'and (mapcar '(lambda(x y)(equal x y)) lst (cdr lst)))))
(setq id '(40 41) ov (getvar 'plinewid))
(setvar 'plinewid 0)
(foreach obj (setq lstObj (acet-ss-to-list (ssget (list (cons 0 "*POLYLINE")(cons 90 2)))))
(if (isSame (setq lst (apply 'append (mapcar '(lambda(x)(massocV x (entget obj))) id))))
(erec (car (setq tmp (massocV 10 (entget obj))))(last tmp) (* 0.5 (car lst)))
)
)
(if (wcmatch (getstring "\nXoa duong goc ? <Y> :") ",")
(mapcar 'entdel lstObj)
)
(setvar 'plinewid ov)
)


- Nếu k ngang thì lại phải sửa đi 1 chút
- Nếu k phải chỉ có 1 segment thì lại sửa đi 1 chút nữa
- Nếu k phải chỉ có segment thẳng thì lại phải sửa đi nhiều nữa
- Nếu k phải chiều dày đầu cuối bằng nhau thì ...
....
....
Google!

Quick code. Lần sau bạn nhớ chú ý cách đặt vấn đề và nội quy box này :


(defun c:test(/ i adoc)(vl-load-com)(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)

>>

Quick code. Lần sau bạn nhớ chú ý cách đặt vấn đề và nội quy box này :


(defun c:test(/ i adoc)(vl-load-com)(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
(vla-addtext
(cond (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
)
(rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
(vlax-3d-point x)
h
)
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",")
a
(reverse a)
)
)(command "undo" "en")
)

(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver)
(PROGN
(vl-load-com)
(defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
(defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)

>>

(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver)
(PROGN
(vl-load-com)
(defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
(defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
)
(defun checkClosed(/ OK)
(while (and (null OK) (setq pl (vlax-ename->vla-object
(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0))) )
(if (null (vlax-curve-isClosed pl) )
(progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
(setq OK T)
)
)
pl
)
(acet-undo-begin)
(setq oldos (getvar "osmode"))
(setq ms (vla-get-modelspace
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
)
(prompt "\n Chon cac doi tuong :")
(vla-SelectOnScreen ss)
(iF (> (vla-get-count ss) 0)
(proGN
(setq i 0)
(setq temperr *error*)
(setq *error* bloi)
(minmaxp (checkClosed) )
(setq minpp (mapcar '- (safearray-value minp)
(list (setq dist (distance (safearray-value maxp) (safearray-value minp)))
dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
(setvar "osmode" 0)
(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while (< i (vla-get-count ss))
(minmaxp (setq obj (vla-item ss i)))
(setq line (vla-addline ms minp maxp ))
(setq line2 (vla-addline ms
(vla-polarpoint util minp 0
(- (car (safearray-value maxp)) (car (safearray-value minp)) )
)
(vla-polarpoint util minp (/ pi 2)
(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
)
)
)
;
(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
)
(PROGN
(setq sslistints (cons obj sslistints))
)
(PROGN
(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
(setq sslistous (cons obj sslistous))
(setq sslistins (cons obj sslistins))
)
(vla-erase line3)
)
);if
(setq i (1+ i))
(vla-erase line)
(vla-erase line2)
(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
((= ans "TRONG") (setq sss (getss sslistins)))
((= ans "TREN") (setq sss (getss sslistints)))
((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)
(sssetfirst sss sss)
(setq *error* temperr)

);proGN
(alert "\n No Selected....")
);iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)

Nhờ các bác xem và chỉnh sửa lại dùm em lisp này của bác TUE_NV.
Sau khi em dùng lệnh ssx của cad để ngầm lựa chọn các đối tượng trong bản vẽ.
Sau khi dùng lệnh SIC của bác TUE_NV thì lisp sẽ chỉ chọn các đối tượng đã lựa chọn trước và nằm trong/trên/ngoài vùng khép kín.
Sau khi chọn được rồi ta có thể Copy, Move, Erase,....
Em cũng đã thử chỉnh sửa nhưng không được.
Các bác giúp em nhé. Em đang mò mẫm lại cho thỏa cái đam mê.

Ý 1 : Quick code :


(defun c:test(/ i adoc daolst )(vl-load-com)
(defun daolst (lst p / lst1 i a
(setq p (car (vl-sort lst '(lambda(x y)(< (distance p x)(distance p y))))))
(cond
((setq a (member p lst)) (setq i -1)
(setq b (append a
(reverse(repeat (vl-position p lst)
(setq lst1 (cons (nth (setq i (1+...

Ý 1 : Quick code :


(defun c:test(/ i adoc daolst )(vl-load-com)
(defun daolst (lst p / lst1 i a
(setq p (car (vl-sort lst '(lambda(x y)(< (distance p x)(distance p y))))))
(cond
((setq a (member p lst)) (setq i -1)
(setq b (append a
(reverse(repeat (vl-position p lst)
(setq lst1 (cons (nth (setq i (1+ i)) lst) lst1))
))
)))
)
b
)
(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))) a (daolst a (getpoint "\nDiem bat dau danh so :")))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
(vla-addtext
(cond (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
)
(rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
(vlax-3d-point x)
h
)
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",")
a
(reverse a)
)
)(command "undo" "en")
)


- Ý 2 của bạn k có cơ sở, vì mình tạo Dtext chứ k tạo Mtext, và mình tạo theo style hiện hành

- hiện tại em phải dùng 5 thao tác riêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:
1: 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
2; Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.
3: Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.
4: Dùng...

- hiện tại em phải dùng 5 thao tác riêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:
1: 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
2; Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.
3: Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.
4: Dùng lệnh lấy trạm máy ™ để lấy tọa độ của trạm máy.
5: 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òn nếu khó và phức tạp quá thì có thể giúp em gộp bước 1 và 2 thành 1 ở trên để phun điểm mia ra và tự làm các bước còn lại theo cách thủ công như cũ.
Cảm ơn các anh em rất nhiều!
ĐÂY LÀ CODE CẦN ANH EM SỬA GIÚP:


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

Với trường hợp sử dụng nhiều IF, bạn nên chuyển hướng sang hàm rẽ nhánh COND. Ngoài ra, thao tác lặp đi lặp lại nên tìm cách đặt nó ra sau cùng.
Ngoài ra, khi viết lisp, bạn có thể nên nghĩ đến việc sử dụng trong tương lai.Ví dụ bạn có thể viết như sau :

(defun c:cc()
(setq lstLayer '("Contour-buiten" "Contour-binnen" "FRAG-8" "1234")) ;List cac Layer xu ly,...

Với trường hợp sử dụng nhiều IF, bạn nên chuyển hướng sang hàm rẽ nhánh COND. Ngoài ra, thao tác lặp đi lặp lại nên tìm cách đặt nó ra sau cùng.
Ngoài ra, khi viết lisp, bạn có thể nên nghĩ đến việc sử dụng trong tương lai.Ví dụ bạn có thể viết như sau :

(defun c:cc()
(setq lstLayer '("Contour-buiten" "Contour-binnen" "FRAG-8" "1234")) ;List cac Layer xu ly, co the them hoac bot trong tuong lai
(foreach layer lstLayer ;Duyet qua tung layer trong list ben tren
(cond ((tblsearch "layer" layer) ;Neu tim thay Layer
(if (setq ss (ssget "x" (list (cons 8 layer)))) ;Kiem tra xem co doi tuong nao thuoc Layer do (neu khong, phan ss "p" cua ban co the khong phai nhu y
(progn ;Neu co thi chon het va chuyen ve layer 0
(sssetfirst nil ss)
(command "chprop" "p" "" "layer" "0" "")
) ;Ket thuc Progn
) ;Ket thuc If
) ;Ket thuc cond 1
) ; Ket thuc toan bo cond
)
;Lam cac viec khac vi du nhu
(command "-layer" "lock" "0" "")
(command "erase" "all" "")
(command "-layer" "unlock" "0" "")
(command "_.saveas" "DXF" ""
(strcat
(getvar 'dwgprefix)
(substr (getvar 'dwgname) 1 (- (strlen (getvar 'dwgname)) 4))
".dxf"
) "y")
(command "._close" "_n")
)

Nếu bạn cần nó thì đây :

Cách sử dụng : Sử dụng "lệnh trong lệnh"
Ví dụ :

Command: l LINE -> Gõ lệnh Line
Specify first point: 'gpo -> Gõ 'gpo

Diem goc : -> Hỏi chọn điểm gốc
x = 500 -> Hỏi nhập X

y = 600 -> Hỏi nhập Y
(1.09567e+006 401936.0 0.0) -> con trỏ chuột sẽ nhảy đến vị trí có tọa độ cách điểm gốc X,...

Nếu bạn cần nó thì đây :

Cách sử dụng : Sử dụng "lệnh trong lệnh"
Ví dụ :

Command: l LINE -> Gõ lệnh Line
Specify first point: 'gpo -> Gõ 'gpo

Diem goc : -> Hỏi chọn điểm gốc
x = 500 -> Hỏi nhập X

y = 600 -> Hỏi nhập Y
(1.09567e+006 401936.0 0.0) -> con trỏ chuột sẽ nhảy đến vị trí có tọa độ cách điểm gốc X, Y

Specify next point or :
Specify next point or :

-Lệnh: RLX
-Thao tác:
+Nhập lệnh, enter.
+Chọn các đối tượng muốn copy (nhiều hoặc 1 cứ chọn chừng nào ko ưng nửa thì enter).
+Chọn điểm cơ sở dùng để copy nhóm đối tượng vừa chọn.
+Chọn đường dẩn để rải.
+Chọn điểm gốc tính toán trên đường dẩn ở lưng chừng đường dẩn cũng được nhưng nhất thiết phải thuộc đường dẩn.
+Chọn điểm...

-Lệnh: RLX
-Thao tác:
+Nhập lệnh, enter.
+Chọn các đối tượng muốn copy (nhiều hoặc 1 cứ chọn chừng nào ko ưng nửa thì enter).
+Chọn điểm cơ sở dùng để copy nhóm đối tượng vừa chọn.
+Chọn đường dẩn để rải.
+Chọn điểm gốc tính toán trên đường dẩn ở lưng chừng đường dẩn cũng được nhưng nhất thiết phải thuộc đường dẩn.
+Chọn điểm định hướng rải nhất thiết phải thuộc đường dẩn.
-Nó hỏi khoảng cách cứ nhập tường khoảng cách xong enter hì nó copy đếncho bạn, không ưng nửa thì enter kết thúc lệnh.
-Luu ý bạn chì cần nhập khoảng cách của điểm phía trước nó với nó là được.
-Mình chưa tính tới trường hợp điểm bạn muốn vượt quá chiều dài đường dẩn và chưa quay vuông góc vì ko biết đungúng ý bạn không. Có gì phản hồi rồi hoàn thiện tiếp.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chon curve
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun duy:c_curve (/ cur)
(setq ddd (entsel "\nChon curve:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong phai curve! Chon lai"))
)
(setq cur (car ddd))
cur)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh diem tu diem can cu den diem dinh huong theo khoang cach
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_diem<dai-huong (curve diemcancu diemhuong khoangcach / curve diemcancu diemhuong khoangcach dmot dhai daixd diemkq)
(setq dmot (vlax-curve-getDistAtPoint curve diemcancu))
(setq dhai (vlax-curve-getDistAtPoint curve diemhuong))
(if (> dhai dmot) (setq daixd (+ dmot khoangcach)) (setq daixd (- dmot khoangcach)))
(setq diemkq (vlax-curve-getPointAtDist curve daixd))
diemkq)

(defun c:rlx ()
(command "undo" "be")
(vl-load-com)
(princ "\nChon cac doi tuong dung de rai")
(setq dtcp (ssget))
(setq dcp (getpoint "\nDiem can cu de copy nhom doi tuong:"))
(setq dtim (duy:c_curve))
(setq ddau (getpoint "\nDiem dau tien de chen tren curve:"))
(setq ddhuong (getpoint "\nDiem dinh huong rai tren curve:"))
(setq kc 0)
(setq lan 1)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(while (setq kc1 (getreal (strcat "\nKhoang cach thu " (itoa lan) " <Nhan enter de ket thuc> :")))
(setq kc (+ kc kc1))
(setq dcpd (duy:xd_diem<dai-huong dtim ddau ddhuong kc))
(command ".copy" dtcp "" dcp dcpd "")
(setq lan (+ lan 1))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
(princ)
)

Chào các bạn trên diễn đàn. Mình đanh tập viết lisp. Mong các bạn giúp đỡ.

Mình viết một đọn code để chọn các block trong bản vẽ có tên là tên của Block mình đã chọn trước.
Do chưa nắm rõ lên chương trình chưa chạy được. Mong các bạn chỉnh sửa lại giúp.



(defun c:Dem ( / ss )
; Lay ten block can dem
(setq pt (cadr (entsel "\nChon Block can...

Chào các bạn trên diễn đàn. Mình đanh tập viết lisp. Mong các bạn giúp đỡ.

Mình viết một đọn code để chọn các block trong bản vẽ có tên là tên của Block mình đã chọn trước.
Do chưa nắm rõ lên chương trình chưa chạy được. Mong các bạn chỉnh sửa lại giúp.



(defun c:Dem ( / ss )
; Lay ten block can dem
(setq pt (cadr (entsel "\nChon Block can dem")))
(setq e1 (ssget pt))
(setq e2 (entget (ssname e1 0)))
(setq tenblock (cdr (assoc 2 e2)))

; Chon tat ca cac block co ten cua block da chon o tren va dem
(setq ss (ssget '((cons 2 tenblock) (0 . "INSERT"))))
(if ss
(princ (strcat "\n So block da chon la: " (rtos (sslength ss))))
)
(princ)
)



Vạn sự khởi đầu nan. Mong các bạn chỉ giùm. Thank !!!

Quick and dirty code - quick test - chưa khử biến luôn vì đến giờ e đi làm rồi.
Đếm cả Block động



(defun c:test ()
(vl-load-com)
(defun table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
(defun DCL(Title @ ThongTin lstVal / fl ret)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl...

Quick and dirty code - quick test - chưa khử biến luôn vì đến giờ e đi làm rồi.
Đếm cả Block động



(defun c:test ()
(vl-load-com)
(defun table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
(defun DCL(Title @ ThongTin lstVal / fl ret)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
"mip_msg : dialog { "
(strcat "label=\"" title "\"; width = 40;fixed_width = true;") ;
":popup_list {label = \"Block : \";key=\"kLst\";}"
": column {"
": row {"
" fixed_width = true;"
" alignment = centered;"
":button {label = \"\U+0110\U+1ED3ng \U+00FD\"; is_cancel = true;fixed_width = true;width = 1;}"
" : spacer { width = 2; }"
":button {label = \"Th\U+00F4ng tin\";fixed_width = true;width = 1;key = \"kThongTin\";}"
"}"
"}"
" :text_part {alignment=centered;"
(strcat "label=\"" @ "\";")
"}}"
)
) ;_ end of mapcar
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
) ;_ end of and
(progn
(start_list "kLst" 3)
(mapcar '(lambda(x)(add_list x)) lstVal)
(end_list)
(action_tile "kLst" "(setq ret (nth (atoi $value) lstVal))")
(start_dialog)
) ;_ end of progn
) ;_ end of if
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)
(setq lstBlk (vl-remove-if '(lambda(x)(wcmatch x "`**"))(acad_strlsort (table "Block"))))
(cond ((setq nm (DCL "Select block :" "@Ketxu" "Counting choiced block @Ketxu" lstBlk))
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 (strcat nm ",`**"))))
tol (length (setq tmp (vl-remove-if-not '(lambda(x)(= (vla-get-EffectiveName (vlax-ename->vla-object x)) nm)) (acet-ss-to-list ss))))
)
))
(cond ((> tol 0)
(sssetfirst nil (acet-list-to-ss tmp))
(princ (strcat "So block " nm " tim thay trong vung chon la : " (itoa tol) ))
)(T (princ "K co cai nao trong vung chon nhe"))
)
(princ)
)