Chuyển đến nội dung
Diễn đàn CADViet
gadibo

[ nhờ chỉnh sửa ] lisp pick tọa độ từ hệ tọa độ cad sang vn2000

Bởi gadibo , trong AutoLisp

Các bài được khuyến nghị

gadibo    2

gadibo
Đã đăng

Mình sưu tầm dc 1 cái lisp pick tọa độ rất hay nhưng nó có vài điểm chưa chuẩn so với công việc đang làm nên mạo muội post lên nhờ ace chỉnh sửa hộ :

1 ) lisp đang tính tọa độ theo hệ tọa độ của cad mà mình đang cần chuyển nó thành dạng vn2000 tức là X của cad thành Y của vn2000 - Y của cad thành X của vn200

2 ) cái elip bao quanh tên nút nó ko tự dộng co dãn theo chiều dài của text tên nút thành ra text nó đè lên elisp , nhờ ace sửa hộhttp://www.cadviet.c...16373_ttd_1.lsp

thank ACE !

116373_toa_do_1.png

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

mình thấy cũng hay, chắc có lúc cũng xài, kím dùm bạn ^^ nhưng ko pit có đúng ý bạn ko, ko đc là elisp nhưng là hình tròn mình thấy cũng đẹp, tọa độ x, y đã đc sữa theo vn-2000 :D, có cái ko chọn font giống cái cũ đc, số lẽ đằng sau do mình thiết lập trong unit của cad

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=67229

