Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
38 replies to this topic

#21 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 17 January 2013 - 01:18 PM

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
Hình đã gửi
  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#22 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 17 January 2013 - 05:27 PM

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
Hình đã gửi

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
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#23 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 17 January 2013 - 08:46 PM

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

  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#24 gadibo

gadibo

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 17 January 2013 - 09:29 PM

cảm ơn 2 bác đã giúp e
  • 0

#25 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 17 January 2013 - 09:40 PM

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
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#26 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 18 January 2013 - 01:09 AM

Giá như mình có thời gian nhiều hơn nữa thì việc này mình sẽ mày mò. Được bác phamthanhbinh chỉ bảo chi tiết thía chả mấy chốc mà lisp lên vùn vụt.
@gadibo = Trương Mạnh Hà đúng ko nhở? Hiii.
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#27 gadibo

gadibo

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 18 January 2013 - 01:10 PM

ko phải đâu bác ơi !
  • 0

#28 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 18 January 2013 - 06:27 PM

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

Hề hề hề, Thù gì mà đòi báo.
Tự mình hại mình thì còn thù ai và báo ai hử???
Này nhé:
PTL là một điểm mang tên đó chứ đâu có phải là một số mà (+ PTL 0.15). Một điểm nghĩa là nó phải được xác định bởi hai hay ba tọa độ chứ. Thực tế thì PTL là một list gồm hai hoặc 3 số thể hiện các tọa độ của điểm mang tên đó.
Vì thế nếu muốn offset điểm PTL một đoạn là 0.15 theo trục x có nghĩa là tọa độ điểm mới sẽ có x lớn hơn tọa độ x của PTL là 0.15, còn các tọa độ khác giữ nguyên. Có nhiều cách để đạt điều này:
1/- (setq PTL1 (polar PTL 0 0,15))
2/- (setq PTL1 (list (+ (car PTL) 0.15) (cadr PTL))
3/- ........
4/- .........
Vì thế cái lisp của nhoc sửa không chạy là tất yếu vì nó chả hiểu nhóc muốn làm gì.
Tiếp theo 0.75 chỉ là một ví dụ để chọn tỷ lệ giữa hai bán trục, nếu nó đẹp rồi thì thôi, còn nếu chưa đẹp thì ta thay lại. Nhưng can cớ chi mà elip lớn thì chọ tỷ lệ là 0.75, còn elip nhỏ lại chọn 0.65. Như vậy thì làm sao mà hai elip đồng dạng được hử??? Nó mà không đồng dạng thì liệu có coi được không và có đúng ý chủ thớt không???
Rứa đó, nhóc thử sửa lại một lần nữa coi sao. nếu vẫn chưa được thì có nhẽ hỏng. mà là hỏng hẳn đó.
Hề hề hề,...
PS: à quênm, caí bữa trước nhóc hỏi về biến SSnode. Nó là một tập chọn gồm các đối tượng mà nhoc tạo ra trong lisp. Bởi thế sau mỗi lần tạo ra một đối tựng trên bản vẽ thì người ta lại nhét nó vào tập chọn này. Để làm chi thì chỉ có người tạo ra líp này trả lời thôi. Theo thiển ý của mình thì có thể là người viết lisp sẽ dùng biến này vào một hàm chi đó trong lisp hoặc là để tiện cho việc xóa sổ nó khi thấy không khoái.
Hề hề hề, cái ni cũng gần giống với cái việc (setq etext (entlast)) vậy.
Hề hề hề, ráng lên chút nữa coi, sắp tới thiên đàng rồi, chớ có rụt tay lại.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#29 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 19 January 2013 - 07:09 AM

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 ^^
Hình đã gửi

Tấm thứ 2, rừng già amazon nhé :)
Hình đã gửi

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
Hình đã gửi
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 ^^
Hình đã gửi
  • 2
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#30 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 19 January 2013 - 08:16 AM

Chúc mừng bạn đã thành công. Bravo bravo
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#31 gadibo

gadibo

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 19 January 2013 - 02:37 PM

