Jump to content
InfoFile
Tác giả: phamthanhbinh
Bài viết gốc: 225032
Tên lệnh: sxtc
Căn lề text + Mtext, Căn lề đối tượng

Hề hề hề,
Lisp đã viết xong, nhưng diễn đàn trục trặc chi đó mà cả ngày hôm qua không post lên được. Tuy nhiên có một vài vấn đề cần lưu ý với bạn khi sử dụng như sau:
1/- Bản vẽ bạn gửi có rất nhiều đối tượng trùng nhau. Điều này gây khó khăn cho lisp khiến nó không chạy tốt được. Bạn nên sử dụng lệnh overkill trong express d963 loại hết các đối tượng trùng nhau...
>>

Hề hề hề,
Lisp đã viết xong, nhưng diễn đàn trục trặc chi đó mà cả ngày hôm qua không post lên được. Tuy nhiên có một vài vấn đề cần lưu ý với bạn khi sử dụng như sau:
1/- Bản vẽ bạn gửi có rất nhiều đối tượng trùng nhau. Điều này gây khó khăn cho lisp khiến nó không chạy tốt được. Bạn nên sử dụng lệnh overkill trong express d963 loại hết các đối tượng trùng nhau trước khi chạy lisp.
2/- các line mặt đất của bạn vẽ nhiều chỗ không chuẩn , Đít thằng nọ không ngồi lên đầu thằng kia. Vì thế việc chuyển đổi từ line về pline bị trục trặc. bạn cần kiểm soát lại toàn bộ các line mặt đất để đảm bảo đít thằng nọ ngồi đúng đầu thằng kia mới được.
3/- Các block bạn đã nhét sẵn vào bản vẽ hoàn toàn không cần dùng đến nó vì khi chạy lisp sẽ chèn các block mới vào điểm cần chèn. Như vậy xem ra hợp lý hơn là việc move các block có sẵn về điểm chèn mới. (vì chả biết nên move thằng nào)
4/- Bạn nên làm việc dọn dẹp bản vẽ thường xuyên để tránh tình trạng như bản vẽ bạn đã gửi. Nó gây khó khăn rất nhiều cho người làm lisp không am hiểu chuyên ngành của bạn như mình.

Đây là lisp. Bạn hãy làm đúng như mình nói rồi hẵng test, nếu không bạn sẽ thất vọng đó.


Chúc bạn vui.
<<

Filename: 225032_sxtc.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225095
Tên lệnh: ttd
lisp pick tọa độ từ hệ tọa độ cad sang vn2000

Bạn "like" mà gượng ép quá vậy >"<, của bạn đây nè, còn vụ elisp nhỏ hơn text mình nghĩ do máy bạn sao chứ mình bình thường ah vừa vặn
http://www.cadviet.com/upfiles/3/104473_tddddrrrr.jpg
đấy vừa vặn tuy ko rộng rãi nhưng cũng ko bị trùng
sữa lại theo hệ tọa độ Trắc địa :D
>>
Bạn "like" mà gượng ép quá vậy >"<, của bạn đây nè, còn vụ elisp nhỏ hơn text mình nghĩ do máy bạn sao chứ mình bình thường ah vừa vặn
http://www.cadviet.com/upfiles/3/104473_tddddrrrr.jpg
đấy vừa vặn tuy ko rộng rãi nhưng cũng ko bị trùng
sữa lại theo hệ tọa độ Trắc địa :D, lsp này mình sữa là dùng lsp của bạn post đấy nhá ^^, hình chứng minh đã đổi hệ tọa độ :D
http://www.cadviet.com/upfiles/3/104473_ssssssssssssssssss.jpg
Còn đây là lsp

(defun C:TTD (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN
B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK
PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME
EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH)
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(command "layer" "m" "QKHS" "c" "6" "" "")
(command "undo" "be")
(setvar "cmdecho" 0)

(command "undo" "begin")
(vl-load-com)
;======================= Defun ==========================
(defun rotate-text ( en ang / p1 p2 a e1)
(setq p1 (acet-geom-textbox (setq e1 (entget en)) 0)
p1 (acet-geom-midpoint (car p1) (caddr p1))
e1 (subst (cons 11 p1) (assoc 11 e1) e1)
a (cdr (assoc 50 e1))
a (+ ang a)
e1 (subst (cons 50 a) (assoc 50 e1) e1)
e1 (subst (cons 72 1) (assoc 72 e1) e1)
e1 (subst (cons 73 2) (assoc 73 e1) e1)
);setq
(entmod e1)
(entupd EN))
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun angle-d2r (ANGD) (if ANGD (/ (* pi ANGD) 180) nil))
(defun angle-r2d (ANGR) (if ANGR (/ (* 180 ANGR) pi) nil))
(defun grnode (point radius color ang node fomp hightlight / ANGi PT0 PT1 PTg COL)
(if fomp
(setq ANGi 0)
(setq ANGi (* 0.5 (angle-d2r ang))))
(if (= color 0) (setq COL 10) (setq COL color))
(setq PT0 (polar point ANGi radius) PTg PT0)
(if node (grdraw point PT0 color hightlight))
(while (<= ANGi (* 2 Pi))
(setq ANGi (+ ANGi (angle-d2r ang))
PT1 (polar point ANGi radius))
(if (= color 0) (setq COL (1+ COL)))
(if node (grdraw point PT0 COL hightlight) (grdraw PT0 PT1 COL hightlight))
(setq PT0 PT1)
);while
(if (not node) (grdraw PT0 PTg COL hightlight))
);end grnode
(defun tencoc (EN) (if (check-nova EN) (cdr (nth 7 (car(cdr (assoc -3 (entget EN '("*"))))))) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun check-nova (EN) (if (= (car(car(cdr (assoc -3 (entget EN '("*")))))) "TDNW") T nil))
(defun lytrinh (EN) (if (check-nova EN) (rtos (cdr (nth 5 (car(cdr (assoc -3 (entget EN '("*"))))))) 2 2) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun accept ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 0)) (done_dialog))
(defun nova ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 1)) (done_dialog))
(defun node ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "table" "1")))
(defun table ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "node" "1")))
(defun style (/ htxt htxt0)
(setq htxt0 (get_tile "height"))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth (fix (atof (get_tile "style"))) Lst-TS))))) 0)
(progn (set_tile "height" (rtos htxt 2 3)) (mode_tile "height" 1))
(progn (mode_tile "height" 0) (set_tile "height" htxt0))))
(defun baoloi (val key valkey)
(if (= "." (substr val 1 1)) (setq val (strcat "0" val)))
(if (not (or (= val "") (and (or (= (type (read val)) 'REAL) (= (type (read val)) 'INT)) (> (atof val) 0))))
(progn
(if (or (= key "height") (= key "start"))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so thuc duong"))
(ACET-SYS-SLEEP 120))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so nguyen duong"))
(ACET-SYS-SLEEP 120)))
(mode_tile key 2)
(mode_tile key 3)
);progn
(set_tile "err" (strcat "Statistical coordinates data record - \Toa do "))
);if
);end error
(if (not TD-value) (setq TD-value (list "1" "1" (getvar "textstyle") "2.00" "N" "1" 0)))
(setq DCL_CDn (list
"Coordinate : dialog { value = \"http://taybac.1talk.net - \<Thong ke Toa do>\"; key = \"err\";"
" : column { children_alignment = top;"
" : boxed_row { "
" : column {"
" : toggle { key = \"node\"; label = \"Chen diem\"; height = 1.4;}"
" : toggle { key = \"table\"; label = \"Chen bang\"; height = 2.5;}}"
" : column {"
" : popup_list { key = \"style\"; label = \"Text Style\"; edit_width = 10.1;}"
" : edit_box { key = \"height\"; label = \"Height Text\"; height = 1.1; edit_width = 11;}"
" : tile { label = \"-\"; alignment = centered;}} "
" : column {"
" : edit_box { key = \"name\"; label = \" Ten diem\"; height = 1.1; edit_width = 4;}"
" : edit_box { key = \"start\"; label = \" So bat dau\"; height = 1.1; edit_width = 4;}"
" : tile { label = \"-\"; alignment = centered;}} "
" } "
" : button { key = \"nova\"; label = \"Export Station coodinates from Road-Plan\";}"
" : row {"
" : button { key = \"cancel\"; label = \" Thoat \"; is_cancel = true;}"
" : button { key = \"accept\"; label = \" Bat dau \"; is_default = true;}}"
" }"
" }"
"helpTLuy : dialog { label = \"Help and Copyright\U+00A9 Information\";"
" : column {"
" : row { : list_box { key = \"helpList\"; edit_width = 95; width = 98; height = 25;}}"
" : row { : button { key = \"okayHelp\"; label = \"Okay\"; is_default = false; is_cancel = true;}}"
" }"
" }"
)
TEMP_CDn (vl-filename-mktemp "CDn.DCL")
FILE_DCL (open TEMP_CDn "W"))
(foreach LL DCL_CDn (write-line LL FILE_DCL))
(close FILE_DCL)
(setq DCL_ID (load_dialog TEMP_CDn))
(new_dialog "Coordinate" DCL_ID)
(set_tile "node" (nth 0 TD-value))
(set_tile "table" (nth 1 TD-value))
(set_tile "height" (nth 3 TD-value))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth 2 TD-value))))) 0)
(progn (set_tile "height" (rtos htxt 2 2)) (mode_tile "height" 1)))
(set_tile "name" (nth 4 TD-value))
(set_tile "start" (nth 5 TD-value))
(start_list "style")
(setq Lst-TS (list (nth 2 TD-value) (cdr (assoc 2 (tblnext "Style" T)))))
(while (setq TSN (tblnext "Style"))
(if (and (/= (cdr (assoc 2 TSN)) (nth 2 TD-value)) (/= (cdr (assoc 2 TSN)) ""))
(setq Lst-TS (append Lst-TS (list (cdr (assoc 2 TSN))))))
);while
(mapcar 'add_list Lst-TS)
(end_list)
(action_tile "cancel" "(exit)")
(action_tile "accept" "(accept)")
(action_tile "nova" "(nova)")
(action_tile "node" "(node)")
(action_tile "table" "(table)")
(action_tile "style" "(style)")
(action_tile "height" "(baoloi (get_tile \"height\") \"height\" \"''Cao chu''\")")
(action_tile "start" "(baoloi (get_tile \"start\") \"start\" \"''STT''\")")
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete TEMP_CDn)
(setq H (atof (nth 3 TD-value)))
(if (wcmatch (cdr (assoc 3 (tblsearch "style" (nth 2 TD-value)))) "*AVAN*,*ARIAL*,*BLACK*") (setq Wh (* 1.5 H)) (setq Wh 0))
(if (= (nth 6 TD-value) 0) (progn
(if (/= (nth 3 TD-value) "") (setq N (nth 3 TD-value)))
(command "UCS" "W")
(setvar "dimzin" 0)
(command "undo" "begin")
(if (= (nth 5 TD-value) "") (setq k 0) (setq k (- (atof (nth 5 TD-value)) 1)))
(if (= (nth 1 TD-value) "1") ; BEGIN TABLE
(progn (prompt "Chon diem dat bang toa do...")
(while
(if (= (car (setq GR (grread 't 15 0))) 5)
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(redraw)
(setq BTR (cadr GR)
BTL (polar BTR 0 (* H -26))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BBR (polar BTR (* 0.5 pi) (* H -11))
BBL (polar BTL (* 0.5 pi) (* H -11))
BB1 (polar BT1 (* 0.5 pi) (* H -11))
BB2 (polar BT2 (* 0.5 pi) (* H -11))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(grdraw BTL BTR COL 1)
(grdraw BTL BBL COL 1)
(grdraw BTR BBR COL 1)
(grdraw BT1 BB1 COL 1)
(grdraw BT2 BB2 COL 1)
(grdraw BR BL COL 1)
(repeat 3
(setq BR (polar BR (* 0.5 pi) (* H -2.0))
BL (polar BL (* 0.5 pi) (* H -2.0))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4)))
(grdraw BR BL COL 1)) T)
(progn
(setq PTitle (list (- (car BTR) (* 13 H)) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (* 23.5 H)) (+ (cadr BTR) (* -1.2 H)))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4)))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL))))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL))))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB1) (cons 10 BT1))))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB2) (cons 10 BT2))))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H))
(cons 1 "%&#11;&#182;ng T&#228;a &#174;&#233; &#174;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 "&#167;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 "X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 "Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt " OK Man!"))))));if END TABLE
(while
(progn
(initget 128 "u")
(setq TD0 (getpoint (strcat "\n Pick diem thu "(rtos (setq k (1+ k)) 2 0) " : ")))
(if (= TD0 "u") (vl-cmdf "undo" "Back") TD0))
(if (/= TD0 "u") (progn
(vl-cmdf "undo" "mark")
(princ TD0)
(setq X (rtos (cadr TD0) 2 3) Y (rtos (car TD0) 2 3))
(if (= (nth 1 TD-value) "1")
(progn ;put into table
(setq STTBTD (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK)
);progn
);if END put into table
(if (= (nth 0 TD-value) "1")
(progn
(setq SSnode (ssadd))
(setq PTX (polar TD0 0 (* H 0.7))
PTY (polar PTX (* pi -0.5) (* H 1.35)))
(entmake (list '(0 . "TEXT") (cons 10 PTX) (cons 11 PTX) (cons 40 H) (cons 1 (strcat "X:"X)) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 1)))
(setq TB (textbox (entget(entlast)))
DIX (distance (car TB) (cadr TB))
PTL (polar PTX 0 (+ DIX (* 0.12 H))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTY) (cons 40 H) (cons 1 (strcat "Y:"Y)) (cons 7 (nth 2 TD-value)) '(72 . 0)))
(setq TB (textbox (entget(entlast))))
(if (< DIX (setq DIY (distance (car TB) (cadr TB))))
(setq PTL (polar PTX 0 (+ DIY (* 0.12 H)))))
(setq SSnode (ssadd (entlast) SSnode))
(setq EPL (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 3) (cons 10 TD0) (cons 10 (polar TD0 0 (* 0.000000001 H))) (cons 10 PTL))))
(setq SSnode (ssadd EPL SSnode))
(if (/= (strcat (nth 4 TD-value) (nth 5 TD-value)) "")
(progn
(setq PTE (polar PTL 0 (+ (* 0.11 Wh) (* 1.5 H))))
(setq name (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
(cons 10 PTE) (cons 11 (list (+ (* 0.11 Wh) (* 1.5 H)) 0 0)) (cons 40 (- 0.75 (if (= 0 Wh) 0 0.06)))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
'(62 . 8) (cons 10 PTE) (cons 11 (list (+ (* 0.1 Wh) (* 1.4 H)) 0 0)) (cons 40 (- 0.74 (if (= 0 Wh) 0 0.06)))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTE) (cons 11 PTE) (cons 40 H)
(cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))))
(ACET-SS-REDRAW SSnode 2)
(if (not (setq PT1 (ACET-SS-DRAG-MOVE SSnode TD0 "" nil 0)))
(Setq PT1 TD0)
(setq del (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 PT1)))))
(vl-cmdf "move" SSnode "" TD0 PT1)
(ACET-SS-REDRAW SSnode 2)
(if (not (setq ANG (ACET-SS-DRAG-ROTATE SSnode PT1 "" nil 0)))
(if (< (* 0.5 pi) (angle PT1 (cadr (grread 't 15 0))) (* 1.5 pi)) (setq ANG pi) (setq ANG 0)))
(vl-cmdf "erase" del "")
(vl-cmdf "rotate" SSnode "" PT1 (rtos (angle-r2d ANG) 2 2))
(setq SSnode (acet-ss-to-list SSnode))
(if (< (* 0.5 pi) ANG (* 1.5 pi))
(foreach SSn SSnode (if (= (DXF 0 SSn) "TEXT") (rotate-text SSn pi))))
(setq EgPL (entget EPL) EgPL (subst (cons 10 TD0) (assoc 10 EgPL) EgPL))
(entmod EgPL) (entupd EPL)
);progn
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(progn (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.09) COL 90 T nil 0)
(grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.2) COL 45 T nil 0)))
))
(progn
(setq k (- k 2)
BTX (polar BTX (* 0.5 pi) (* 2 H))
BTY (polar BTY (* 0.5 pi) (* 2 H))
BTT (polar BTT (* 0.5 pi) (* 2 H))
BB1 (polar BB1 (* 0.5 pi) (* 2 H))
BB2 (polar BB2 (* 0.5 pi) (* 2 H))
BR (polar BR (* 0.5 pi) (* 2 H))
BL (polar BL (* 0.5 pi) (* 2 H))
VBR (polar VBR (* 0.5 pi) (* 2 H))
VBL (polar VBL (* 0.5 pi) (* 2 H))))
);if
);while
(prompt "Done\n \U+2022 Statistical coordinates data record - Copyright\U+00A9 2010 Thaistreetz")
(setq TD-value (ACET-LIST-PUT-NTH (rtos k 2 0) TD-value 5)))
;=== Xuat bang toa do coc tu binh do tuyen
(progn
(if (setq SSC (acet-ss-to-list (ssget '((0 . "LINE") (8 . "ENTCOC")))))
(progn
(setq BTR (cadr (grread 't 15 0))
BTL (polar BTR 0 (- (* H -26) Wh))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
PTitle (list (- (car BTR) (+ (* 0.5 Wh) (* 13 H))) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (+ (* 0.5 Wh) (* 23.5 H))) (+ (cadr BTR) (* -1.2 H)))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(setq SSnode (ssadd))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL)))
SSnode (ssadd (entlast) SSnode))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL)))
SSnode (ssadd (entlast) SSnode))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1)))
SSnode (ssadd (entlast) SSnode))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2)))
SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%&#11;&#182;ng T&#228;a &#174;&#233; c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "T&#170;n c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt "OK Man! ")
(setq SSC (vl-sort SSC '(lambda (EN1 EN2) (< (atof (lytrinh EN1)) (atof (lytrinh EN2))))))
(foreach SSn SSC
(setq TD0 (acet-geom-midpoint (DXF 10 SSn) (DXF 11 SSn))
X (rtos (car TD0) 2 3)
Y (rtos (cadr TD0) 2 3)
STTBTD (tencoc SSn))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq SSnode (ssadd (entlast) SSnode))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK))
(acet-ss-redraw SSnode 2)
(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
(if (setq PT1 (acet-ss-drag-move SSnode BTR "Chon diem dat bang toa do..."))
(vl-cmdf "move" SSnode "" BTR PT1)
(vl-cmdf "erase" SSnode ""))
(setvar "orthomode" OTHLAST)
);progn
));if End Xuat bang toa do coc tu binh do
);if
(command "UCS" "P")
(command "undo" "end")
(princ)
);end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Cập nhật 23:15 .Ps: mình nhầm, nếu đặt tên điểm quá 3 chữ là bị, cái này mình hem pit sữa :D, bạn xem như mình spam đi^^
<<