;; free lisp from cadviet.com
(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")
----------------------------------------------
(defun C:TTD ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq tapx '() tapy '() stt '())
(setq bit1 (cond (bit1) ("Yes")))
(initget "Yes No")
(setq Tmp1 (strcat "\nTu dong ghi ten nut? [Yes/No] <" bit1 ">: ")
bit1 (cond ((getkword Tmp1)) (bit1)))
(if (eq bit1 "Yes")
(progn
(setq ten (getstring "\nTen Nut:"))
(if (not i) (setq i 1))
(setq i1  (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: ")))
(if i1 (setq i i1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx)
angr (angle Dx Dy)
angd (/ (* 180 angr) pi)
 y   (rtos (car D1) 2 4)
 x   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Cadr D1) 2 4))
TY (strcat "Y:"(rtos (Car D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k   (+ 1 k)
 N   (strcat ten (rtos k 2 0))
 stt (append stt (list N))
 );setq
 (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (if (>= (car DY) (car DX))
 (progn
(setq D2 (polar Dx angr (* 0.7 h)))   
 (command "text" "BL" D2 h angd tX)
  (setq   TB  (textbox (entget(entlast)))
  LC  (car TB)
 RC  (cadr TB)
  di  (distance LC RC)
 PT3 (polar D2 angr (+ di (* 0.4 h)))
 pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
 pt5 (polar pt4 angr di)
 C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
  	"pline" D1 DX PT3 ""
  	"circle" (polar PT3 angr (+ (* 1.5 h ) dt)) (+ (* 1.5 h) dt)
  	"text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N
  	"CECOLOR" 8
  "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
 );progn
 );if
 (if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h))) 
  (command "text" "BR" D2 h (+ angd 180) tx)
  (setq   TB  (textbox (entget(entlast)))
 LC  (car TB)
 RC  (cadr TB)
 di  (distance LC RC)
 PT3 (polar D2 angr (+ di (* 0.4 h)))
 pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
 pt5 (polar pt4 angr di)
 C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
 "pline" D1 DX PT3 ""
 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
 "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
 "CECOLOR" 8
 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(if (eq bit1 "No")
(progn
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") i 1 k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
 (progn
 (setq LOOP T)
 (while (= LOOP T)
 (while (null (setq ten (nentsel "\nChon mot text lam ten nut: ")))
(princ "\nChua tim thay doi tuong la text, chon lai !"));while
 (setq Source_text (entget (car ten)))
 (if (or (= (cdr (assoc '0 Source_text)) "TEXT")
 (= (cdr (assoc '0 Source_text)) "MTEXT")
 (= (cdr (assoc '0 Source_text)) "ATTRIB"));or
(progn
(setq N (cdr (assoc 1 Source_text)))
(setq LOOP nil));progn
(progn
(princ "Phai chon mot text lam ten nut !")
(setq LOOP T));progn
 )if
 );while
 );progn
(setq  DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx)
angr (angle Dx Dy))
(setq angd (/ (* 180 angr) pi)
 y   (rtos (car D1) 2 4)
 x   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Cadr D1) 2 4))
TY (strcat "Y:"(rtos (Car D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k   (+ 1 k)
 stt (append stt (list N))
);setq
 (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))   
 (command "text" "BL" D2 h angd tX)
  (setq   TB  (textbox (entget(entlast)))
  LC  (car TB)
 RC  (cadr TB)
  di  (distance LC RC)
 PT3 (polar D2 angr (+ di (* 0.4 h)))
 pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
 pt5 (polar pt4 angr di)
 C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
  	"pline" D1 DX PT3 ""
  	"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
  	"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N
  	"CECOLOR" 8
  "circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
 (if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h))) 
  (command "text" "BR" D2 h (+ angd 180) tx)
  (setq   TB  (textbox (entget(entlast)))
 LC  (car TB)
 RC  (cadr TB)
 di  (distance LC RC)
 PT3 (polar D2 angr (+ di (* 0.4 h)))
 pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
 pt5 (polar pt4 angr di)
 C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
 "pline" D1 DX PT3 ""
 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
 "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
 "CECOLOR" 8
 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuat bang toa do? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 h))
kc (* 2 di)
 PT (getpoint"\nVi tri dat bang")
 PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
  PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
  PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
  PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1))  (+ (* 1.1 h) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
  n (length tapx)
  k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
 "text" "m" p11 h 0 "§iÓm"
 "text" "m" p22 h 0 "Täa ®é X"
 "text" "m" p33 h 0 "Täa ®é Y"
 "text" "m" pTB (* 1.3 h) 0 "B¶ng Täa §é §iÓm") 
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt
  "text" "m" PTX h 0 xx
  "text" "m" PTY h 0 yy
 "CECOLOR" 3
  "line" PT PTC "") 
(setq  PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq  PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO]\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

cái lsp trên bạn post của anh Thaistreetz, nếu mún bạn pm riêng cho anh ấy thử xem

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Người ta cười chết đấy. Phải nói là sửa thành hệ tọa độ Trắc Địa. (X, Y cad = Y, X Trắc Địa)

Hề hề hề,

Cười càng to càng sống lâu chứ chả chết đâu mà sợ.

Một nụ cười bằng mười thang Minh mạng mà lị. Tốt cho cả người cười lẫn người nghe cười.

Hề hề hề,...

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

gadibo    2

gadibo
Đã đăng

chờ mấy hôm rồi mà chưa thấy anh nào ra tay hộ , toàn cười em ko à .

với em thế nào cũng dc miễn là hoàn thành công việc , ko ngại , sai thì sửa chưa biết thì học.

cái quan trọng em lập cái topic này là để nhờ các anh sửa dùm cái lisp cho đúng mục đích thôi .

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

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

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

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 "%¶ng Täa ®é ®iÓ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 "§iÓ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 "%¶ng Täa ®é cä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ªn cä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äa §é 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äa §é 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^^

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

Lỡ mò mò cho tới, ko pit sữa text lsp của bạn, dùng cách thổ rân này cũng đc hihi, dùng cái lsp minh post ghi tên nut, dùng lsp của bạn mình đã chuyển hệ tọa độ để lập bảng, ok men => hết sức của nhoc rùi :D

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

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

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

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 "%¶ng Täa ®é ®iÓ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 "§iÓ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 "%¶ng Täa ®é cä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ªn cä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äa §é 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äa §é 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^^

Hề hề hề,

Cho bạn viên tăng lực nè. Ráng chút nữa coi.

Hãy lưu ý hai dòng code để tạo e lisp bằng hàm (entmake .....) đó.

(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)))))

Và đây là mã DXF của đối tượng e lip.

 

The following group codes apply to ellipse entities. In addition to the group codes described here, see Common Group Codes for Entities. For information about abbreviations and formatting used in this table, see Formatting Conventions in This Reference.

Ellipse group codes

Group codes

Description

100

Subclass marker (AcDbEllipse)

10

Center point (in WCS)

DXF: X value; APP: 3D point

20, 30

DXF: Y and Z values of center point (in WCS)

11

Endpoint of major axis, relative to the center (in WCS)

DXF: X value; APP: 3D point

21, 31

DXF: Y and Z values of endpoint of major axis, relative to the center (in WCS)

210

Extrusion direction (optional; default = 0, 0, 1)

DXF: X value; APP: 3D vector

220, 230

DXF: Y and Z values of extrusion direction (optional)

40

Ratio of minor axis to major axis

41

Start parameter (this value is 0.0 for a full ellipse)

42

End parameter (this value is 2pi for a full ellipse)

 

Bạn thử dựa vào đây chỉnh sửa lại các giá trị của mã 11, 40 cho phù hợp với kích thước text là OK mà.

Lưu ý tí chút về việc lấy chiều dài của text bằng hàm (textbox.....) hoặc hàm (acet-ent-geomextents ename).

 

Chúc thành công.

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

thanks anh Bình trợ lực nhưng nhoc level yếu quá, thuốc tăng lực anh cho, nhoc uống chắc sock thuốc die mất :D, thật ra nhìn cái lsp này nhoc đâu có hỉu đc cái rì hết ^^, anh Ket dạy chưa tới, chắc học 1 năm bám gót anh Ket nữa may ra nhoc đọc mới hỉu thui chứ viết thì.....^^, chỉ vì nhoc tò mò tí thử liều bơi qua sống "MeKong" ^^,sửa đc thành hệ tọa độ trắc địa là nhoc mừng nhắm rùi.

Ps: dù sao cũng cám ơn anh Bình đã quan tâm chú nhoc tài lanh nì hihi

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng 
(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¶ng Täa ®é ®iÓ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 "§iÓ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¶ng Täa ®é cä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ªn cä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äa §é 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äa §é 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

Nhoc đã cố gắng hết sức, hút hết gói thuốc, load thử hơn chục lần => chỉ đc như trên ^^. Còn 1 cái là còn net line dư chổ elip, hết nơ cà ron rùi :D, bạn chưa chịu thì đành chờ xem mấy huynh có rủ lòng từ bi không hihi

104473_vvffttrggg.jpg

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

thanks anh Bình trợ lực nhưng nhoc level yếu quá, thuốc tăng lực anh cho, nhoc uống chắc sock thuốc die mất :D, thật ra nhìn cái lsp này nhoc đâu có hỉu đc cái rì hết ^^, anh Ket dạy chưa tới, chắc học 1 năm bám gót anh Ket nữa may ra nhoc đọc mới hỉu thui chứ viết thì.....^^, chỉ vì nhoc tò mò tí thử liều bơi qua sống "MeKong" ^^,sửa đc thành hệ tọa độ trắc địa là nhoc mừng nhắm rùi.

Ps: dù sao cũng cám ơn anh Bình đã quan tâm chú nhoc tài lanh nì hihi

Hề hề hề,

Vậy thì thêm một viên chống sốc nữa hè.

Này nhé nhóc thử nghĩ thêm một chút như sau:

1/- Quên mọi thứ lằng nhằng khác trong lisp đi. Chỉ quan tâm tới hai dòng code tạo elip bằng hàm entmake như mình đã nói trên để thấy được cần chỉnh sửa thế nào.

(

 

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

 

2/- Và như vậy do mình chưa hiểu hết vậy hẵng chơi với những thằng mình biết, còn thì thây kệ chúng nó.

Soi vào bảng mã DXF của elip thì rõ ràng thằng (cons 10 PTE) là để xác định tâm của elip

thằng (cons 11 (list (+ (* 0.11 Wh) (* 1.5 H)) 0 0)) để xác định điểm mút của bán trục thứ nhất của elip

thằng (cons 40 (-0.75 (if (= 0 Wh) 0 0.06))))) để xác định tỷ số giữa bán trục "ngắn" và bán trục "dài".

Vậy muốn cho elip to hay nhỏ béo hay gầy là do 3 thằng này quyết định đúng không??? Thế thì ta tìm cách chơi nó là ok.

 

3/- Mần từng thằng một cho nó dễ chứ uýnh cả cụm xem ra nó uýnh mình chết mất.

Với thằng (cons 10 PTE) . Vậy chứ PTE là thằng nào mà gớm vậy. Soi trở lại lisp ở mấy dòng trên đó sẽ thấy:

(

 

setq PTE (polar PTL 0 (+ (* 0.11 Wh) (* 1.5 H))))

À té ra nó là thằng cu tí nhà hàng xóm, quen quá rồi còn gì. Lột truồng nó ra thì nó là một point được lấy theo thằng cu PTL bằng hàm polar theo trục x.

Ở đây nhòm vào hình vẽ dễ dàng suy đoán ra thằng PTL là thằng điểm chót của lwpolyline mà dính vào thằng elip. Và như vậy cũng hiểu ra luôn là cái elip được vẽ với cái tâm PTE chết còng queo, Vì thê mà nếu text dài một chút thì nó đè ngửa thằng elip là đúng rồi. Vậy muốn cho text không đè ngửa được thằng elip thì phải làm cho thằng PTE này sống lại tức là nó được phép chạy ra chạy vô theo chiều dài của text. Tỷ như chiều dài text 100 thì nò nằm cách điểm cuối line là 50 còn nếu text có chiều dài là 10 thì nó sẽ chỉ cách điểm cuối line là 5 thôi.

Vậy thì ngon rồi, có quyền vứt cha mấy cái biến Wh và H đi để thay nó bằng một biến có liên quan tới chiều dài text là Ok, chứ cần đếch gì hai thằng loằng ngoằng kia.

Vậy chứ làm sao biết chiều dài text bằng bao nhiêu???

Hề hề hề, Nhòm lại lisp thì thấy cái text này có tên là name nhưng nó lại được tạo sau khi có elip. Tiên sư nhà nó chứ lị. Vậy thì ông xách cổ mày lôi lên trên để có cái cho ông mày mần chớ.

Đơn giản quá rồi Cut đoạn code tạo text này rồi paste nó lên trên dòng code tạo elip.

Vậy là đã có text trước khi có elip. Thế nhưng muốn làm thịt nó thì phải cho nó cái tên để còn cúng chớ, Sử dụng hàm entlast ngay sau dòng code tạo text để đặt tên cho nó. Cú pháp là (setq etext (entlast))

Đã có tên etext, tha hồ mà làm thịt nó để lây ra chiều dài của nó.

Nếu dùng hàm textbox thì phải dùng (setq len (- (caar (textbox (entget etext))) (cadr (textbox (entget etext)))))

Còn nếu dùng hàm acet -... thì sẽ là (setq len (- (caar (acet-ent-geomextents etext)) (cadr (acet-ent-geomextents etext))))

Và thế là nhóc hoàn toàn có thể bắt cái tâm PTE của elip chạy theo chiều dài của text rối.

(setq PTE (polar PTL 0 (/ len 2)))

Hề hề hề, sướng nhé,

Ấy nhưng , chết bỏ bu rồi bởi cái hàm entmake tạo text:

(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)))

nó lại dựa vào điểm PTE mà lúc này đã có điểm đó đâu. [cái thằng (setq PTE .......) phía trên phải bỏ đi vì không dùng tới nó nữa] Vậy phải làm sao???

Soi kỹ lại hàm này thì thấy cái mã DXF 72 là 1 tức là text được căn theo điểm giữa theo phương ngang. Vậy thì ta chơi kiểu khác lấy căn chỉnh text theo mép trái tức là mã DXF 72 là 0 và điểm căn text được thay bằng điểm PTL . Vậy là xong.

Đoạn code tạo text được sửa thành:

(entmake (list '(0 . "TEXT") (cons 10 PTL) (cons 11 PTL) (cons 40 H) (cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 2)))

 

Đến đây việc xử lý điểm tâm của elip coi như ổn.

Nhóc hãy thử nghĩ tiếp việc xử lý đối với 2 thằng cu còn lại nhé. Chỉ cần lưu ý việc chọn tỷ lệ giữa hai bán trục cho elip ngó thấy mập mạp là OK.

 

Hề hề hề, hãy cố lên, sắp tới thiên đàng rồi.

Chúc thành công.

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

Sáng mai rãnh nhoc mò tip giờ bùn ngủ oỳ, chưa đọc hết ko biết chống sock hay sock thêm ^^, thanks anh Bình nhiều ^^

Ps: Pac Bình ở SG phải hem nhỉ, khi nào có dịp nhoc xin đc mời bác chầu cafe đa tạ bác đã nhiệt tình với thằng em nì ^^

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Sáng mai rãnh nhoc mò tip giờ bùn ngủ oỳ, chưa đọc hết ko biết chống sock hay sock thêm ^^, thanks anh Bình nhiều ^^

Ps: Pac Bình ở SG phải hem nhỉ, khi nào có dịp nhoc xin đc mời bác chầu cafe đa tạ bác đã nhiệt tình với thằng em nì ^^

Hề hề hề,

Sài gòn hoa lệ mà toàn thấy lệ hoa thui....

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

Anh Bình ơi nhoc gặp 1 số chỗ vướn, nhoc đọc hỉu sơ sơ rùi làm thử => sai :D, nó ra đc điểm ra đc text, text ko bị trùng lwpoline nhưng ko tạo đc elisp cũng ko thể kéo đi đâu, pick xong hiện lun rùi chết ngay điểm pick, cũng ko thể pick điểm khác ^^

Lỗi em nó như thế lày, sau khi pick điểm đầu tiên báo lỗi

Pick diem thu 100 : (2540.71 1176.03 0.0)error: bad argument type: numberp:

(8.41746 2.00819 0.0)

Em thấy còn 1 chỗ lạ là sau khi tạo text hay elisp dưới code đó lại có thêm biến: (setq SSnode (ssadd (entlast) SSnode)) => ko pit có tác dụng gì

còn đây là đoạn code em sữa thế này

(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 PTL) (cons 40 H)

(cons 1 name) (cons 7 (nth 2 TD-value)) '(72 . 0) '(73 . 2)))

(setq etext (entlast))

(setq len (- (caar (textbox (entget etext))) (cadr (textbox (entget etext)))))

(setq PTE (polar PTL 0 (/ len 2)))

(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")

(cons 10 PTE) (cons 11 (list (+ (* 0.25 len) (* 2.2 H)) 0 0)) (cons 40 (- 0.75 (if (= 0 len) 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 len) (* 1.9 H)) 0 0)) (cons 40 (- 0.74 (if (= 0 len) 0 0.01)))))

(setq SSnode (ssadd (entlast) SSnode))))

Thành quả thất bại :D

104473_thuuuuuuuuuuuu.jpg

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Anh Bình ơi nhoc gặp 1 số chỗ vướn, nhoc đọc hỉu sơ sơ rùi làm thử => sai :D, nó ra đc điểm ra đc text, text ko bị trùng lwpoline nhưng ko tạo đc elisp cũng ko thể kéo đi đâu, pick xong hiện lun rùi chết ngay điểm pick, cũng ko thể pick điểm khác ^^

Lỗi em nó như thế lày, sau khi pick điểm đầu tiên báo lỗi

 

Em thấy còn 1 chỗ lạ là sau khi tạo text hay elisp dưới code đó lại có thêm biến: (setq SSnode (ssadd (entlast) SSnode)) => ko pit có tác dụng gì

còn đây là đoạn code em sữa thế này

 

Thành quả thất bại :D

104473_thuuuuuuuuuuuu.jpg

Hề hề hề,

Rất xin lỗi vì thất bại của bạn.

Mình check lại thì lỗi là do:

1/- Mình đọc không kỹ phần help của CAD về hàm textbox.

Khi dùng hàm text box thì:

If fields that define text parameters other than the text itself are omitted from elist,

Tức là bạn phải bỏ qua các trường xác định các thuộc tính của text mà không liên quan trực tiếp đến text. Vì thế khi viết (textbox (entget etext)) thì hàm sẽ trả về nil chứ không phải list các tọa độ của khung bao text như mình mong muốn.

Ví thế chỗ này phải đổi lại thành (textbox (list (assoc 1 (entget etext))))

2/- Do không kiểm tra nên mình bị nhầm một chút ở hàm (cadr (textbox......)). Đúng ra phải là (caadr (textbox ......))

3/- Điểm PTE phải lấy về phía bên phải của điểm PTL mà giá trị của biến len lúc này lại <0. Vì thế may mà nó không vẽ ra elip chứ vẽ ra thì lại bị bạn chửi vỡ mặt.

bây giờ bạn thử sửa một chút xíu nhé:

1/- Lấy giá trị biến len:

(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))))))))