thank nhóc nhiều lắm , nhưng ko dc rồi nhóc ơi .

Hình đã gửi
  • 0

#32 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 20 January 2013 - 02:19 AM

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 ^^ Hình đã gửi Tấm thứ 2, rừng già amazon nhé :) Hình đã gửi 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 Hình đã gửi 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 ^^ Hình đã gửi

Hề hề hề,
Vậy là ngon rồi. Việc elip nó bao được text là Ok, còn cái vụ nó mập mạp, ấy là do cái tỷ lệ 0.75 đó mà thôi. Cùng chiều cao text nhưng khi text đủ dài thì bán trục dài đủ lớn khiến cho bán trục ngắn đủ bự. Nếu muốn ngon hơn thì đơn giản là bạn chọn tỷ lệ này phụ thuộc vào chiếu dài text. Tỷ như:
(setq TLBT (cond ((< len 10) 0.75) ((and (> len 10) (< len 20)) 0.70) ((and (> len 20) (< len 30)) 0.65)))
Nhưng như vậy thì khá lôi thôi vì chả ai biết được cái chiều dài text bao nhiêu là đủ cả.
Mặt khác cứ có elip đi rồi người dùng nếu thấy chưa vừa ý co thể tự điều chỉnh elip sao cho phù hôp là được chứ khó mà biết ý người dùng thế nào là đẹp nhóc ạ.
Cái cách của nhóc làm cho text không thật sụ nằn chính tâm elip vì :
(

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)))
tức là tạo text cách dầu mút line một khoảng (+ (car PTL) 0.65)
Trong khi tâm của elip là
(

setq PTE (polar PTL 0 (/ len 1.7)))
Như vậy làm sao đảm bảo được tâm elip trùng với tâm text.
Đúng ra tâm text sẽ cách điểm PTL một đoạn là (+ (/ len 2) 0.65) chứ không phải là (/ len 1.7) và nhóc nên lấy tâm text làm tâm elip thì hình vẽ ra trong sẽ ngon mắt hơn.

Hề hề hề, góp ý một chút để nhóc tập suy luận khi làm lisp, nếu không hài lòng chớ có giận nghen. Làm được như vậy là quá tốt rồi, ráng chút xíu sẽ làm được những điều mình khoái nhóc ạ.

@ Chủ thớt: Lỗi font không phải do lisp đâu mà là do code box của diễn đàn. Chủ thớt chịu khó down file về chứ đừng copy code trong box. Cái elip bị nhỏ là do chủ thớt đang dùng textstyle khác với textstyle được chọn trong lisp đó. Hãy cẩn thận check lại text style của bản vẽ trước khi dùng lisp sao cho nó phù hợp với style được quy định trong lisp.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#33 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 20 January 2013 - 06:54 AM

hihi nhoc dể tính lém hem có giận đâu :D, anh Bình góp ý đúng rùi, cái vụ tâm elip và tâm text nhưng nhóc cố tình đó anh BÌnh ^^, nhoc thấy anh Bình hướng dẫn cho text canh trái theo PTL, nhưng khi tạo ra elip thấy cái chữ đầu nó hơi sát elip , mắt nhoc chưa ưng nên nhoc mò chỉnh sao cho text nó chạy ra tí ^^. Nói thiệt đc anh Bình chỉ dạy nhoc rất zui nhưng thiệt là ko hỉu gì hết suy luận tùm lum, lấy cái code anh Bình cho đem vô thử chưa đc thỉ chỉnh tí làm lại chứ đọc nhoc chưa hỉu nỗi mấy code ở trong đâu chỉ áp dụng cái cơ bản nhất anh Ket dạy mò sao miễn là đóng mở ngoặc cho đủ, và áp dụng mí code anh Bình cho để vào sao cho đúng vị trí :D, vậy mới có 2 tấm trên 3 cái bầu thịt bự, và nguyên 1 rừng amazon đó ^^, nhoc chỉ sợ anh Bình bùn ngược lại "chỉ nó kỹ như rứa" mà cuối cùng nó ko hỉu gì hết ^^
@gadibo: bạn down kiểu này zìa sẽ ko bị lỗi font nữa, còn vụ style như anh Bình nói, lsp quy định 1 số font nhất định bạn tạo style mới font ngoài font quy định nên thía, nếu sữa trong lsp nữa :D cho nhoc xin , vụ nì ko mò nỗi tip đâu ^^
http://www.cadviet.c.../104473_tff.lsp
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#34 gadibo