Filename: 225095_ttd.lsp
Tác giả: leem
Bài viết gốc: 225147
Tên lệnh: le01 le02
lisp chuyển layer.


Lệnh le01 dùng để chuyển tất cả các đối tượng thuộc layer: KT-TRUC sang KC-TRUC.
Tạo hàm con: chla với 2 biến a và b, các anh chị sửa lại dùm em, vì sao le02 nó không hiểu a và b là 2 chuỗi vậy?
Chân thành cám ơn!

Filename: 225147_le01_le02.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 225168
Tên lệnh: le02
lisp chuyển layer.
Nãy mới để ý đến hàm cons mà quên hàm list. Nên sửa thế này

Filename: 225168_le02.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225104
Tên lệnh: nt2
Text cao độ của bình đồ bị tách làm nhiều đối tượng
bạn dùng lsp hỗ trợ xem thế lào, nhoc sưu tầm đc ^^, có 2 lsp
lsp 1 nối text trước vào text sau để thành số thập phân, xóa text sau

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT ( / SSET HND LAY OBJ)
(setq hnd (car (entsel "\nDS> Phan nguyen : ")))
(setq e (entget hnd))
(setq text1 (cdr (assoc 1 e)))
(setq hnd2 (car (entsel "\nDS> Phan thap phan...
>>
bạn dùng lsp hỗ trợ xem thế lào, nhoc sưu tầm đc ^^, có 2 lsp
lsp 1 nối text trước vào text sau để thành số thập phân, xóa text sau

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT ( / SSET HND LAY OBJ)
(setq hnd (car (entsel "\nDS> Phan nguyen : ")))
(setq e (entget hnd))
(setq text1 (cdr (assoc 1 e)))
(setq hnd2 (car (entsel "\nDS> Phan thap phan : ")))
(setq text2 (cdr (assoc 1 (entget hnd2))))
(setq chunoi (strcat text1 "." text2))
(command "ERASE" hnd2 "")
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(princ)
);;end defun

lsp 2 nối text trước vào text sau để thành số thập phân, xóa text trước

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT2 ( / SSET HND LAY OBJ)
(setq hnd1 (car (entsel "\nDS> Phan nguyen : ")))
(setq text1 (cdr (assoc 1 (setq e1 (entget hnd1)))))
(setq hnd2 (car (entsel "\nDS> Phan thap phan : ")))
(setq text2 (cdr (assoc 1 (setq e2 (entget hnd2)))))
(setq chunoi (strcat text1 "." text2))
(command "ERASE" hnd1 "")
(entmod (subst (cons 1 chunoi) (assoc 1 e2) e2))
(princ))

Có gì ko hỉu cách xài, bạn cứ pm, nhoc ko pit sẽ có mấy huynh khác hỗ trợ ^^
<<

Filename: 225104_nt2.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225104
Tên lệnh: nt
Text cao độ của bình đồ bị tách làm nhiều đối tượng

bạn dùng lsp hỗ trợ xem thế lào, nhoc sưu tầm đc ^^, có 2 lsp
lsp 1 nối text trước vào text sau để thành số thập phân, xóa text sau

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT ( / SSET HND LAY OBJ)
(setq hnd (car (entsel "\nDS> Phan nguyen : ")))
(setq e (entget hnd))
(setq text1 (cdr (assoc 1 e)))
(setq hnd2 (car (entsel "\nDS> Phan thap phan...
>>
bạn dùng lsp hỗ trợ xem thế lào, nhoc sưu tầm đc ^^, có 2 lsp
lsp 1 nối text trước vào text sau để thành số thập phân, xóa text sau

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT ( / SSET HND LAY OBJ)
(setq hnd (car (entsel "\nDS> Phan nguyen : ")))
(setq e (entget hnd))
(setq text1 (cdr (assoc 1 e)))
(setq hnd2 (car (entsel "\nDS> Phan thap phan : ")))
(setq text2 (cdr (assoc 1 (entget hnd2))))
(setq chunoi (strcat text1 "." text2))
(command "ERASE" hnd2 "")
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(princ)
);;end defun

lsp 2 nối text trước vào text sau để thành số thập phân, xóa text trước

(prompt "\n NT : Lisp noi phan nguyen va phan thap phan cua text cao do")
(defun c:NT2 ( / SSET HND LAY OBJ)
(setq hnd1 (car (entsel "\nDS> Phan nguyen : ")))
(setq text1 (cdr (assoc 1 (setq e1 (entget hnd1)))))
(setq hnd2 (car (entsel "\nDS> Phan thap phan : ")))
(setq text2 (cdr (assoc 1 (setq e2 (entget hnd2)))))
(setq chunoi (strcat text1 "." text2))
(command "ERASE" hnd1 "")
(entmod (subst (cons 1 chunoi) (assoc 1 e2) e2))
(princ))

Có gì ko hỉu cách xài, bạn cứ pm, nhoc ko pit sẽ có mấy huynh khác hỗ trợ ^^
<<

Filename: 225104_nt.lsp
Tác giả: quansla
Bài viết gốc: 225226
Tên lệnh: tinhtong
[YÊU CẦU] Lisp đo tổng khoảng cách AB + CD nằm trên 2 đường Pline khác nhau

(defun c:tinhtong (/ L p1 p2 ll s1 olay)
(vl-load-com)
(setq olay (getvar "clayer"))
(setvar "clayer" "defpoints")
(setvar "cmdecho" 0)
(setq p1 (getpoint "chon diem")
L 0
ll (list p1))
(while (setq p2 (getpoint p1 "chon diem"))
(setq L ( + L (distance p1 p2)))
(setq ll (append ll (list p2)))
(setq p1 p2))
(acet-pline-make (list ll))
>>

(defun c:tinhtong (/ L p1 p2 ll s1 olay)
(vl-load-com)
(setq olay (getvar "clayer"))
(setvar "clayer" "defpoints")
(setvar "cmdecho" 0)
(setq p1 (getpoint "chon diem")
L 0
ll (list p1))
(while (setq p2 (getpoint p1 "chon diem"))
(setq L ( + L (distance p1 p2)))
(setq ll (append ll (list p2)))
(setq p1 p2))
(acet-pline-make (list ll))
L
(entmod(subst (cons 1 (rtos L 2 2)) (assoc 1 (setq dt(entget(car(entsel "chontext"))))) dt))
(initget 1 "Y N")
(setq s1 (strcase(getkword "Co Xoa bo PL vua tao")))
(if (or (= s1 "")(= s1 "Y")) (entdel (entlast)))
(setvar "clayer" olay)
(setvar "cmdecho" 1)
)

Bạn có thể thử
<<

Filename: 225226_tinhtong.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225184
Tên lệnh: tdd
[ nhờ chỉnh sửa ] lisp pick tọa độ từ hệ tọa độ cad sang vn2000

(defun C:TDD (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN
B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK
PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME
EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH)
(command "style" "VnArial NarrowH" ".VnArial NarrowH" ""...
>>

(defun C:TDD (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN
B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK
PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME
EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH)
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(command "layer" "m" "QKHS" "c" "6" "" "")
(command "undo" "be")
(setvar "cmdecho" 0)

(command "undo" "begin")
(vl-load-com)
;======================= Defun ==========================
(defun rotate-text ( en ang / p1 p2 a e1)
(setq p1 (acet-geom-textbox (setq e1 (entget en)) 0)
p1 (acet-geom-midpoint (car p1) (caddr p1))
e1 (subst (cons 11 p1) (assoc 11 e1) e1)
a (cdr (assoc 50 e1))
a (+ ang a)
e1 (subst (cons 50 a) (assoc 50 e1) e1)
e1 (subst (cons 72 1) (assoc 72 e1) e1)
e1 (subst (cons 73 2) (assoc 73 e1) e1)
);setq
(entmod e1)
(entupd EN))
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun angle-d2r (ANGD) (if ANGD (/ (* pi ANGD) 180) nil))
(defun angle-r2d (ANGR) (if ANGR (/ (* 180 ANGR) pi) nil))
(defun grnode (point radius color ang node fomp hightlight / ANGi PT0 PT1 PTg COL)
(if fomp
(setq ANGi 0)
(setq ANGi (* 0.5 (angle-d2r ang))))
(if (= color 0) (setq COL 10) (setq COL color))
(setq PT0 (polar point ANGi radius) PTg PT0)
(if node (grdraw point PT0 color hightlight))
(while (<= ANGi (* 2 Pi))
(setq ANGi (+ ANGi (angle-d2r ang))
PT1 (polar point ANGi radius))
(if (= color 0) (setq COL (1+ COL)))
(if node (grdraw point PT0 COL hightlight) (grdraw PT0 PT1 COL hightlight))
(setq PT0 PT1)
);while
(if (not node) (grdraw PT0 PTg COL hightlight))
);end grnode
(defun tencoc (EN) (if (check-nova EN) (cdr (nth 7 (car(cdr (assoc -3 (entget EN '("*"))))))) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun check-nova (EN) (if (= (car(car(cdr (assoc -3 (entget EN '("*")))))) "TDNW") T nil))
(defun lytrinh (EN) (if (check-nova EN) (rtos (cdr (nth 5 (car(cdr (assoc -3 (entget EN '("*"))))))) 2 2) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun accept ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 0)) (done_dialog))
(defun nova ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 1)) (done_dialog))
(defun node ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "table" "1")))
(defun table ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "node" "1")))
(defun style (/ htxt htxt0)
(setq htxt0 (get_tile "height"))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth (fix (atof (get_tile "style"))) Lst-TS))))) 0)
(progn (set_tile "height" (rtos htxt 2 3)) (mode_tile "height" 1))
(progn (mode_tile "height" 0) (set_tile "height" htxt0))))
(defun baoloi (val key valkey)
(if (= "." (substr val 1 1)) (setq val (strcat "0" val)))
(if (not (or (= val "") (and (or (= (type (read val)) 'REAL) (= (type (read val)) 'INT)) (> (atof val) 0))))
(progn
(if (or (= key "height") (= key "start"))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so thuc duong"))
(ACET-SYS-SLEEP 120))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so nguyen duong"))
(ACET-SYS-SLEEP 120)))
(mode_tile key 2)
(mode_tile key 3)
);progn
(set_tile "err" (strcat "Statistical coordinates data record - \Toa do "))
);if
);end error
(if (not TD-value) (setq TD-value (list "1" "1" (getvar "textstyle") "2.00" "N" "1" 0)))
(setq DCL_CDn (list
"Coordinate : dialog { value = \"http://taybac.1talk.net - \<Thong ke Toa do>\"; key = \"err\";"
" : column { children_alignment = top;"
" : boxed_row { "
" : column {"
" : toggle { key = \"node\"; label = \"Chen diem\"; height = 1.4;}"
" : toggle { key = \"table\"; label = \"Chen bang\"; height = 2.5;}}"
" : column {"
" : popup_list { key = \"style\"; label = \"Text Style\"; edit_width = 10.1;}"
" : edit_box { key = \"height\"; label = \"Height Text\"; height = 1.1; edit_width = 11;}"
" : tile { label = \"-\"; alignment = centered;}} "
" : column {"
" : edit_box { key = \"name\"; label = \" Ten diem\"; height = 1.1; edit_width = 4;}"
" : edit_box { key = \"start\"; label = \" So bat dau\"; height = 1.1; edit_width = 4;}"
" : tile { label = \"-\"; alignment = centered;}} "
" } "
" : button { key = \"nova\"; label = \"Export Station coodinates from Road-Plan\";}"
" : row {"
" : button { key = \"cancel\"; label = \" Thoat \"; is_cancel = true;}"
" : button { key = \"accept\"; label = \" Bat dau \"; is_default = true;}}"
" }"
" }"
"helpTLuy : dialog { label = \"Help and Copyright\U+00A9 Information\";"
" : column {"
" : row { : list_box { key = \"helpList\"; edit_width = 95; width = 98; height = 25;}}"
" : row { : button { key = \"okayHelp\"; label = \"Okay\"; is_default = false; is_cancel = true;}}"
" }"
" }"
)
TEMP_CDn (vl-filename-mktemp "CDn.DCL")
FILE_DCL (open TEMP_CDn "W"))
(foreach LL DCL_CDn (write-line LL FILE_DCL))
(close FILE_DCL)
(setq DCL_ID (load_dialog TEMP_CDn))
(new_dialog "Coordinate" DCL_ID)
(set_tile "node" (nth 0 TD-value))
(set_tile "table" (nth 1 TD-value))
(set_tile "height" (nth 3 TD-value))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth 2 TD-value))))) 0)
(progn (set_tile "height" (rtos htxt 2 2)) (mode_tile "height" 1)))
(set_tile "name" (nth 4 TD-value))
(set_tile "start" (nth 5 TD-value))
(start_list "style")
(setq Lst-TS (list (nth 2 TD-value) (cdr (assoc 2 (tblnext "Style" T)))))
(while (setq TSN (tblnext "Style"))
(if (and (/= (cdr (assoc 2 TSN)) (nth 2 TD-value)) (/= (cdr (assoc 2 TSN)) ""))
(setq Lst-TS (append Lst-TS (list (cdr (assoc 2 TSN))))))
);while
(mapcar 'add_list Lst-TS)
(end_list)
(action_tile "cancel" "(exit)")
(action_tile "accept" "(accept)")
(action_tile "nova" "(nova)")
(action_tile "node" "(node)")
(action_tile "table" "(table)")
(action_tile "style" "(style)")
(action_tile "height" "(baoloi (get_tile \"height\") \"height\" \"''Cao chu''\")")
(action_tile "start" "(baoloi (get_tile \"start\") \"start\" \"''STT''\")")
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete TEMP_CDn)
(setq H (atof (nth 3 TD-value)))
(if (wcmatch (cdr (assoc 3 (tblsearch "style" (nth 2 TD-value)))) "*AVAN*,*ARIAL*,*BLACK*") (setq Wh (* 1.5 H)) (setq Wh 0))
(if (= (nth 6 TD-value) 0) (progn
(if (/= (nth 3 TD-value) "") (setq N (nth 3 TD-value)))
(command "UCS" "W")
(setvar "dimzin" 0)
(command "undo" "begin")
(if (= (nth 5 TD-value) "") (setq k 0) (setq k (- (atof (nth 5 TD-value)) 1)))
(if (= (nth 1 TD-value) "1") ; BEGIN TABLE
(progn (prompt "Chon diem dat bang toa do...")
(while
(if (= (car (setq GR (grread 't 15 0))) 5)
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(redraw)
(setq BTR (cadr GR)
BTL (polar BTR 0 (* H -26))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BBR (polar BTR (* 0.5 pi) (* H -11))
BBL (polar BTL (* 0.5 pi) (* H -11))
BB1 (polar BT1 (* 0.5 pi) (* H -11))
BB2 (polar BT2 (* 0.5 pi) (* H -11))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(grdraw BTL BTR COL 1)
(grdraw BTL BBL COL 1)
(grdraw BTR BBR COL 1)
(grdraw BT1 BB1 COL 1)
(grdraw BT2 BB2 COL 1)
(grdraw BR BL COL 1)
(repeat 3
(setq BR (polar BR (* 0.5 pi) (* H -2.0))
BL (polar BL (* 0.5 pi) (* H -2.0))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4)))
(grdraw BR BL COL 1)) T)
(progn
(setq PTitle (list (- (car BTR) (* 13 H)) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (* 23.5 H)) (+ (cadr BTR) (* -1.2 H)))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4)))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL))))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL))))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB1) (cons 10 BT1))))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB2) (cons 10 BT2))))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H))
(cons 1 "%%UB&#182;ng T&#228;a &#174;&#233; &#174;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 "&#167;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 "X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 "Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt " OK Man!"))))));if END TABLE
(while
(progn
(initget 128 "u")
(setq TD0 (getpoint (strcat "\n Pick diem thu "(rtos (setq k (1+ k)) 2 0) " : ")))
(if (= TD0 "u") (vl-cmdf "undo" "Back") TD0))
(if (/= TD0 "u") (progn
(vl-cmdf "undo" "mark")
(princ TD0)
(setq X (rtos (cadr TD0) 2 3) Y (rtos (car TD0) 2 3))
(if (= (nth 1 TD-value) "1")
(progn ;put into table
(setq STTBTD (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK)
);progn
);if END put into table
(if (= (nth 0 TD-value) "1")
(progn
(setq SSnode (ssadd))
(setq PTX (polar TD0 0 (* H 0.7))
PTY (polar PTX (* pi -0.5) (* H 1.35)))
(entmake (list '(0 . "TEXT") (cons 10 PTX) (cons 11 PTX) (cons 40 H) (cons 1 (strcat "X:"X)) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 1)))
(setq TB (textbox (entget(entlast)))
DIX (distance (car TB) (cadr TB))
PTL (polar PTX 0 (+ DIX (* 3.0 H))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTY) (cons 40 H) (cons 1 (strcat "Y:"Y)) (cons 7 (nth 2 TD-value)) '(72 . 0)))
(setq TB (textbox (entget(entlast))))
(if (< DIX (setq DIY (distance (car TB) (cadr TB))))
(setq PTL (polar PTX 0 (+ DIY (* 0.12 H)))))
(setq SSnode (ssadd (entlast) SSnode))
(setq EPL (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 3) (cons 10 TD0) (cons 10 (polar TD0 0 (* 0.000000001 H))) (cons 10 PTL))))
(setq SSnode (ssadd EPL SSnode))
(if (/= (strcat (nth 4 TD-value) (nth 5 TD-value)) "")
(progn
(setq PTE (polar PTL 0 (+ (* 0.11 Wh) (* 1.5 H))))
(setq name (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
(cons 10 PTE) (cons 11 (list (+ (* 0.25 Wh) (* 2.2 H)) 0 0)) (cons 40 (- 0.75 (if (= 0 Wh) 0 0.01)))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
'(62 . 8) (cons 10 PTE) (cons 11 (list (+ (* 0.22 Wh) (* 1.9 H)) 0 0)) (cons 40 (- 0.74 (if (= 0 Wh) 0 0.01)))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTE) (cons 11 PTE) (cons 40 H)
(cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))))
(ACET-SS-REDRAW SSnode 2)
(if (not (setq PT1 (ACET-SS-DRAG-MOVE SSnode TD0 "" nil 0)))
(Setq PT1 TD0)
(setq del (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 PT1)))))
(vl-cmdf "move" SSnode "" TD0 PT1)
(ACET-SS-REDRAW SSnode 2)
(if (not (setq ANG (ACET-SS-DRAG-ROTATE SSnode PT1 "" nil 0)))
(if (< (* 0.5 pi) (angle PT1 (cadr (grread 't 15 0))) (* 1.5 pi)) (setq ANG pi) (setq ANG 0)))
(vl-cmdf "erase" del "")
(vl-cmdf "rotate" SSnode "" PT1 (rtos (angle-r2d ANG) 2 2))
(setq SSnode (acet-ss-to-list SSnode))
(if (< (* 0.5 pi) ANG (* 1.5 pi))
(foreach SSn SSnode (if (= (DXF 0 SSn) "TEXT") (rotate-text SSn pi))))
(setq EgPL (entget EPL) EgPL (subst (cons 10 TD0) (assoc 10 EgPL) EgPL))
(entmod EgPL) (entupd EPL)
);progn
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(progn (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.09) COL 90 T nil 0)
(grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.2) COL 45 T nil 0)))
))
(progn
(setq k (- k 2)
BTX (polar BTX (* 0.5 pi) (* 2 H))
BTY (polar BTY (* 0.5 pi) (* 2 H))
BTT (polar BTT (* 0.5 pi) (* 2 H))
BB1 (polar BB1 (* 0.5 pi) (* 2 H))
BB2 (polar BB2 (* 0.5 pi) (* 2 H))
BR (polar BR (* 0.5 pi) (* 2 H))
BL (polar BL (* 0.5 pi) (* 2 H))
VBR (polar VBR (* 0.5 pi) (* 2 H))
VBL (polar VBL (* 0.5 pi) (* 2 H))))
);if
);while
(prompt "Done\n \U+2022 Statistical coordinates data record - Copyright\U+00A9 2010 Thaistreetz")
(setq TD-value (ACET-LIST-PUT-NTH (rtos k 2 0) TD-value 5)))
;=== Xuat bang toa do coc tu binh do tuyen
(progn
(if (setq SSC (acet-ss-to-list (ssget '((0 . "LINE") (8 . "ENTCOC")))))
(progn
(setq BTR (cadr (grread 't 15 0))
BTL (polar BTR 0 (- (* H -26) Wh))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
PTitle (list (- (car BTR) (+ (* 0.5 Wh) (* 13 H))) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (+ (* 0.5 Wh) (* 23.5 H))) (+ (cadr BTR) (* -1.2 H)))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(setq SSnode (ssadd))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL)))
SSnode (ssadd (entlast) SSnode))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL)))
SSnode (ssadd (entlast) SSnode))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1)))
SSnode (ssadd (entlast) SSnode))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2)))
SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%%UB&#182;ng T&#228;a &#174;&#233; c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "T&#170;n c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt "OK Man! ")
(setq SSC (vl-sort SSC '(lambda (EN1 EN2) (< (atof (lytrinh EN1)) (atof (lytrinh EN2))))))
(foreach SSn SSC
(setq TD0 (acet-geom-midpoint (DXF 10 SSn) (DXF 11 SSn))
X (rtos (car TD0) 2 3)
Y (rtos (cadr TD0) 2 3)
STTBTD (tencoc SSn))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq SSnode (ssadd (entlast) SSnode))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK))
(acet-ss-redraw SSnode 2)
(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
(if (setq PT1 (acet-ss-drag-move SSnode BTR "Chon diem dat bang toa do..."))
(vl-cmdf "move" SSnode "" BTR PT1)
(vl-cmdf "erase" SSnode ""))
(setvar "orthomode" OTHLAST)
);progn
));if End Xuat bang toa do coc tu binh do
);if
(command "UCS" "P")
(command "undo" "end")
(princ)
);end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