2/- Chớ vội tham lấy nhiều điểm làm chi, cứ thử một điểm thôi đã, nó ngon thì ắt các thằng khác cũng ngon.

Hề hề hề.

 

3/- Lưu ý bạn vì sao lại lấy cái thằng cu 11 và 40 như vậy.

 

(cons 11 (list (+ (* 0.25 len) (* 2.2 H)) 0 0)) (cons 40 (- 0.75 (if (= 0 len) 0 0.01)))))

Thằng 11 là điểm mút của bán trục thứ nhất mà bạn đã biết nó chính là điểm cuối của pline PTL đối với elip lớn, còn elip nhỏ thì bạn trừ nó đi chút xíu lá được.

Thằng 40 là tỷ số giử hai bán trục. Vậy cần chi phải rắc rối if iếc cho nó tịt mũi. Cứ nhét đại một con số rồi chỉnh sau. Tỷ như 0.75 chẳng hạn.

Như vậy code sẽ dễ hiểu và đỡ loằng ngoằng hơn nhiều.

Chẳng hạn với elip lớn :

 

(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse") (cons 10 PTE) (cons 11 PTL) (cons 40 0.75)))

Còn với elip nhỏ chỉ cần thay điểm PTL bằng một điểm lấy cách PTL một khoảng cố định theo trục x là 0,1 hay 0.15 là Ok.

 

Hề hề hề,

Chúc thành công

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

nhoc làm y hệt anh Bình nhưng nó vẫn ko chịu có b......ầ............u .......bùn wé >"<, T_T

(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 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 2)))
(setq SSnode (ssadd (entlast) SSnode))
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")
 (cons 10 PTE) (cons 11 PTL) (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 (+ PTL 0.15) 0 0)) (cons 40 0.65)))
 (setq SSnode (ssadd (entlast) SSnode))))

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

Nhoc sr...bạn, sr..anh Bình hướng dẫn nhoc đầu hàng ^^, cái nì giống như học sinh lớp 1 giải tích phân bậc 3 ớ ^^. Thui nhoc sẽ ghi nhớ trang này khi nào đủ level quay lại báo thù sau vậy :D

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×