gadibo

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 20 January 2013 - 01:20 PM

nhóc à cái lỗi e lisp nó vẫn thế ko khác gì cả . mình đã tải đúng lisp mới của bạn về dùng rồiHình đã gửi
  • 1

#35 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 20 January 2013 - 02:23 PM

ax, ax thử với text lớn quên thử text nhỏ, đúng như bạn nói ^^, anh Bình help nhoc :D
Nhoc cố gắng lần nữa sữa rùi nè lần này ok, nhưng nhoc nói trước nếu text dài quá thì nhoc ko đảm bảo đc text nằm giữa elip chỉ đảm bảo text nằm trong elip ko bị chồng thui nhen :D
http://www.cadviet.c...04473_tff_1.lsp
  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#36 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 21 January 2013 - 10:28 AM

ax, ax thử với text lớn quên thử text nhỏ, đúng như bạn nói ^^, anh Bình help nhoc :D
Nhoc cố gắng lần nữa sữa rùi nè lần này ok, nhưng nhoc nói trước nếu text dài quá thì nhoc ko đảm bảo đc text nằm giữa elip chỉ đảm bảo text nằm trong elip ko bị chồng thui nhen :D
http://www.cadviet.c...04473_tff_1.lsp

Hề hề hề,
Nhóc cứ bình tĩnh, yêu cầu chủ thớt gửi bản vẽ lên để test lại. Khả năng là lỗi chủ thớt để textstyle chưa đúng rất cao, song không có bản vẽ thì cũng mù tịt. Cứ xem hình thì thấy lisp đã tạo ra elip rồi. Vấn đề kích thước của elip thì nó phục thuộc vào chiều dài text như lisp yêu cầu rồi. Chỉ còn lại là chiều dài text mà thôi. Lisp lấy chiều dài text theo style có trong biến TD-value.
Trong khi biến này lại có thể lấy giá trị có sẵn trong hộp thoại. Nếu giá trị của textsize trong style này khác với quy định trong lisp thì hề hề hề chỉ có giời mới biết nó to hay bé.
Bài trước mình cũng đã có đề nghị chủ thớt check lại style mà chả nghe chủ thớt phản ứng gì , chắc là chủ thớt chỉ muốn ăn sẵn đây mà. nếu chủ thớt khoi6ng đưa bản vẽ lên thì cứ ngồi đó đợi đi, mình chả có cách gì để phàn nữa cả.
Hề hề hề, cái mình biết chỉ có hạn chứ chả phải là biết tuốt......
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#37 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 21 January 2013 - 11:07 AM

anh Bình thử lsp em sữa chưa a, đc rùi đó chỉ là text dài thì nhìn nó sẽ ko cân lắm với elisp
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#38 lecoi

lecoi

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 December 2013 - 01:15 PM

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

Bạn cho minh xin cách sử dụng lips này được không: hoanghiep198@gmail.com


  • 0

#39 trungack

trungack

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 November 2015 - 08:11 AM

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 [url=""%20title="]Common Group Codes for Entities[/url]. For information about abbreviations and formatting used in this table, see [url=""%20title="]Formatting Conventions in This Reference[/url].
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.

 Mình thấy lisp này rất hay, nên đã tải xuống dùng, nhưng chỉ pick được có 1 điểm rồi phải enter tiếp chọn vị trí đặt bản TKTD lại rất lâu, A Bình có thể chỉnh sửa lại dùm được k a. lisp vẫn như vậy nhưng pick được nhiều điểm và hiện tọa độ lên bản TK luôn 1 lần.Thanks!


  • 0