<<

Filename: 225184_tdd.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225383
Tên lệnh: tdd
Lisp thống kê tọa độ địa chính
Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&st=40
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun Wdis (p1 p2 / dis ang point)
...
>>
Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&st=40
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun Wdis (p1 p2 / dis ang point)
(setq dis (distance p1 p2))
(setq ang (angle p1 p2))
(if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
(progn
(setq ang (+ Ang Pi))
(setq Point (polar p2 ang (/ dis 2.0)))
)
(setq Point (polar p1 ang (/ dis 2.0)))
)
(command "Text" "S" "vaptimn" "c" point (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 ca))
)
(defun ssgetLayer( La1 La2 / ss)
(setq ss (ssget "X" (list
(cons -4 "<OR")
(cons -4 "<AND")
(cons 8 La1)
(cons 0 "LWPOLYLINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La1)
(cons 0 "LINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La2)
(cons 0 "LWPOLYLINE")
(cons -4 "AND>")
(cons -4 "<AND")
(cons 8 La2)
(cons 0 "LINE")
(cons -4 "AND>")
(cons -4 "OR>")
)
))
ss
)
(defun pointpl (name tM k / namem i bien t1 p1 diem)
(setq namem name)
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc tM namem))
(setq t1 (member bien namem))
(setq p1 (car t1))
(setq namem (cdr t1))
(setq diem (cdr p1))
(setq i (+ 1 i))
)
)
diem
)
(defun c:tdd( / i k luuxy p xoa)
(setvar "cmdecho" 0)
(progn
(if (null (tblsearch "style" "vaptimn"))
(command "_style" "vaptimn" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "style" "vhelveb"))
(command "_style" "vhelveb" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "layer" "sohieu_diem"))
(command "_layer" "n" "sohieu_diem" ""))
(command "_layer" "c" "2" "sohieu_diem" "")
(if (null (tblsearch "layer" "bang_toado"))
(command "_layer" "n" "bang_toado" ""))
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "6" "thua" "")
(command "_layer" "c" "6" "100" "")
(setq r1 (getvar "USERI1"))
(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
(setq tdo (getint "\nNhap do chinh xac toado:"))
(setq ca (getint "\nNhap do chinh xac canh:"))
(if (= TileBdHT nil)
(setq TileBdHT r1))
(setvar "USERR1" TileBdHT)
(setvar "blipmode" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Pick"))
(if (/= p nil)
(command "-Boundary" "a" "b" "n" "" "" p "" )
)
(setq luuxy (entget (entlast)))
(setq p (getpoint "\n Diem dat bang toa do :"))
(entdel (entlast))
(setq k (cdr (assoc 90 luuxy)))
(if (/= p nil)
(progn
(setq p01 p)
(setq p02 (mapcar '+ p '(10.0 0.0 0.0)))
(setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))
(setq p04 (mapcar '+ p '(35.0 0.0 0.0)))
(setq p05 (mapcar '+ p '(45.0 0.0 0.0)))
(setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))
(setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))
(setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))
(setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))
(if (<= k 10)
(progn
(setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))
(setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))
(setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))
(setq p13 (mapcar '+ p '(35.0 -40.0 0.0)))
(setq p14 (mapcar '+ p '(45.0 -40.0 0.0)))
)
(progn
(setq ty (* -1 (+ 10.0 (* k 3))))
(setq t0 (list 0.0 ty 0.0))
(setq t1 (list 10.0 ty 0.0))
(setq t2 (list 22.5 ty 0.0))
(setq t3 (list 35.0 ty 0.0))
(setq t4 (list 45.0 ty 0.0))
(setq p10 (mapcar '+ p t0))
(setq p11 (mapcar '+ p t1))
(setq p12 (mapcar '+ p t2))
(setq p13 (mapcar '+ p t3))
(setq p14 (mapcar '+ p t4))
)
)
(command "layer" "s" "bang_toado" "")
(command "Line" p01 p05 "")
(command "Line" p01 p10 "")
(command "Line" p02 p11 "")
(command "Line" p03 p12 "")
(command "Line" p04 p13 "")
(command "Line" p05 p14 "")
(command "Line" p07 p08 "")
(command "Line" p06 p09 "")
(command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 2.0 0.0)) 1.25 0 "B&#182;NG LI&#214;T K&#163; T&#228;A &#167;&#233; G&#227;C RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "S&#232; hi&#214;u &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "T&#170;n &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "T&#228;a &#174;&#233;")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.25 0 "C&#185;nh")
)
)
(setq i 1)
(while (<= i k)
(progn
(setq toado (pointpl luuxy 10 i))
(setq x (rtos (car toado) 2 tdo))
(setq y (rtos (cadr toado) 2 tdo))
(command "layer" "s" "sohieu_diem" "")
(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
(command "Text" "S" "vaptimn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
(command "donut" "0.0" (* 0.25 (/ TileBdHT 500)) toado "")
(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
(setq psh (mapcar '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p tgc))
(if (= i 1)
(progn
(setq toado1 toado)
(setq x1 (rtos (car toado1) 2 tdo))
(setq y1 (rtos (cadr toado1) 2 tdo))
)
)
(if (>= i 2)
(progn
(setq canh (distance toado0 toado))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 ca) )
(command "layer" "s" "sohieu_diem" "")
(wdis toado0 toado)
)
)
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 i)
(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y)
(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x)
(setq toado0 toado)
(setq i (+ i 1))
)
)
(command "layer" "s" "sohieu_diem" "")
(wdis toado toado1)
(setq canh (distance toado toado1))
(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
(setq psh (mapcar '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p tgc))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 ca) )
(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 "1")
(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y1)
(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x1)
(setvar "osmode" old)
) ;(end progn)
;(end if)
)


<<

Filename: 225383_tdd.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 225390
Tên lệnh: mm
Căn lề text + Mtext, Căn lề đối tượng

Hề hề hề,
Sorry vì mình không kiểm tra kỹ khi hướng dẫn bạn bổ sung code. Bạn hãy chép lại lisp dưới đây và so sánh để thấy dược lỗi và rút kinh nghiệm nhé.
Tuy nhiên do cách tư duy của người viết lisp nên lisp này sẽ chạy khá chậm và rất dễ gây nhầm lẫn khi trên bản vẽ của bạn có nhiều đường mặt đất trùng lặp.
Việc lisp bạn sửa bị lỗi là do khi tạo hai...
>>

Hề hề hề,
Sorry vì mình không kiểm tra kỹ khi hướng dẫn bạn bổ sung code. Bạn hãy chép lại lisp dưới đây và so sánh để thấy dược lỗi và rút kinh nghiệm nhé.
Tuy nhiên do cách tư duy của người viết lisp nên lisp này sẽ chạy khá chậm và rất dễ gây nhầm lẫn khi trên bản vẽ của bạn có nhiều đường mặt đất trùng lặp.
Việc lisp bạn sửa bị lỗi là do khi tạo hai vòng lặp lồng nhau mình đã quên trả biến về giá trị ban đầu.


Về việc bổ sung thêm vào lisp này thì mình thấy nó không nên do hạn chế của lisp. Hơn nữa cách làm này không thực tạo ra hứng thú với mình. Do vậy nếu bạn vẫn muốn sửa để dùng thì mình gợi ý bạn như sau:
1/- tạo một tập chọn gồ tất cả các line trong cụm.
2/- lặp qua các line này để lấy được các cụm text line riên biệt.
3/- Với mỗi cụm sử dụng lisp hiện có để move nó về điểm tương ứng. Điểm này được lấy tương ứng với các điểm giao có được từ lisp và offset nó theo khoảng cách bạn nhập vào.

bạn hãy thử làm, nếu vướng mắc mình sẽ giúp thêm.
Chúc bạn vui.
<<

Filename: 225390_mm.lsp
Tác giả: Chiron
Bài viết gốc: 225418
Tên lệnh: test
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Nó đây bác:

(defun make_text (txt_pt txt_val)
(entmake (list '(0 . "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 10 txt_pt)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 txt_val)
'(50 . 0.0)
(assoc 41 (tblsearch "Style" (getvar "textstyle")))
'(51 . 0.0)
(cons 7 (getvar "TEXTSTYLE"))
'(71...
>>
Nó đây bác:

(defun make_text (txt_pt txt_val)
(entmake (list '(0 . "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 10 txt_pt)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 txt_val)
'(50 . 0.0)
(assoc 41 (tblsearch "Style" (getvar "textstyle")))
'(51 . 0.0)
(cons 7 (getvar "TEXTSTYLE"))
'(71 . 0)
'(72 . 0)
(cons 11 txt_pt)
'(73 . 0)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:test (/ *error* oldcmd tot_len TL Depth1 Len Hcc inspt txtdis)
(defun *error* (msg) (setvar "CMDECHO" oldcmd) (princ))
(setq oldcmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setq TL 0.0
Depth1 1.07
Dia 150.0
tot_len 10.0
Hcc (/ (+ 1 (fix tot_len)) 80)
IL1 (- TL Depth1)
IL2 (- IL1 Hcc)
Depth2 (+ Depth1 Hcc)
inspt (getpoint "\nChon diem chen text: ")
txtdis (* 1.5 (getvar "TEXTSIZE"))
)
(make_text inspt (strcat "\nTL " (rtos TL 2 2)))
(make_text (list (car inspt) (- (cadr inspt) txtdis)) (strcat "\nIL " (rtos IL2 2 2)))
(make_text (list (car inspt) (- (cadr inspt) (* txtdis 2.0))) (strcat "\n" (rtos Depth2 2 2) " (D)"))

(setvar "CMDECHO" oldcmd)
(princ)
)

Mình cắt bỏ các bước trung gian đi để dễ bắt bệnh, chỉ gửi cái khung xương lên. Mong các bác xem giúp.
<<

Filename: 225418_test.lsp
Tác giả: ssg
Bài viết gốc: 45857
Tên lệnh: tl tl
These gadgets are available in different designs and varieties ranging from very simple to extravagant. These units can be installed between the seats,

Lisp tính tổng chiều dài của mọi đối tượng có thuộc tính chiều dài (line, pline, spline, arc, circle, ellipse). Lệnh TL:


Filename: 45857_tl_tl.lsp
Tác giả: nhoclangbat
Bài viết gốc: 225480
Tên lệnh: tff
lisp pick tọa độ từ hệ tọa độ cad sang vn2000
Trước hết nhoc xin chân thành đa tạ pac Bình đã dìu dắt hướng dẫn thằng em nì ^^ tới tới .....:D, sau 1 đêm mày mò , hút hết 2 gói thuốc >> ngu người, cuối cùng nhoc cũng đã hoàn tất đc những gì pac Bình chỉ dạy. Cái nỳ để pac chắc mất 2 phút là xong, còn nhoc >> ko đếm nỗi >"<....
>>
Trước hết nhoc xin chân thành đa tạ pac Bình đã dìu dắt hướng dẫn thằng em nì ^^ tới tới .....:D, sau 1 đêm mày mò , hút hết 2 gói thuốc >> ngu người, cuối cùng nhoc cũng đã hoàn tất đc những gì pac Bình chỉ dạy. Cái nỳ để pac chắc mất 2 phút là xong, còn nhoc >> ko đếm nỗi >"<. Không dài dòng vô thẳng, pac Bình và bạn gaibo vô xem thử hàng nhé, trước khi xem nhoc xin đc show quá trình nhoc lên thiên đường, ah thật ra lên chưa tới đâu, đụng nóc mây thui, mà vậy là zui rùi ^^
Tấm đầu tiên, cái bầu này sắp sinh rùi bự lắm ^^
http://www.cadviet.com/upfiles/3/104473_11111111111.jpg

Tấm thứ 2, rừng già amazon nhé :)
http://www.cadviet.com/upfiles/3/104473_22222222222.jpg

Tấm cuối cùng, mẹ tròn con vuông, cây cối đã đc tỉa gọn gàng :D :D :D
http://www.cadviet.com/upfiles/3/104473_333333333333.jpg
Sau cùng là file lsp tạm gọi là chấp nhận đc ^^

(defun C:tff (/ tencoc check-nova lytrinh accept nova baoloi node table style DCL_CDN DCL_ID FILE_DCL HTXT TEMP_CDN TSN
B1 B2 BB1 BB2 BBL BBR BK BL BLI BR BRI BT1 BT2 BTL BTR BTT BTX BTY EB1 EB2 EBK
PT1 PTE PTITLE PTL PTX PTY TD0 X Y SSNODE STTBTD TB ANG COL DEL DIX DIY EGPL EPL GR H K LST-TS N NAME
EVK OV SSC VBL VBR VK VLI VRI VTL VTR WH)
(command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
(command "layer" "m" "QKHS" "c" "6" "" "")
(command "undo" "be")
(setvar "cmdecho" 0)

(command "undo" "begin")
(vl-load-com)
;======================= Defun ==========================
(defun rotate-text ( en ang / p1 p2 a e1)
(setq p1 (acet-geom-textbox (setq e1 (entget en)) 0)
p1 (acet-geom-midpoint (car p1) (caddr p1))
e1 (subst (cons 11 p1) (assoc 11 e1) e1)
a (cdr (assoc 50 e1))
a (+ ang a)
e1 (subst (cons 50 a) (assoc 50 e1) e1)
e1 (subst (cons 72 1) (assoc 72 e1) e1)
e1 (subst (cons 73 2) (assoc 73 e1) e1)
);setq
(entmod e1)
(entupd EN))
(defun DXF (code en) (cdr (assoc code (entget en))))
(defun angle-d2r (ANGD) (if ANGD (/ (* pi ANGD) 180) nil))
(defun angle-r2d (ANGR) (if ANGR (/ (* 180 ANGR) pi) nil))
(defun grnode (point radius color ang node fomp hightlight / ANGi PT0 PT1 PTg COL)
(if fomp
(setq ANGi 0)
(setq ANGi (* 0.5 (angle-d2r ang))))
(if (= color 0) (setq COL 10) (setq COL color))
(setq PT0 (polar point ANGi radius) PTg PT0)
(if node (grdraw point PT0 color hightlight))
(while (<= ANGi (* 2 Pi))
(setq ANGi (+ ANGi (angle-d2r ang))
PT1 (polar point ANGi radius))
(if (= color 0) (setq COL (1+ COL)))
(if node (grdraw point PT0 COL hightlight) (grdraw PT0 PT1 COL hightlight))
(setq PT0 PT1)
);while
(if (not node) (grdraw PT0 PTg COL hightlight))
);end grnode
(defun tencoc (EN) (if (check-nova EN) (cdr (nth 7 (car(cdr (assoc -3 (entget EN '("*"))))))) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun check-nova (EN) (if (= (car(car(cdr (assoc -3 (entget EN '("*")))))) "TDNW") T nil))
(defun lytrinh (EN) (if (check-nova EN) (rtos (cdr (nth 5 (car(cdr (assoc -3 (entget EN '("*"))))))) 2 2) (prompt "Doi tuong chon khong co du lieu tuyen")))
(defun accept ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 0)) (done_dialog))
(defun nova ()
(setq TD-value (list (get_tile "node") (get_tile "table") (nth (fix (atof (get_tile "style"))) Lst-TS)
(get_tile "height") (get_tile "name") (get_tile "start") 1)) (done_dialog))
(defun node ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "table" "1")))
(defun table ()
(if (and (= (get_tile "table") "0") (= (get_tile "node") "0")) (set_tile "node" "1")))
(defun style (/ htxt htxt0)
(setq htxt0 (get_tile "height"))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth (fix (atof (get_tile "style"))) Lst-TS))))) 0)
(progn (set_tile "height" (rtos htxt 2 3)) (mode_tile "height" 1))
(progn (mode_tile "height" 0) (set_tile "height" htxt0))))
(defun baoloi (val key valkey)
(if (= "." (substr val 1 1)) (setq val (strcat "0" val)))
(if (not (or (= val "") (and (or (= (type (read val)) 'REAL) (= (type (read val)) 'INT)) (> (atof val) 0))))
(progn
(if (or (= key "height") (= key "start"))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so thuc duong"))
(ACET-SYS-SLEEP 120))
(repeat 2
(set_tile "err" (strcat " "))
(ACET-SYS-SLEEP 70)
(set_tile "err" (strcat "Gia tri " valkey " phai la so nguyen duong"))
(ACET-SYS-SLEEP 120)))
(mode_tile key 2)
(mode_tile key 3)
);progn
(set_tile "err" (strcat "Statistical coordinates data record - \Toa do "))
);if
);end error
(if (not TD-value) (setq TD-value (list "1" "1" (getvar "textstyle") "2.00" "N" "1" 0)))
(setq DCL_CDn (list
"Coordinate : dialog { value = \"http://taybac.1talk.net - \<Thong ke Toa do>\"; key = \"err\";"
" : column { children_alignment = top;"
" : boxed_row { "
" : column {"
" : toggle { key = \"node\"; label = \"Chen diem\"; height = 1.4;}"
" : toggle { key = \"table\"; label = \"Chen bang\"; height = 2.5;}}"
" : column {"
" : popup_list { key = \"style\"; label = \"Text Style\"; edit_width = 10.1;}"
" : edit_box { key = \"height\"; label = \"Height Text\"; height = 1.1; edit_width = 11;}"
" : tile { label = \"-\"; alignment = centered;}} "
" : column {"
" : edit_box { key = \"name\"; label = \" Ten diem\"; height = 1.1; edit_width = 4;}"
" : edit_box { key = \"start\"; label = \" So bat dau\"; height = 1.1; edit_width = 4;}"
" : tile { label = \"-\"; alignment = centered;}} "
" } "
" : button { key = \"nova\"; label = \"Export Station coodinates from Road-Plan\";}"
" : row {"
" : button { key = \"cancel\"; label = \" Thoat \"; is_cancel = true;}"
" : button { key = \"accept\"; label = \" Bat dau \"; is_default = true;}}"
" }"
" }"
"helpTLuy : dialog { label = \"Help and Copyright\U+00A9 Information\";"
" : column {"
" : row { : list_box { key = \"helpList\"; edit_width = 95; width = 98; height = 25;}}"
" : row { : button { key = \"okayHelp\"; label = \"Okay\"; is_default = false; is_cancel = true;}}"
" }"
" }"
)
TEMP_CDn (vl-filename-mktemp "CDn.DCL")
FILE_DCL (open TEMP_CDn "W"))
(foreach LL DCL_CDn (write-line LL FILE_DCL))
(close FILE_DCL)
(setq DCL_ID (load_dialog TEMP_CDn))
(new_dialog "Coordinate" DCL_ID)
(set_tile "node" (nth 0 TD-value))
(set_tile "table" (nth 1 TD-value))
(set_tile "height" (nth 3 TD-value))
(if (/= (setq htxt (cdr (assoc 40 (tblsearch "style" (nth 2 TD-value))))) 0)
(progn (set_tile "height" (rtos htxt 2 2)) (mode_tile "height" 1)))
(set_tile "name" (nth 4 TD-value))
(set_tile "start" (nth 5 TD-value))
(start_list "style")
(setq Lst-TS (list (nth 2 TD-value) (cdr (assoc 2 (tblnext "Style" T)))))
(while (setq TSN (tblnext "Style"))
(if (and (/= (cdr (assoc 2 TSN)) (nth 2 TD-value)) (/= (cdr (assoc 2 TSN)) ""))
(setq Lst-TS (append Lst-TS (list (cdr (assoc 2 TSN))))))
);while
(mapcar 'add_list Lst-TS)
(end_list)
(action_tile "cancel" "(exit)")
(action_tile "accept" "(accept)")
(action_tile "nova" "(nova)")
(action_tile "node" "(node)")
(action_tile "table" "(table)")
(action_tile "style" "(style)")
(action_tile "height" "(baoloi (get_tile \"height\") \"height\" \"''Cao chu''\")")
(action_tile "start" "(baoloi (get_tile \"start\") \"start\" \"''STT''\")")
(start_dialog)
(unload_dialog DCL_ID)
(vl-file-delete TEMP_CDn)
(setq H (atof (nth 3 TD-value)))
(if (wcmatch (cdr (assoc 3 (tblsearch "style" (nth 2 TD-value)))) "*AVAN*,*ARIAL*,*BLACK*") (setq Wh (* 1.5 H)) (setq Wh 0))
(if (= (nth 6 TD-value) 0) (progn
(if (/= (nth 3 TD-value) "") (setq N (nth 3 TD-value)))
(command "UCS" "W")
(setvar "dimzin" 0)
(command "undo" "begin")
(if (= (nth 5 TD-value) "") (setq k 0) (setq k (- (atof (nth 5 TD-value)) 1)))
(if (= (nth 1 TD-value) "1") ; BEGIN TABLE
(progn (prompt "Chon diem dat bang toa do...")
(while
(if (= (car (setq GR (grread 't 15 0))) 5)
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(redraw)
(setq BTR (cadr GR)
BTL (polar BTR 0 (* H -26))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BBR (polar BTR (* 0.5 pi) (* H -11))
BBL (polar BTL (* 0.5 pi) (* H -11))
BB1 (polar BT1 (* 0.5 pi) (* H -11))
BB2 (polar BT2 (* 0.5 pi) (* H -11))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(grdraw BTL BTR COL 1)
(grdraw BTL BBL COL 1)
(grdraw BTR BBR COL 1)
(grdraw BT1 BB1 COL 1)
(grdraw BT2 BB2 COL 1)
(grdraw BR BL COL 1)
(repeat 3
(setq BR (polar BR (* 0.5 pi) (* H -2.0))
BL (polar BL (* 0.5 pi) (* H -2.0))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4)))
(grdraw BR BL COL 1)) T)
(progn
(setq PTitle (list (- (car BTR) (* 13 H)) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (* 23.5 H)) (+ (cadr BTR) (* -1.2 H)))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4)))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL))))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
(cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL))))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB1) (cons 10 BT1))))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 BB2) (cons 10 BT2))))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H))
(cons 1 "%&#11;&#182;ng T&#228;a &#174;&#233; &#174;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 "&#167;i&#211;m") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 "X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 "Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt " OK Man!"))))));if END TABLE
(while
(progn
(initget 128 "u")
(setq TD0 (getpoint (strcat "\n Pick diem thu "(rtos (setq k (1+ k)) 2 0) " : ")))
(if (= TD0 "u") (vl-cmdf "undo" "Back") TD0))
(if (/= TD0 "u") (progn
(vl-cmdf "undo" "mark")
(princ TD0)
(setq X (rtos (car TD0) 2 3) Y (rtos (cadr TD0) 2 3))
(if (= (nth 1 TD-value) "1")
(progn ;put into table
(setq STTBTD (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H))
(cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H))
(cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H))
(cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK)
);progn
);if END put into table
(if (= (nth 0 TD-value) "1")
(progn
(setq SSnode (ssadd))
(setq PTX (polar TD0 0 (* H 0.7))
PTY (polar PTX (* pi -0.5) (* H 1.35)))
(entmake (list '(0 . "TEXT") (cons 10 PTX) (cons 11 PTX) (cons 40 H) (cons 1 (strcat "X:"X)) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 1)))
(setq TB (textbox (entget(entlast)))
DIX (distance (car TB) (cadr TB))
PTL (polar PTX 0 (+ DIX (* 0.12 H))))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTY) (cons 40 H) (cons 1 (strcat "Y:"Y)) (cons 7 (nth 2 TD-value)) '(72 . 0)))
(setq TB (textbox (entget(entlast))))
(if (< DIX (setq DIY (distance (car TB) (cadr TB))))
(setq PTL (polar PTX 0 (+ DIY (* 0.12 H)))))
(setq SSnode (ssadd (entlast) SSnode))
(setq EPL (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 3) (cons 10 TD0) (cons 10 (polar TD0 0 (* 0.000000001 H))) (cons 10 PTL))))
(setq SSnode (ssadd EPL SSnode))
(if (/= (strcat (nth 4 TD-value) (nth 5 TD-value)) "")
(progn
(setq name (strcat (nth 4 TD-value) (rtos k 2 0)))
(entmake (list '(0 . "TEXT") (cons 10 PTL) (cons 11 (list (+ (car PTL) 0.65) (cadr PTL))) (cons 40 H)
(cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 2)))
(setq etext (entlast))
(setq len (abs (- (caar (textbox (list (assoc 1 (entget etext)) (assoc 40 (entget etext)) (assoc 50 (entget etext)))))
(caadr (textbox (list (assoc 1 (entget etext)) (assoc 40 (entget etext)) (assoc 50 (entget etext))))))))
(setq PTE (polar PTL 0 (/ len 1.7)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
(cons 10 PTE) (cons 11 (list (/ len 1.7) 0 0)) (cons 40 0.75)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
'(62 . 8) (cons 10 PTE) (cons 11 (list (/ len 1.8) 0 0)) (cons 40 0.75)))
(setq SSnode (ssadd (entlast) SSnode))))
(ACET-SS-REDRAW SSnode 2)
(if (not (setq PT1 (ACET-SS-DRAG-MOVE SSnode TD0 "" nil 0)))
(Setq PT1 TD0)
(setq del (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (cons 10 TD0) (cons 10 PT1)))))
(vl-cmdf "move" SSnode "" TD0 PT1)
(ACET-SS-REDRAW SSnode 2)
(if (not (setq ANG (ACET-SS-DRAG-ROTATE SSnode PT1 "" nil 0)))
(if (< (* 0.5 pi) (angle PT1 (cadr (grread 't 15 0))) (* 1.5 pi)) (setq ANG pi) (setq ANG 0)))
(vl-cmdf "erase" del "")
(vl-cmdf "rotate" SSnode "" PT1 (rtos (angle-r2d ANG) 2 2))
(setq SSnode (acet-ss-to-list SSnode))
(if (< (* 0.5 pi) ANG (* 1.5 pi))
(foreach SSn SSnode (if (= (DXF 0 SSn) "TEXT") (rotate-text SSn pi))))
(setq EgPL (entget EPL) EgPL (subst (cons 10 TD0) (assoc 10 EgPL) EgPL))
(entmod EgPL) (entupd EPL)
);progn
(progn
(if (or (not COL) (= 249 COL)) (setq COL 1) (setq COL (1+ COL)))
(progn (grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.09) COL 90 T nil 0)
(grnode TD0 (/ (ACET-GEOM-PIXEL-UNIT) 0.2) COL 45 T nil 0)))
))
(progn
(setq k (- k 2)
BTX (polar BTX (* 0.5 pi) (* 2 H))
BTY (polar BTY (* 0.5 pi) (* 2 H))
BTT (polar BTT (* 0.5 pi) (* 2 H))
BB1 (polar BB1 (* 0.5 pi) (* 2 H))
BB2 (polar BB2 (* 0.5 pi) (* 2 H))
BR (polar BR (* 0.5 pi) (* 2 H))
BL (polar BL (* 0.5 pi) (* 2 H))
VBR (polar VBR (* 0.5 pi) (* 2 H))
VBL (polar VBL (* 0.5 pi) (* 2 H))))
);if
);while
(prompt "Done\n \U+2022 Statistical coordinates data record - Copyright\U+00A9 2010 Thaistreetz")
(setq TD-value (ACET-LIST-PUT-NTH (rtos k 2 0) TD-value 5)))
;=== Xuat bang toa do coc tu binh do tuyen
(progn
(if (setq SSC (acet-ss-to-list (ssget '((0 . "LINE") (8 . "ENTCOC")))))
(progn
(setq BTR (cadr (grread 't 15 0))
BTL (polar BTR 0 (- (* H -26) Wh))
BT1 (polar BTR 0 (* H -21))
BT2 (polar BTR 0 (* H -10.5))
BB1 (polar BT1 (* 0.5 pi) (* H -2.4))
BB2 (polar BT2 (* 0.5 pi) (* H -2.4))
BR (polar BTR (* 0.5 pi) (* H -2.4))
BL (polar BTL (* 0.5 pi) (* H -2.4))
PTitle (list (- (car BTR) (+ (* 0.5 Wh) (* 13 H))) (+ (cadr BTR) (* 1.8 H)))
BTX (list (- (car BTR) (* 15.75 H)) (+ (cadr BTR) (* -1.2 H)))
BTY (list (- (car BTR) (* 5.25 H)) (+ (cadr BTR) (* -1.2 H)))
BTT (list (- (car BTR) (+ (* 0.5 Wh) (* 23.5 H))) (+ (cadr BTR) (* -1.2 H)))
OV (* H 0.3)
VTR (polar BTR (* 0.25 pi) OV)
VTL (polar BTL (* 0.75 pi) OV)
VBR (polar BR (* 1.75 pi) OV)
VBL (polar BL (* 1.25 pi) OV))
(setq SSnode (ssadd))
(setq VK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(62 . 8) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 VBR) (cons 10 VTR) (cons 10 VTL) (cons 10 VBL)))
SSnode (ssadd (entlast) SSnode))
(setq BK (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 BR) (cons 10 BTR) (cons 10 BTL) (cons 10 BL)))
SSnode (ssadd (entlast) SSnode))
(setq B1 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB1) (cons 10 BT1)))
SSnode (ssadd (entlast) SSnode))
(setq B2 (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BB2) (cons 10 BT2)))
SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 PTitle) (cons 11 PTitle) (cons 40 (* 1.2 H)) (cons 1 "%&#11;&#182;ng T&#228;a &#174;&#233; c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 "T&#170;n c&#228;c") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; X") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 "T&#228;a &#167;&#233; Y") (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2.2 H))
BTY (polar BTY (* -0.5 pi) (* 2.2 H))
BTT (polar BTT (* -0.5 pi) (* 2.2 H)))
(prompt "OK Man! ")
(setq SSC (vl-sort SSC '(lambda (EN1 EN2) (< (atof (lytrinh EN1)) (atof (lytrinh EN2))))))
(foreach SSn SSC
(setq TD0 (acet-geom-midpoint (DXF 10 SSn) (DXF 11 SSn))
X (rtos (car TD0) 2 3)
Y (rtos (cadr TD0) 2 3)
STTBTD (tencoc SSn))
(entmake (list '(0 . "TEXT") (cons 10 BTT) (cons 11 BTT) (cons 40 (* 1 H)) (cons 1 STTBTD) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTX) (cons 11 BTX) (cons 40 (* 1 H)) (cons 1 X) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "TEXT") (cons 10 BTY) (cons 11 BTY) (cons 40 (* 1 H)) (cons 1 Y) (cons 7 (nth 2 TD-value)) '(72 . 1) '(73 . 2)))
(setq SSnode (ssadd (entlast) SSnode))
(setq BTX (polar BTX (* -0.5 pi) (* 2 H))
BTY (polar BTY (* -0.5 pi) (* 2 H))
BTT (polar BTT (* -0.5 pi) (* 2 H)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) (cons 10 BR) (cons 10 BL)))
(setq SSnode (ssadd (entlast) SSnode))
(setq EB1 (entget B1) EB1 (subst (cons 10 (setq BB1 (polar BB1 (* -0.5 pi) (* 2 H)))) (assoc 10 EB1) EB1))
(entmod EB1) (entupd B1)
(setq EB2 (entget B2) EB2 (subst (cons 10 (setq BB2 (polar BB2 (* -0.5 pi) (* 2 H)))) (assoc 10 EB2) EB2))
(entmod EB2) (entupd B2)
(setq EBK (entget BK)
BRi (polar BR (* -0.5 pi) (* 2 H))
BLi (polar BL (* -0.5 pi) (* 2 H))
EBK (reverse (subst (cons 10 BRi) (assoc 10 EBK) EBK))
EBK (reverse (subst (cons 10 BLi) (assoc 10 EBK) EBK))
BR Bri BL BLi)
(entmod EBK) (entupd BK)
(setq EVK (entget VK)
VRi (polar VBR (* -0.5 pi) (* 2 H))
VLi (polar VBL (* -0.5 pi) (* 2 H))
EVK (reverse (subst (cons 10 VRi) (assoc 10 EVK) EVK))
EVK (reverse (subst (cons 10 VLi) (assoc 10 EVK) EVK))
VBR Vri VBL VLi)
(entmod EVK) (entupd VK))
(acet-ss-redraw SSnode 2)
(setq OTHLAST (getvar "orthomode")) (setvar "orthomode" 0)
(if (setq PT1 (acet-ss-drag-move SSnode BTR "Chon diem dat bang toa do..."))
(vl-cmdf "move" SSnode "" BTR PT1)
(vl-cmdf "erase" SSnode ""))
(setvar "orthomode" OTHLAST)
);progn
));if End Xuat bang toa do coc tu binh do
);if
(command "UCS" "P")
(command "undo" "end")
(princ)
);end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Ps: 1 lần nữa thanks anh Bình rất nhiều đã tận tình với nhoc, còn 1 cái nữa là nếu lên tới Nut 100000 thì nhìn nó ko còn cân so với elip nữa, nhưng nhoc hết sức sức rùi ^^ ko còn biết cân sao rứa, thò đc cái đầu qua thiên đường xem thế lào thui cũng mừng ^^
http://www.cadviet.com/upfiles/3/104473_44444444444.jpg
<<

Filename: 225480_tff.lsp
Tác giả: ThuyLinh313
Bài viết gốc: 225494
Tên lệnh: vd
[Thảo luận] - Kiểm soát lỗi (có thể) phát sinh khi người dùng nhấn Esc để thoát lệnh
Một ví dụ đơn giản cho Nhóc hiểu nhé.
Giả sử Nhóc viết 1 lệnh vẽ line bằng command trong đó có thay đổi các biến hệ thống OSMODE (tắt bắt điểm) và ORTHOMODE (tắt vẽ chế độ vẽ theo trục tọa độ). Khi đó Nhóc viết thế này:
(defun C:VD (/ lst *error* p p1)
(setq lst (start-defun '("OSMODE" "ORTHOMODE")))
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq...
>>
Một ví dụ đơn giản cho Nhóc hiểu nhé.
Giả sử Nhóc viết 1 lệnh vẽ line bằng command trong đó có thay đổi các biến hệ thống OSMODE (tắt bắt điểm) và ORTHOMODE (tắt vẽ chế độ vẽ theo trục tọa độ). Khi đó Nhóc viết thế này:
(defun C:VD (/ lst *error* p p1)
(setq lst (start-defun '("OSMODE" "ORTHOMODE")))
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq p (getpoint)) p1 (getpoint p))
(command "line" p p1"")
(done-defun lst));end vd
Giải thích:
- Việc lấy các giá trị ban đầu của các biến hệ thống OSMODE và ORTHOMODE do hàm start-defun đảm nhận và lưu giá trị vào biến lst
- Việc trả lại các giá trị ban đầu cho các biến trên sẽ do hàm done-defun đảm nhận khi kết thúc lệnh
- Nếu nhấn esc giữa chừng thì hàm con *error* (đã khai báo ben trong hàm start-defun) được gọi. nó sẽ thực hiện thao tác undo back về thời điểm trước khi gõ lệnh
* Về bản chất thì nó giống như cách ĐVH hướng dẫn nhóc, nhưng cách này gọn gàng hơn, sẽ khiến Nhóc đỡ cực hơn khi viết.
=================================================
PS: Thêm 1 chút cho các bạn chưa biết:
"Nếu có lỗi" như ĐVH nói thì TL chỉ biết 1 trường hợp duy nhất có thể sảy ra lỗi là do hàm *error* không được gọi khi nhấn Esc. Nguyên nhân do tại thời điểm nhấn Esc, Cad đang ở trạng thái Active command. (sự kiện vlr-commandWillStart). Như ở Mục 1 TL đã nói về hàm *error*, nó chỉ được gọi khi chạy lệnh lisp.
Vì vậy, nếu lỗi là do trường hợp này thì chỉ cần khắc phục như sau chứ không cần tìm cách khác: Nếu trong lisp có sử dụng command thì không nên cho hàm lisp vào trong command nữa. Như trong ví dụ trên thì không nên viết như thế này (command "Line" (getpoint) (getpoint) "")
Ngoài lỗi này thì TL chưa bao giờ gặp lỗi nào khác
<<

Filename: 225494_vd.lsp
Tác giả: tien2005
Bài viết gốc: 225685
Tên lệnh: ed
- Tự động bật - tắt chế độ gõ tiếng việt trong CAD
Mình xin phép lấy code của @ThuyLinh313 sửa lại các nội dung sau:
- Bổ sung thêm chuyển chế độ gõ Anh/Việt bằng phím ATL+Z
- Chuyển đúng bảng mã cho các text có font khác nhau (chỉ trong 1 lệnh ED của lisp, xem bài #30)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66851
;===========================================================;
; A U T...
>>
Mình xin phép lấy code của @ThuyLinh313 sửa lại các nội dung sau:
- Bổ sung thêm chuyển chế độ gõ Anh/Việt bằng phím ATL+Z
- Chuyển đúng bảng mã cho các text có font khác nhau (chỉ trong 1 lệnh ED của lisp, xem bài #30)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66851
;===========================================================;
; A U T O U N I K E Y C O N T R O L R O U T I N E ;
;===========================================================;
; ;
; Version 1.0 - 14/12/2012 ;
; - Support Auto change table code (Unicode, TCVN, VNI) ;
; - Support for Text & Mtext objects ;
; ;
; Version 2.0 - 15/12/2012 ;
; - Added Auto toggle (On/Off) Vietnamese keys ;
; - Added support for Dimension objects ;
; - fixed Check-font-code function ;
; ;
;===========================================================;
; Cadviet.com - Le Thuy Linh 313 - Tri Tue Viet.jsc ;
;===========================================================;
(vl-load-com)
;;; Go bo Reactor Auto-Unikey cu truoc khi load
(foreach x (cdar (vlr-reactors :vlr-sysvar-reactor))
(if (= (vlr-data x) "Auto-Unikey") (vlr-remove x)))
;;; Tao Reactor Auto-Unikey
(vlr-sysvar-reactor "Auto-Unikey" '((:vlr-sysvarchanged . callback-Unikey)))
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent)
(while(setq textedit (car (entsel "\nSelect object: ")))
(setq ent (cdr (assoc 0 (entget textedit))))
(if (wcmatch ent "*TEXT,DIMENSION")
(progn
(if(wcmatch ent "*TEXT")
(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))
)
(command "ddedit" textedit "")
)
)
)
(princ)
)
;;; Ham callback dieu khien bo go tieng viet
(defun callback-Unikey (reactor sysvar / code Crfont)
(if (= (car sysvar) "TEXTEDITOR") (progn(sendkeys "^+")(sendkeys "%{Z}")))
(if (> (getvar "TEXTEDITOR") 0)
(progn
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
(setq code (check-font-code Crfont))
(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))))))
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS,CALIBRI*") "UNICODE")
((wcmatch font ".VN*") "TCVN3")
((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))

<<

Filename: 225685_ed.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 225672
Tên lệnh: mla
Lisp tạo viewport từ khung chọn bên model.

Hề hề hề,

Không biết cái của đi chôm này có ưng ý bạn hay không, nếu nó dùng được thì chịu khó cám ơn ông chủ lisp thanhduan2407 nghen.
Lưu ý rằng lisp này xuất ra các viewports dạng file *.xps lưu tại đường dẫn do bạn chọn khi lisp hỏi địa chỉ lưu file chứ không phải tạo thêm các layout mới như bạn mong muốn. Điều này có lẽ thuận lợi hơn cho bạn khi xuất để in...
>>

Hề hề hề,

Không biết cái của đi chôm này có ưng ý bạn hay không, nếu nó dùng được thì chịu khó cám ơn ông chủ lisp thanhduan2407 nghen.
Lưu ý rằng lisp này xuất ra các viewports dạng file *.xps lưu tại đường dẫn do bạn chọn khi lisp hỏi địa chỉ lưu file chứ không phải tạo thêm các layout mới như bạn mong muốn. Điều này có lẽ thuận lợi hơn cho bạn khi xuất để in ấn. nếu muốn xuất thành các layout riêng có nhẽ không khó lắm nữa nhưng mình chưa rành về layout nên không thể hứa hẹn gì với bạn cả. Trước mắt theo ngu ý của mình thì dùng cái này còn ngon hơn layout nhiều vì vừa nặng bản vẽ lại vừa rất dễ toi khi người dùng không rành về layout.

Nếu nó chưa như ý thì cũng đừng phiền lòng và hãy post lên để có thể có người khác giúp bạn được.
Lisp đây hè:

Chúc bạn vui.

PS: Bạn lưu ý thêm rằng trong lisp có sử dụng hàm (alignspace ....) là một hàm có trong bộ Express tools. Vì thế có thể khi chạy lisp lần đầu tiên nó sẽ báo lỗi không có hàm này. Lý do là một số hàm của express tools không tự động load vào bản vẽ. Do vậy để an toàn trước khi sử dụng lisp này bạn cần phải gọi lệnh align space này ít nhất là một lần trong phiên làm việc với bản vẽ cần chạy lisp để CAD có thể nhận dạng hàm (alignspace .....) này. Để tìm hiểu kỹ hơn về hàm alignspace bạn cần mở thư mục express tools của CAD và tìm tới lisp này để hiểu nó.
cách chạy lisp bổ sung này y như cũ, chỉ có lưu ý thêm phải nhập tên của các layout mới được tạo ra.
Để tiết kiệm đất nên mình bổ sung luôn vào lisp cũ. nếu bạn đã down về rồi thì hãy down lại một lần nữa. Nên download, tránh copy - paste code vì rất có thể bị lỗi lisp do code box của diễn đàn có vấn đề mà mình không biết cách khắc phục.
<<

Filename: 225672_mla.lsp
Tác giả: phamngoctukts
Bài viết gốc: 225718
Tên lệnh: edt
- Tự động bật - tắt chế độ gõ tiếng việt trong CAD
Mình thấy cái này hay hay nên edit chút để dùng được cho cad đời thấp. Do vội nên chưa test kỹ không biết có lỗi gì không.

PS: Mình nghĩ cái này có thể phát triển thêm dùng cho cả block attribute.

Filename: 225718_edt.lsp
Tác giả: ThuyLinh313
Bài viết gốc: 225778
Tên lệnh: ed
[Đã xong] - Tự động bật - tắt chế độ gõ tiếng việt trong CAD
Version 2.1: Tự động bật/Tắt chế độ gõ tiếng việt, tự động chuyển đổi bảng mã của Unikey khi chỉnh sửa hoặc tạo Text, Mtext, Dimension
- Sửa lệnh Ed để nhận diện các text cần sửa tiếp theo. (Cảm ơn bạn Tien2005 đã hỗ trợ thuật toán ^^)
- Update hỗ trợ thêm thao tác kick đúp để chỉnh sửa text.

;===============================================================;
; A U T O U N I...
>>
Version 2.1: Tự động bật/Tắt chế độ gõ tiếng việt, tự động chuyển đổi bảng mã của Unikey khi chỉnh sửa hoặc tạo Text, Mtext, Dimension
- Sửa lệnh Ed để nhận diện các text cần sửa tiếp theo. (Cảm ơn bạn Tien2005 đã hỗ trợ thuật toán ^^)
- Update hỗ trợ thêm thao tác kick đúp để chỉnh sửa text.

;===============================================================;
; A U T O U N I K E Y C O N T R O L R O U T I N E ;
;===============================================================;
; ;
; Version 1.0 - 14/12/2012 ;
; - Support Auto change table code (Unicode, TCVN, VNI) ;
; - Support for Text & Mtext objects ;
; ;
; Version 2.0 - 15/12/2012 ;
; - Added Auto toggle (On/Off) Vietnamese keys ;
; - Added support for Dimension objects ;
; - fixed Check-font-code function ;
; ;
; Version 2.1 - 22/01/2013 ;
; - Added support for Double click to edit *text ;
; - fixed ED command to select continues (thanks Tien2005) ;
; ;
;===============================================================;
; Cadviet.com - Le Thuy Linh 313 - Tri Tue Viet.jsc ;
;===============================================================;
(vl-load-com)
;;; Go bo Reactor Auto-Unikey cu truoc khi load
(foreach x (cdar (vlr-reactors :vlr-sysvar-reactor))
(if (= (vlr-data x) "Auto-Unikey") (vlr-remove x)))
(foreach x (cdar (vlr-reactors :vlr-mouse-reactor))
(if (= (vlr-data x) "Double-Click") (vlr-remove x)))
;;; Tao Reactor Auto-Unikey
(vlr-mouse-reactor "Double-Click" '((:vlr-beginDoubleClick . callback-DoubleClick)))
(vlr-sysvar-reactor "Auto-Unikey" '((:vlr-sysvarchanged . callback-Unikey)))
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent)
(and (or (and (setq textedit (ssget "I" '((0 . "*TEXT,DIMENSION"))))
(sssetfirst textedit)
(setq textedit (ssname textedit 0)))
(setq textedit (car (entsel))))
(while textedit
(setq ent (cdr (assoc 0 (entget textedit))))
(cond ((wcmatch ent "*TEXT")
(setq font (vla-get-stylename (vlax-ename->vla-object textedit))))
((= ent "DIMENSION")
(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))))
(command "ddedit" textedit "")
(setq textedit (car (entsel)))))
(princ))
;;; Ham callback dieu khien bo go tieng viet
(defun callback-Unikey (reactor sysvar / code Crfont)
(if (= (car sysvar) "TEXTEDITOR") (sendkeys "^+"))
(if (> (getvar "TEXTEDITOR") 0)
(progn
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
(setq code (check-font-code Crfont))
(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}")))
(setq font nil))))
;;; Ham callback lay textstyle khi Double Click vao text
(defun callback-DoubleClick (reactor point / sset obj ss)
(setq sset (vla-get-selectionsets (vla-get-activedocument (vlax-get-acad-object))))
(setq ss (vla-add sset "ThuyLinh313"))
(vla-selectatpoint ss (vlax-3d-point (car point)))
(if (> (vlax-get ss 'Count) 0)
(progn
(setq obj (vla-item ss 0))
(if (or (eq (vlax-get obj 'ObjectName) "AcDbText")
(eq (vlax-get obj 'ObjectName) "AcDbMText"))
(setq font (vla-get-stylename obj)))
(sssetfirst nil (ssadd (vlax-vla-object->ename obj)))))
(vla-delete ss))
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
((wcmatch font ".VN*") "TCVN3")
((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))

(Chú ý: cần thiết lập chế độ gõ tiếng anh mặc định khi sử dụng cad; Ứng dụng này tạm thời chỉ hỗ trợ cad 2009 trở lên)

Từ ý tưởng của bạn Phamngoctukts thì mình nảy sinh ý định viết ứng dụng này để hỗ trợ với tất cả các loại text trong bản vẽ: attribute, text trong khối block, rtext... Hi vọng sẽ làm được trong các version tiếp theo :D
<<

Filename: 225778_ed.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 225794
Tên lệnh: vd
[Thảo luận] - Kiểm soát lỗi (có thể) phát sinh khi người dùng nhấn Esc để thoát lệnh

Trong VD của mình Code nó chỉ là: thêm (repead 5000... ) và trong khi đang chạy mình nhấn esc xem sao, thì nó vậy.

Nhờ mọi người test giùm nhé!

Filename: 225794_vd.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 225829
Tên lệnh: vehoga vhga
[nhờ chỉnh sửa] lisp vẽ pline
mình đang viết lisp vẽ kích thước hố ga nhưng vướng 1 cái là vẽ các pline không được (nó chồng lên nhau hoặc khi được khi không) nhờ mọi người giúp đỡ cám ơn nhiều
đây là đoạn lisp

(defun c:vehoga ()
(setq p (getpoint "\nNhap diem ve:"))
(setq h 2.5);(distof cc))
(setq b 1.2);(distof cr))
(setq l 1.0);(distof cd))
(setq d 0.2);(distof dt))
(setq goc (/ pi 2))
(setq b1...
>>
mình đang viết lisp vẽ kích thước hố ga nhưng vướng 1 cái là vẽ các pline không được (nó chồng lên nhau hoặc khi được khi không) nhờ mọi người giúp đỡ cám ơn nhiều
đây là đoạn lisp

(defun c:vehoga ()
(setq p (getpoint "\nNhap diem ve:"))
(setq h 2.5);(distof cc))
(setq b 1.2);(distof cr))
(setq l 1.0);(distof cd))
(setq d 0.2);(distof dt))
(setq goc (/ pi 2))
(setq b1 (+ b (* 2 d)))
(setq h1 (- h d))
(setq goc1 (* 3 (/ pi 2)))
(setq p0 (polar p goc1 d))
(vethanhtrong)
(vethanhngoai)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vethanhtrong ()
(setq p1 (polar p 0 (/ b 2)))
(setq p2 (polar p1 goc h1))
(setq p3 (polar p pi (/ b 2)))
(setq p4 (polar p3 goc h1))
(command ".Pline" p2 p1 p3 p4 "")
(COMMAND ".PEDIT" "last" "W" "0" "")
)
(defun vethanhngoai ()
(setq p5 (polar p0 0 (/ b1 2)))
(setq p6 (polar p5 goc h))
(setq p7 (polar p0 pi (/ b1 2)))
(setq p8 (polar p7 goc h))
(command ".Pline" p6 p5 p7 p8 "")
(COMMAND ".PEDIT" "last" "W" "0" "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:vhga ()
(dodegoi))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dodegoi (/ COM)
(setq DCL_ID (load_dialog (strcat odiachay "\\tlkt\\dcl\\chon.DCL")))
(new_dialog "CONG" DCL_ID)
(if (not cc) (setq cc "0.00"))
(set_tile "cc" cc)
(if (not cr) (setq cr "0.00"))
(set_tile "cr" cr)
(if (not cd) (setq cd "0.00"))
(set_tile "cd" cd)
(if (not dt) (setq dt "0.00"))
(set_tile "dt" dt)
(action_tile "cc" "(setq cc $value) (KIEM_TRA_LOI)")
(action_tile "cr" "(setq cr $value) (KIEM_TRA_LOI)")
(action_tile "cd" "(setq cd $value) (KIEM_TRA_LOI)")
(action_tile "dt" "(setq dt $value) (KIEM_TRA_LOI)")
(action_tile "ve" "(done_dialog 1)")
(action_tile "thoat" "(done_dialog 14)")
(setq phepchon(start_dialog))
(cond
((= phepchon 1) (vehoga))

((= phepchon 14) (thoi))
)
(unload_dialog DCL_ID)
(princ))
(defun KIEM_TRA_LOI ()
(set_tile "error" "")
(if
(/= (type (distof cc)) 'real)
(progn
(set_tile "error" "Nhap lai chieu cao!")
(mode_tile "cc" 2)))
(if
(/= (type (distof cr)) 'real)
(progn
(set_tile "error" "Nhap lai chieu rong!")
(mode_tile "cr" 2)))
(if
(/= (type (distof cd)) 'real)
(progn
(set_tile "error" "Nhap lai chieu dai!")
(mode_tile "cd" 2)))
(if
(/= (type (distof dt)) 'real)
(progn
(set_tile "error" "Nhap lai day thanh!")
(mode_tile "dt" 2)))
)

<<

Filename: 225829_vehoga_vhga.lsp

Trang 116/330

116