Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
2hproduction

[Yêu cầu] Lisp thống kê tọa độ địa chính

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

em load lisp của bác lên thì lệnh laytd thì đc nhưng lenh ghitd thì lỗi thế này bác à 

Command: ghitd

; error: no function definition: TYLE

Sr mình quên xóa 2 dòng :

(setq TL (getvar "userr1"))

 

(if (<= TL 0.0) (tyle))

 

trong phần đầu của hàm ghitd đó bạn. Mình đã edit lại rồi đó.

 

Có lỗi thì trả lời nhé !

  • 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

cái này hình như đang nhầm giữa X và Y thì phải anh à, Kiểm tra thấy bảng X thành bảng Y bác à

Tọa độ địa chính thì X = North và Y = East mà bạ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

bác xem xem phải không nhé em tríc tọa độ 2 điểm này,với cả em muốn chỉnh cái cỡ chữ số hiệu điểm thì chỉnh ở đâu bác, bác đang để 1.0 giờ em muốn cho nó nhỏ hơn chút

đây là file ảnh http://www.upanh.com/view/?s=upload&id=8vp5bvcl5oz

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

bác xem xem phải không nhé em tríc tọa độ 2 điểm này,với cả em muốn chỉnh cái cỡ chữ số hiệu điểm thì chỉnh ở đâu bác, bác đang để 1.0 giờ em muốn cho nó nhỏ hơn chút

đây là file ảnh http://www.upanh.com/view/?s=upload&id=8vp5bvcl5oz

Tọa độ địa chính thì như mình đã nói, không có gì phải bàn cả.

Nếu muốn sửa độ lớn của chữ thì bạn tìm dòng như vầy :

(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")

sửa giá trị 1.0 đi là đc.

PS: Nếu bạn muốn Trục XY như cũ thì hoặc là sửa code hoặc là move cột X thành Y thôi

À mà mình thấy có lẽ bạn cần cái này để lấy tọa độ diểm phải không ?


(defun c:T_id ()

(luuBHT) (setvar "cmdecho" 0)

(initget 1) (setq point01 (getpoint "\nChon diem 1 : \n"))

(setq x1 (rtos (car point01) 2 3) y1 (rtos (cadr point01) 2 3))

(setvar "osmode" 0)

(initget 1) (setq point02 (getpoint point01 "\nChon diem 2 :\n :"))

(setq Angle12 (angle Point01 Point02) dis12 (distance point01 point02))

(if (and (> Angle12 (/ pi 2)) (< Angle12 (* pi 1.5)))

(progn (setq Angle0 pi) (setq Jus "BR"))

(progn (setq Angle0 0.0) (setq Jus "BL")));end if

(setq Point03 (polar (polar Point01 Angle12 dis12) (/ pi 2) 0.275))

(taolop '("Hientrang")) (command "layer" "s" "Hientrang" "")

(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")

(command "pline" point01 "w" 0.0 0.4 (polar Point01 Angle12 1) "w" 0.0 0.0

(polar Point01 Angle12 dis12)

(polar (polar Point01 Angle12 dis12) Angle0 10.5) "")

(command ".text" Jus Point03 1.0 0.0 (strcat "X = " x1) "")

(command ".text" Jus (polar Point03 (* pi 1.5) 2.5) 1.0 0.0 (strcat "Y = " y1) "")

(traBHT) (princ))

(Không có vòng tròn như bạn vì công việc của mình không cần vòng tròn đó )

  • 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

Ý em muốn sửa cái text này nhỏ bớt anh à, anh nhìn hình rồi giúp em phát

http://www.upanh.com/view/?s=upload&id=3vp27v9x2ao

Cái bác bảo em sửa ở trên chỉ là cái chữ ở trong khung bang tọa độ thôi.

Em xin cảm ơn bác

Sửa dòng này :

(taochu (itoa SBD) "MiaT" 256 pt 1.0 "Aptima")

Giá trị 1.0 màu đỏ là cao chữ .

(Bạn Ctrl+C dòng trên rồi past vào phần Find  của trình soạn thảo là tìm đc dòng đó nhanh chóng thôi)

  • 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

Thanks bác em đã làm đc rồi. Tiện đây cho em hỏi có lisp nào chạy cạnh của thửa đất không cho em xin với.

Nó cũng giống như mình chạy tọa độ, chỉ cần pick vào 1 điểm trong vùng kín là nó tự hiện kích thước tất cả các cạnh lê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

Thanks bác em đã làm đc rồi. Tiện đây cho em hỏi có lisp nào chạy cạnh của thửa đất không cho em xin với.

Nó cũng giống như mình chạy tọa độ, chỉ cần pick vào 1 điểm trong vùng kín là nó tự hiện kích thước tất cả các cạnh lên

Cái này chắc cũng dùng tạm đc cho yc của bạn :


(defun C:ghicanh (/ ss)

(luuBHT)

(setvar "CMDECHO" 0)

(setvar "OSMODE" 0)

(setq ss (ssget))

(command "UNDO" "BE" "")

(T_ALL ss)

(command "UNDO" "E" "")

(traBHT))

(defun XULY (s1 s2 / goc so canh goc90 pt0 pt)

(setq goc (angle s1 s2) so (distance s1 s2) HSLT 2 )

(setq pt0 (polar s1 goc (/ so 2)))

(setq goc90 (+ goc (/ PI 2)) pt (polar pt0 goc90 0.8))

(setq canh (trtos so HSLT))

(if (or (<= (* (/ goc pi) 180) 90) (>= (* (/ goc pi) 180) 270))

(command "TEXT" "M" pt 0.85 (* (/ goc pi) 180) canh "")

(command "TEXT" "M" pt 0.85 (+ (* (/ goc pi) 180) 180) canh "")))

(defun T_LINE (oldob / s01 s02)

(setq s01 (cdr (assoc 10 oldob)) s02 (cdr (assoc 11 oldob)))

(xuly s01 s02))

(defun T_POLYLINE (oldob / s s1 s2 i)

(setq i 0 s nil s1 nil)

(while (< i (length oldob))

(if (= (car (nth i oldob)) 10)

(progn

(setq s2 (cdr (nth i oldob)))

(if (= s1 nil) (setq s s2) (xuly s1 s2))

(setq s1 s2)))

(setq i (1+ i)))

(if (= (cdr (assoc 70 oldob)) 1)

(xuly s2 s)))

(defun T_BLOCK (oldob / ss1 pt1)

(setq pt1 (cdr (assoc 10 oldob)))

(setq b_name (cdr (assoc 2 oldob)))

(setq tt_name (cdr (assoc -1 oldob)))

(command "EXPLODE" tt_name "")

(setq ss1 (ssget "P"))

(T_ALL ss1)

(command "ERASE" "P" "")

(command "INSERT" b_name pt1 "" "" ""))

(defun T_ALL (ss / c oldob)

(setq c 0)

(if (/= ss nil)

(while (< c (sslength ss))

(setq oldob (entget (ssname ss c)))

(if (= (cdr (assoc 0 oldob)) "LINE")

(T_LINE oldob)

(if (/= (or (= (cdr (assoc 0 oldob)) "POLYLINE") (= (cdr (assoc 0 oldob)) "LWPOLYLINE")) nil)

(T_POLYLINE oldob)

(if (= (cdr (assoc 0 oldob)) "INSERT")

(T_BLOCK oldob))))

(setq c (1+ c)))))

 

Chọn các cạnh muốn ghi là đc.

PS : lsp xử lý đc luôn cả pline và block. Nhưng nếu là block thì chỉ đúng khi block chưa bị scale .

Và phải có hàm trtos của lsp ghitd bên trên.

(Trtos cũng giống rtos nhưng tránh đc các lỗi do CAD làm tròn số)

  • 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

Nhờ a chỉnh sưa giúp e chạy được thêm đỉnh thửa, cạnh thửa được không ạ.

1 ý nữa là cho chọn điểm đầu để đánh đỉnh thửa, pcik điểm nằm trong thưa, rồi chạy theo chiều thuận kim đồng hồ

E xin chân thành cảm ơ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

anh ơi anh có thể sửa lại dùm em file này. chạy theo chiều kim đồng hồ không? ( hoặc anh nào cũng được ạ). em cảm ơn nhiều

Mình đang dùng lsp này. Bạn nào đang làm địa chính vẽ 1/500 in 2=1 thì dùng rất phù hợp.  Còn in tỷ lệ khac thì chỉnh lại code lsp là đc
Lệnh như sau :
ghitd (Xuất bảng tọa độ góc ranh theo cách pick điểm tuần tự do ng dùng chỉ định)
laytd (Xuất bảng tọa độ theo cách ng dùng pick chọn 1 điểm trong vùng muốn xuất tọa độ. kết quả xuất ra bảng tọa độ theo nguyên tắc lấy điểm thứ 1 là điểm cao nhất và chạy tọa độ cùng chiều kim đồng hồ )


;Ndaitfunc 2013
;Viet boi : Ndait Nguyen
;;-------------------------------------------------------
;Ghi toa do tu dong theo chieu kim dong ho
(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1
p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17)
(luuBHT)
(setq p (getpoint "\nPick point :"))
(setvar "osmode" 0)
(taolop '("vunglaytd" "diemtd" "texttd"))
(setvar "clayer" "vunglaytd")
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(if (/= p nil) (command "-Boundary" p "" ));end if
(setq bound (entget (entlast)))
(setq k (cdr (assoc 90 bound)))
(setq lstpt '() lstx '() lsty '() newlst '())
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc 10 bound))
(setq t1 (member bien bound))
(setq p1 (car t1))
(setq bound (cdr t1))
(setq diem (cdr p1))
(setq x (car diem) y (cadr diem))
(setq lstx (append lstx (list x)) lsty (append lsty (list y)))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq ymax (maximum lsty))
(setq kmax (vl-position ymax (reverse lsty)))
(setq lstpt (reverse lstpt))
(setq newlst (member (nth kmax lstpt) lstpt))
(setq n 0)
(repeat kmax (setq newlst (append newlst (list (nth n lstpt)))) (setq n (+ 1 n)))
(setq c 0 new '())
(foreach name newlst (setq new (append new (list (append (list (setq c (1+ c))) name)))))
(setq c 1 new (append new (list (nth 0 new))))
(setq ltext '())
(setq ltext (append ltext (list (nth 0 new))))
(setq newlst (append newlst (list (nth 0 newlst))))
(repeat (- (length new) 1)
(setq ltext (append ltext (list (append (nth c new)
(list (distance (append (nth (- c 1) newlst) '(0.0)) (append (nth c newlst) '(0.0))))))))
(setq c (1+ c)));repeat
(setq n 0)
(setvar "clayer" "diemtd")
(repeat (- (length new) 1)
(ndait_addtext (itoa (car (nth n new))) "texttd" 256 (cdr (nth n new)) 1.0 0.0 "aptima" "BL")
(command "CIRCLE" (cdr (nth n new)) "0.25" "")
(setq n (1+ n)));repeat
(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))
(if (null diemve)
(prompt "\nKhong ve bang ! ")
(progn
(setvar "osmode" 0)
(setvar "orthomode" 0)
(taolop '("Text_Bang" "Line_Bang"))
(setq pt diemve)
(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")
(command "layer" "s" "Line_Bang" "")
(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))
(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))
(setq p1 p
p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)
p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)
P4 (polar p3 0.0 7.0)
p5 (polar p4 0.0 9.0)
p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5))
(setq pt2 (polar pt1 0.0 5.5)
pt3 (polar pt2 0.0 18.0)
pt4 (polar pt3 0.0 5.5)
pt5 (polar pt2 (* 1.5 Pi) 2.5)
pt6 (polar pt5 0.0 9.0)
pt7 (polar pt6 0.0 9.0)
pt8 (polar pt1 (* 1.5 Pi) 5.0)
pt9 (polar pt8 0.0 5.5)
pt10 (polar pt9 0.0 9.0)
pt11 (polar pt10 0.0 9.0)
pt12 (polar pt11 0.0 5.5))
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")
(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")
(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")
(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")
(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")
(command "layer" "s" "Line_Bang" "")
(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "")
(command "line" pt2 pt3 "")
(command "line" pt5 pt9 "")
(command "line" pt6 pt10 "")
(command "line" pt7 pt11 "")
(setq pt (polar pt (* 1.5 pi) 6.9))
(setq i 0)
(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))
(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25)))
(setq pt14 (polar pt13 0.0 5.5)
pt15 (polar pt14 0.0 9.0)
pt16 (polar pt15 0.0 9.0)
pt17 (polar pt16 0.0 5.5))
(command "layer" "s" "Line_Bang" "")
(command "line" pt8 pt13 pt14 pt9 "")
(command "line" pt14 pt15 pt10 "")
(command "line" pt15 pt16 pt11 "")
(command "line" pt16 pt17 pt12 "")
));if
(traBHT)
(princ))
;;----------------------------------------------------------------
;;;Xuat so lieu toa do diem ra file va danh so thu tu
(defun c:ghitd (/ SBD DIEMDAU pt pt0 canh diem text text0 dspt ltext DIEMCUOI Tongdiem diemve i f fl)
(luuBHT)
;(setq TL (getvar "userr1"))
;(if (<= TL 0.0) (tyle))
(setvar "cmdecho" 0) (setvar "cecolor" "256")
(setq dspt '() ltext '() pt0 nil canh nil)
(Setq SBD (getint "\n Nhap so hieu diem bat dau ghi toa do : <Enter=1> "))
(if (null SBD) (setq SBD 1) (setq SBD SBD))
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(taolop '("MiaP" "MiaT"))
(SETQ DIEMDAU SBD)
(while (setq pt (getpoint (strcat "\n Chon diem toa do : <Mia so " (itoa SBD) "> (Enter de ket thuc)")))
(if (not (null pt0)) (setq canh (distance pt0 pt)))
(setq pt0 pt)
(setq diem (strcat (itoa SBD) " " (trtos (car pt) 3) " " (trtos (cadr pt) 3)))
(setq text (list SBD (car pt) (cadr pt) canh))
(command "layer" "s" "MiaP" "")
(command "point" pt "")
(command "CIRCLE" pt "0.25" "")
(taochu (itoa SBD) "MiaT" 256 pt 1.0 "Aptima")
(setq SBD (1+ SBD))
(setq dspt (append dspt (list diem)))
(setq ltext (append ltext (list text)))
);end while
(setq text0 (nth 0 ltext))
(setq canh (distance (list (nth 1 text0) (nth 2 text0) 0) pt0))
(Setq text (list (nth 0 text0) (nth 1 text0) (nth 2 text0) canh))
(setq ltext (append ltext (list text)))
(setq Tongdiem (itoa (- SBD diemdau)))
(SETQ DIEMCUOI (- SBD 1))
(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))
(if (null diemve)
(prompt "\nKhong ve bang ! ")
(progn
(setvar "osmode" 0)
(setvar "orthomode" 0)
(taolop '("Text_Bang" "Line_Bang"))
(setq pt diemve)
(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH"
"Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")
(command "layer" "s" "Line_Bang" "")
(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))
(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))
(setq p1 p
p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)
p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)
P4 (polar p3 0.0 7.0)
p5 (polar p4 0.0 9.0)
p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5)) ;_ end of setq
(setq pt2 (polar pt1 0.0 5.5)
pt3 (polar pt2 0.0 18.0)
pt4 (polar pt3 0.0 5.5)
pt5 (polar pt2 (* 1.5 Pi) 2.5)
pt6 (polar pt5 0.0 9.0)
pt7 (polar pt6 0.0 9.0)
pt8 (polar pt1 (* 1.5 Pi) 5.0)
pt9 (polar pt8 0.0 5.5)
pt10 (polar pt9 0.0 9.0)
pt11 (polar pt10 0.0 9.0)
pt12 (polar pt11 0.0 5.5)) ;_ end of setq
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")
(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")
(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")
(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")
(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")
(command "layer" "s" "Line_Bang" "")
(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "") ;_ end of command
(command "line" pt2 pt3 "")
(command "line" pt5 pt9 "")
(command "line" pt6 pt10 "")
(command "line" pt7 pt11 "")
(setq pt (polar pt (* 1.5 pi) 6.9))
(setq i 0)
(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))
(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25))
pt14 (polar pt13 0.0 5.5)
pt15 (polar pt14 0.0 9.0)
pt16 (polar pt15 0.0 9.0)
pt17 (polar pt16 0.0 5.5))
(command "layer" "s" "Line_Bang" "")
(command "line" pt8 pt13 pt14 pt9 "")
(command "line" pt14 pt15 pt10 "")
(command "line" pt15 pt16 pt11 "")
(command "line" pt16 pt17 pt12 "")))
(if (/= (setq f (getstring "\n<Ten FILE> luu toa do diem , Go <ENTER> neu khong luu : ")) "")
(progn
(if (findfile f) (setq fl (open f "a")) (setq fl (open f "w")))
(write-line "DANH SACH TOA DO DIEM " fl)
(write-line (strcat "File name : " (getvar "dwgprefix") (getvar "dwgname")) fl)
(write-line (strcat "TONG SO DIEM : " Tongdiem) fl)
(write-line (strcat "DIEM DAU : " (itoa DIEMDAU) " DIEM CUOI : " (itoa DIEMCUOI)) fl)
(setq i 0)
(repeat (length dspt) (write-line (nth i dspt) fl) (setq i (1+ i)))))
(if fl (close fl))
(traBHT)
(princ))
;;Dung cho ham ghitd
(defun ghihang (point hang / p p1 p2 p3 pt pt2 pt3 pt4 pt5 t1 t2 t3 t4)
(setq pt point
p (polar (polar pt 0.0 2.0) (/ pi 2.0) 0.25)
t1 (rtos (car hang) 2 0)
t2 (trtos (cadr hang) 3)
t3 (trtos (cadr (cdr hang)) 3))
(if (not (null (nth 3 hang))) (setq t4 (trtos (nth 3 hang) 2)))
(setq p1 p
p2 (polar p1 0.0 12.0)
p3 (polar p2 0.0 8.5)
p4 (polar (polar p3 0.0 5.5) (* 0.5 Pi) 1.0))
(taochu t1 "Text_Bang" 256 p1 0.9 "aptima")
(Ndait_addtext t3 "Text_Bang" 256 p2 0.9 nil "aptima" "R")
(Ndait_addText t2 "Text_Bang" 256 p3 0.9 nil "aptima" "R")
(if (not (null t4)) (Ndait_addText t4 "Text_Bang" 256 p4 0.9 nil "aptima" "R")));end of defun
;-----------------------------------
;Cac ham dung chung
;;Luu va tra bien he thong
(defun luuBHT ()
(setq
auts (getvar "autosnap")
blip (getvar "blipmode")
ceco (getvar "cecolor")
clay (getvar "clayer")
cmec (getvar "cmdecho")
fdia (getvar "filedia")
osmo (getvar "osmode")
orth (getvar "orthomode")
plwi (getvar "plinewid")
pola (getvar "polarmode")
tsty (getvar "textstyle")) ;_ end of setq
) ;_ end of defun
(defun traBHT ()
(setvar "autosnap" auts)
(setvar "blipmode" blip)
(setvar "cecolor" ceco)
(setvar "clayer" clay)
(setvar "cmdecho" cmec)
(setvar "filedia" fdia)
(setvar "osmode" osmo)
(setvar "orthomode" orth)
(setvar "plinewid" plwi)
(setvar "polarmode" pola)
(setvar "textstyle" tsty)
) ;_ end of defun
;---
;;Tao lop theo danh sach di kem
(defun taolop (dslop)
(mapcar '(lambda (a) (if (null (tblsearch "layer" a)) (command "layer" "N" a ""))) dslop)
)
;-----
;Ham tao text
(defun taochu (noidung lop mau diem caochu kieu / x y)
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop) (cons 62 mau)
(cons 100 "AcDbText") (list 10 x y 0.0) (cons 40 caochu)
(cons 1 noidung) (cons 7 kieu))))
) ;defun
(defun Ndait_addtext (noidung lop mau diem caochu goc kieu canhchu / x y va ha)
(cond
((= canhchu "L") (setq va 0 ha 0));Left
((= canhchu "C") (setq va 0 ha 1));Center
((= canhchu "R") (setq va 0 ha 2));Right
;((= canhchu "A") (setq va 0 ha 3));Aligned
((= canhchu "M") (setq va 0 ha 4));Middle
;((= canhchu "F") (setq va 0 ha 5));Fit
((= canhchu "TL") (setq va 3 ha 0));Top Left
((= canhchu "TC") (setq va 3 ha 1));Top Center
((= canhchu "TR") (setq va 3 ha 2));Top Right
((= canhchu "ML") (setq va 2 ha 0));Middle Left
((= canhchu "MC") (setq va 2 ha 1));Middle Center
((= canhchu "MR") (setq va 2 ha 2));Middle Right
((= canhchu "BL") (setq va 1 ha 0));Bottom Left
((= canhchu "BC") (setq va 1 ha 1));Bottom Center
((= canhchu "BR") (setq va 1 ha 2));Bottom Right
(T (setq va 0 ha 0));canhchu false -> Left
);cond
(if (null (tblsearch "style" kieu)) (setq kieu (getvar "textstyle")))
(if (null goc) (setq goc 0.0))
(if (null caochu) (setq caochu 1.0))
(if (null diem) (progn (initget 1) (setq diem (getpoint "\npick point :"))))
(if (null mau) (setq mau 256))
(if (null lop) (setq lop (getvar "clayer")))
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop)
(cons 62 mau) (cons 100 "AcDbText") (list 10 x y 0.0)
(cons 40 caochu) (cons 50 goc)(cons 1 noidung) (cons 7 kieu)
(cons 72 ha) (list 11 x y 0.0) (cons 100 "AcDbText") (cons 73 va))))
);defun
;Tra ve so lon nhat trong danh sach a
(defun maximum (a)
(setq i 0 maxa (max (nth 0 a) (nth 1 a)))
(repeat (length a) (setq maxa (max (nth i a) maxa)) (setq i (1+ i)))
maxa)
;;Doi so thuc sang chuoi (giong rtos)
;;VD (trtos 1.05 3) -> "1.050"
(defun trtos (Num dec / HSLT N0 N1 N2 N3 them0 them1 CHU)
(setq HSLT dec N0 (+ Num 0.000000001) N1 (- N0 (fix N0)) N2 (rtos N1 2 HSLT)
N3 (- (strlen N2) 2) them0 "." them1 "")
(if (>= N3 HSLT)
(setq CHU (rtos N0 2 HSLT))
(if (= N3 -1)
(setq CHU (strcat (rtos N0 2 HSLT)
(if (= HSLT 0)
(setq them0 "") (repeat HSLT (setq them0 (strcat them0 "0"))))))
(setq CHU (strcat (rtos N0 2 HSLT)
(repeat (- HSLT N3) (setq them1 (strcat them1 "0")))))
);if
);if
CHU)
;the end


ps: trên máy người dùng nhất định phải có font Aptima (vaptimn.ttf) nếu không lsp sẽ bị lỗ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

Hề hề hề,

Muốn cụ thì có cụ :

Xin lỗi bác Duy vì mình chôm ít đồ của bác để xài cho nó lẹ. Có chỉnh sửa chút chút cho nó hợp với mưu đồ của chủ thớt.

http://www.cadviet.com/upfiles/3/5194_taobangtoadotrichthua.lsp

 

 
(defun c:lbtd (/ oldos en enlst e1 i n dvbd db1 dth dtn)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuyen gia tri goc tu do sang radian
;;;Cu phap su dung (duy:s_do>radian giatri)
;;;giatri la goc tinh theo do, kq la goc tinh theo radian
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_do>radian (gt / gt kq)
(setq kq (* (/ pi 180) gt))
kq)
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi text
;;;Cu phap su dung (duy:t_text diemchen docao gocquay canhle noidung textstyle layer color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_text (d c g cl nd k la co / d c g cl nd k la co)
(cond
((= cl "trai") (setq kcl 0))
((= cl "phai") (setq kcl 2))
((= cl "giua") (setq kcl 1))
)
(cond ((= g "") (setq g 0) ))
(cond ((= cl "") (setq kcl 0) ))
(setq g (duy:s_do>radian g))
(cond ((= k "") (setq k (getvar "TEXTSTYLE")) ))
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(entmake (list (cons 0 "TEXT")(cons 10 d)(cons 11 d)(cons 40 c)(cons 50 g)(cons 72 kcl)(cons 1 nd)(cons 7 k)(cons 8 la)
 
(cons 62 co)))
(princ)
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi line
;;;Cu phap su dung (duy:t_line diemdau diemcuoi layer color ltype ltypescale)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_line (a b la co lt slt / a b la co lt slt)
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= lt "") (setq lt "bylayer") ))
(cond ((= slt "") (setq slt 1) ))
(entmake (list (cons 0 "LINE")(cons 10 a)(cons 11 <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/cool.png' class='bbc_emoticon' alt='B)' />(cons 8 la)(cons 62 co)(cons 6 lt)(cons 48 slt) ))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vepolyline (/ i)
(setq i 0)
(command "pline")
(while (setq p (getpoint (strcat "\n Chon dinh thu " (rtos (setq i (1+ i)) 2 0) " <Enter de ket thuc>")))
	(command p)
)
(command "c")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(alert "\n Chon lan luot cac dinh cua thua dat can lap bang toa do")
(command "undo" "be")
(vepolyline)
(setq en (entlast) i 0
          enlst (acet-geom-vertex-list en)
          n (length enlst) )
 
(setq dvbd (getpoint "\nChon diem dat bang: "))
(duy:t_line dvbd (list (+ (car dvbd) 30) (cadr dvbd)) "" "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 5)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 0) (- (cadr dvbd) 0)) (list (+ (car dvbd) 0) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 0)) (list (+ (car dvbd) 23) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 26.5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 30) (- (cadr dvbd) 0)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2.5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 14) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 14) (- (cadr dvbd) 5)) "" "" "" "")
 
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 3)) 1 0 "giua" "§Ønh" "" "" "")
(duy:t_text (list (+ (car dvbd) 14) (- (cadr dvbd) 1.75)) 1 0 "giua" "Täa §é" "" "" "");;;"Täa §é"
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "X (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "Y (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 1.75)) 1 0 "giua" "Tªn" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 1.75)) 1 0 "giua" "C¹nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 4.25)) 1 0 "giua" "C¹nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 4.25)) 1 0 "giua" "(m)" "" "" "")
 
(setq dvbd (list (car dvbd) (- (cadr dvbd) 5)))
(setq db1 dvbd)
 
(while (< i (1- n))
	(setq dtn (nth i enlst))
	(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (setq i (1+ i)) 2 0) "" "" "")
	(duy:t_text dtn 1 0 "giua" (rtos  i  2 0) "" "" "")    
	(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr dtn) 2 3) "" "" "")
	(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car dtn) 2 3) "" "" "")              
	(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
	(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 3)) (list (+ (car dvbd) 30) (- (cadr dvbd) 3)) "" "" "" "")
	(setq e1 (entlast))
	(if (> i 1)
 		(progn
                  (duy:t_text (list (+ (car dvbd) 24.8) (- (cadr dvbd) 0.5)) 1 0 "giua"
                                    (strcat (rtos (1- i) 2 0) "-" (rtos i 2 0)) "" "" "")
                  (duy:t_text (list (+ (car dvbd) 28.3) (- (cadr dvbd) 0.5)) 1 0 "giua" (rtos (distance dtn dth) 2 2) "" "" "")
 		)
	)
	(setq dth dtn)
    
	(setq dvbd (list (car dvbd) (- (cadr dvbd) 2)))
)
(command "erase" e1 en "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" "1"  "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr (nth 0 enlst)) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car (nth 0 enlst)) 2 3) "" "" "")              
(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 30) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (cadr dvbd) 0.5)) 1 0 "giua" (strcat (rtos i 2 0) "-1" ) "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (cadr dvbd) 0.5)) 1 0 "giua" (rtos (distance (nth 0 enlst) dth) 2 2) "" "" "")
(duy:t_line db1 (list (car db1) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 5) (cadr db1) ) (list (+ (car dvbd) 5) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 14) (cadr db1) ) (list (+ (car dvbd) 14) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 23) (cadr db1) ) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 26.5) (cadr db1) ) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 30) (cadr db1) ) (list (+ (car dvbd) 30) (- (cadr dvbd) 2)) "" "" "" "")
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

1. Nhờ anh xem lại lisp dùm em làm nó ra thế này: Chon diem dat bang: ; error: no function definition: DUY:T_LINE

2. Chế độ truy bắt điểm không thực hiện đuợc.

3. Nếu được anh bổ sung thêm phần chọn chiều cao chữ và chế độ số thập phân sau dấu phẩy

4. Phần xuất bảng toạ độ anh thêm dùm 2 lựa chọn ;(cad /Excel)

     Câu lệnh như sau khi chèn trên cad xong enter (cad /Excel), xuất trên Excel chỉ cần lây giá trị text .

     thế là xong!

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

Mình đang dùng lsp này. Bạn nào đang làm địa chính vẽ 1/500 in 2=1 thì dùng rất phù hợp.  Còn in tỷ lệ khac thì chỉnh lại code lsp là đc

Lệnh như sau :

ghitd (Xuất bảng tọa độ góc ranh theo cách pick điểm tuần tự do ng dùng chỉ định)

laytd (Xuất bảng tọa độ theo cách ng dùng pick chọn 1 điểm trong vùng muốn xuất tọa độ. kết quả xuất ra bảng tọa độ theo nguyên tắc lấy điểm thứ 1 là điểm cao nhất và chạy tọa độ cùng chiều kim đồng hồ )


;Ndaitfunc 2013

;Viet boi : Ndait Nguyen

;;-------------------------------------------------------

;Ghi toa do tu dong theo chieu kim dong ho

(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1

p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17)

(luuBHT)

(setq p (getpoint "\nPick point :"))

(setvar "osmode" 0)

(taolop '("vunglaytd" "diemtd" "texttd"))

(setvar "clayer" "vunglaytd")

(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")

(if (/= p nil) (command "-Boundary" p "" ));end if

(setq bound (entget (entlast)))

(setq k (cdr (assoc 90 bound)))

(setq lstpt '() lstx '() lsty '() newlst '())

(setq i 1)

(while (<= i k)

(progn

(setq bien (assoc 10 bound))

(setq t1 (member bien bound))

(setq p1 (car t1))

(setq bound (cdr t1))

(setq diem (cdr p1))

(setq x (car diem) y (cadr diem))

(setq lstx (append lstx (list x)) lsty (append lsty (list y)))

(setq lstpt (append lstpt (list diem)))

(setq i (+ 1 i))));while

(setq ymax (maximum lsty))

(setq kmax (vl-position ymax (reverse lsty)))

(setq lstpt (reverse lstpt))

(setq newlst (member (nth kmax lstpt) lstpt))

(setq n 0)

(repeat kmax (setq newlst (append newlst (list (nth n lstpt)))) (setq n (+ 1 n)))

(setq c 0 new '())

(foreach name newlst (setq new (append new (list (append (list (setq c (1+ c))) name)))))

(setq c 1 new (append new (list (nth 0 new))))

(setq ltext '())

(setq ltext (append ltext (list (nth 0 new))))

(setq newlst (append newlst (list (nth 0 newlst))))

(repeat (- (length new) 1)

(setq ltext (append ltext (list (append (nth c new)

(list (distance (append (nth (- c 1) newlst) '(0.0)) (append (nth c newlst) '(0.0))))))))

(setq c (1+ c)));repeat

(setq n 0)

(setvar "clayer" "diemtd")

(repeat (- (length new) 1)

(ndait_addtext (itoa (car (nth n new))) "texttd" 256 (cdr (nth n new)) 1.0 0.0 "aptima" "BL")

(command "CIRCLE" (cdr (nth n new)) "0.25" "")

(setq n (1+ n)));repeat

(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))

(if (null diemve)

(prompt "\nKhong ve bang ! ")

(progn

(setvar "osmode" 0)

(setvar "orthomode" 0)

(taolop '("Text_Bang" "Line_Bang"))

(setq pt diemve)

(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")

(command "layer" "s" "Line_Bang" "")

(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))

(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))

(setq p1 p

p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)

p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)

P4 (polar p3 0.0 7.0)

p5 (polar p4 0.0 9.0)

p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5))

(setq pt2 (polar pt1 0.0 5.5)

pt3 (polar pt2 0.0 18.0)

pt4 (polar pt3 0.0 5.5)

pt5 (polar pt2 (* 1.5 Pi) 2.5)

pt6 (polar pt5 0.0 9.0)

pt7 (polar pt6 0.0 9.0)

pt8 (polar pt1 (* 1.5 Pi) 5.0)

pt9 (polar pt8 0.0 5.5)

pt10 (polar pt9 0.0 9.0)

pt11 (polar pt10 0.0 9.0)

pt12 (polar pt11 0.0 5.5))

(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")

(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")

(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")

(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")

(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")

(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")

(command "layer" "s" "Line_Bang" "")

(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "")

(command "line" pt2 pt3 "")

(command "line" pt5 pt9 "")

(command "line" pt6 pt10 "")

(command "line" pt7 pt11 "")

(setq pt (polar pt (* 1.5 pi) 6.9))

(setq i 0)

(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))

(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25)))

(setq pt14 (polar pt13 0.0 5.5)

pt15 (polar pt14 0.0 9.0)

pt16 (polar pt15 0.0 9.0)

pt17 (polar pt16 0.0 5.5))

(command "layer" "s" "Line_Bang" "")

(command "line" pt8 pt13 pt14 pt9 "")

(command "line" pt14 pt15 pt10 "")

(command "line" pt15 pt16 pt11 "")

(command "line" pt16 pt17 pt12 "")

));if

(traBHT)

(princ))

;;----------------------------------------------------------------

;;;Xuat so lieu toa do diem ra file va danh so thu tu

(defun c:ghitd (/ SBD DIEMDAU pt pt0 canh diem text text0 dspt ltext DIEMCUOI Tongdiem diemve i f fl)

(luuBHT)

;(setq TL (getvar "userr1"))

;(if (<= TL 0.0) (tyle))

(setvar "cmdecho" 0) (setvar "cecolor" "256")

(setq dspt '() ltext '() pt0 nil canh nil)

(Setq SBD (getint "\n Nhap so hieu diem bat dau ghi toa do : <Enter=1> "))

(if (null SBD) (setq SBD 1) (setq SBD SBD))

(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")

(taolop '("MiaP" "MiaT"))

(SETQ DIEMDAU SBD)

(while (setq pt (getpoint (strcat "\n Chon diem toa do : <Mia so " (itoa SBD) "> (Enter de ket thuc)")))

(if (not (null pt0)) (setq canh (distance pt0 pt)))

(setq pt0 pt)

(setq diem (strcat (itoa SBD) " " (trtos (car pt) 3) " " (trtos (cadr pt) 3)))

(setq text (list SBD (car pt) (cadr pt) canh))

(command "layer" "s" "MiaP" "")

(command "point" pt "")

(command "CIRCLE" pt "0.25" "")

(taochu (itoa SBD) "MiaT" 256 pt 1.0 "Aptima")

(setq SBD (1+ SBD))

(setq dspt (append dspt (list diem)))

(setq ltext (append ltext (list text)))

);end while

(setq text0 (nth 0 ltext))

(setq canh (distance (list (nth 1 text0) (nth 2 text0) 0) pt0))

(Setq text (list (nth 0 text0) (nth 1 text0) (nth 2 text0) canh))

(setq ltext (append ltext (list text)))

(setq Tongdiem (itoa (- SBD diemdau)))

(SETQ DIEMCUOI (- SBD 1))

(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))

(if (null diemve)

(prompt "\nKhong ve bang ! ")

(progn

(setvar "osmode" 0)

(setvar "orthomode" 0)

(taolop '("Text_Bang" "Line_Bang"))

(setq pt diemve)

(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH"

"Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")

(command "layer" "s" "Line_Bang" "")

(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))

(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))

(setq p1 p

p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)

p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)

P4 (polar p3 0.0 7.0)

p5 (polar p4 0.0 9.0)

p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5)) ;_ end of setq

(setq pt2 (polar pt1 0.0 5.5)

pt3 (polar pt2 0.0 18.0)

pt4 (polar pt3 0.0 5.5)

pt5 (polar pt2 (* 1.5 Pi) 2.5)

pt6 (polar pt5 0.0 9.0)

pt7 (polar pt6 0.0 9.0)

pt8 (polar pt1 (* 1.5 Pi) 5.0)

pt9 (polar pt8 0.0 5.5)

pt10 (polar pt9 0.0 9.0)

pt11 (polar pt10 0.0 9.0)

pt12 (polar pt11 0.0 5.5)) ;_ end of setq

(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")

(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")

(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")

(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")

(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")

(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")

(command "layer" "s" "Line_Bang" "")

(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "") ;_ end of command

(command "line" pt2 pt3 "")

(command "line" pt5 pt9 "")

(command "line" pt6 pt10 "")

(command "line" pt7 pt11 "")

(setq pt (polar pt (* 1.5 pi) 6.9))

(setq i 0)

(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))

(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25))

pt14 (polar pt13 0.0 5.5)

pt15 (polar pt14 0.0 9.0)

pt16 (polar pt15 0.0 9.0)

pt17 (polar pt16 0.0 5.5))

(command "layer" "s" "Line_Bang" "")

(command "line" pt8 pt13 pt14 pt9 "")

(command "line" pt14 pt15 pt10 "")

(command "line" pt15 pt16 pt11 "")

(command "line" pt16 pt17 pt12 "")))

(if (/= (setq f (getstring "\n<Ten FILE> luu toa do diem , Go <ENTER> neu khong luu : ")) "")

(progn

(if (findfile f) (setq fl (open f "a")) (setq fl (open f "w")))

(write-line "DANH SACH TOA DO DIEM " fl)

(write-line (strcat "File name : " (getvar "dwgprefix") (getvar "dwgname")) fl)

(write-line (strcat "TONG SO DIEM : " Tongdiem) fl)

(write-line (strcat "DIEM DAU : " (itoa DIEMDAU) " DIEM CUOI : " (itoa DIEMCUOI)) fl)

(setq i 0)

(repeat (length dspt) (write-line (nth i dspt) fl) (setq i (1+ i)))))

(if fl (close fl))

(traBHT)

(princ))

;;Dung cho ham ghitd

(defun ghihang (point hang / p p1 p2 p3 pt pt2 pt3 pt4 pt5 t1 t2 t3 t4)

(setq pt point

p (polar (polar pt 0.0 2.0) (/ pi 2.0) 0.25)

t1 (rtos (car hang) 2 0)

t2 (trtos (cadr hang) 3)

t3 (trtos (cadr (cdr hang)) 3))

(if (not (null (nth 3 hang))) (setq t4 (trtos (nth 3 hang) 2)))

(setq p1 p

p2 (polar p1 0.0 12.0)

p3 (polar p2 0.0 8.5)

p4 (polar (polar p3 0.0 5.5) (* 0.5 Pi) 1.0))

(taochu t1 "Text_Bang" 256 p1 0.9 "aptima")

(Ndait_addtext t3 "Text_Bang" 256 p2 0.9 nil "aptima" "R")

(Ndait_addText t2 "Text_Bang" 256 p3 0.9 nil "aptima" "R")

(if (not (null t4)) (Ndait_addText t4 "Text_Bang" 256 p4 0.9 nil "aptima" "R")));end of defun

;-----------------------------------

;Cac ham dung chung

;;Luu va tra bien he thong

(defun luuBHT ()

(setq

auts (getvar "autosnap")

blip (getvar "blipmode")

ceco (getvar "cecolor")

clay (getvar "clayer")

cmec (getvar "cmdecho")

fdia (getvar "filedia")

osmo (getvar "osmode")

orth (getvar "orthomode")

plwi (getvar "plinewid")

pola (getvar "polarmode")

tsty (getvar "textstyle")) ;_ end of setq

) ;_ end of defun

(defun traBHT ()

(setvar "autosnap" auts)

(setvar "blipmode" blip)

(setvar "cecolor" ceco)

(setvar "clayer" clay)

(setvar "cmdecho" cmec)

(setvar "filedia" fdia)

(setvar "osmode" osmo)

(setvar "orthomode" orth)

(setvar "plinewid" plwi)

(setvar "polarmode" pola)

(setvar "textstyle" tsty)

) ;_ end of defun

;---

;;Tao lop theo danh sach di kem

(defun taolop (dslop)

(mapcar '(lambda (a) (if (null (tblsearch "layer" a)) (command "layer" "N" a ""))) dslop)

)

;-----

;Ham tao text

(defun taochu (noidung lop mau diem caochu kieu / x y)

(setq x (car diem) y (cadr diem))

(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop) (cons 62 mau)

(cons 100 "AcDbText") (list 10 x y 0.0) (cons 40 caochu)

(cons 1 noidung) (cons 7 kieu))))

) ;defun

(defun Ndait_addtext (noidung lop mau diem caochu goc kieu canhchu / x y va ha)

(cond

((= canhchu "L") (setq va 0 ha 0));Left

((= canhchu "C") (setq va 0 ha 1));Center

((= canhchu "R") (setq va 0 ha 2));Right

;((= canhchu "A") (setq va 0 ha 3));Aligned

((= canhchu "M") (setq va 0 ha 4));Middle

;((= canhchu "F") (setq va 0 ha 5));Fit

((= canhchu "TL") (setq va 3 ha 0));Top Left

((= canhchu "TC") (setq va 3 ha 1));Top Center

((= canhchu "TR") (setq va 3 ha 2));Top Right

((= canhchu "ML") (setq va 2 ha 0));Middle Left

((= canhchu "MC") (setq va 2 ha 1));Middle Center

((= canhchu "MR") (setq va 2 ha 2));Middle Right

((= canhchu "BL") (setq va 1 ha 0));Bottom Left

((= canhchu "BC") (setq va 1 ha 1));Bottom Center

((= canhchu "BR") (setq va 1 ha 2));Bottom Right

(T (setq va 0 ha 0));canhchu false -> Left

);cond

(if (null (tblsearch "style" kieu)) (setq kieu (getvar "textstyle")))

(if (null goc) (setq goc 0.0))

(if (null caochu) (setq caochu 1.0))

(if (null diem) (progn (initget 1) (setq diem (getpoint "\npick point :"))))

(if (null mau) (setq mau 256))

(if (null lop) (setq lop (getvar "clayer")))

(setq x (car diem) y (cadr diem))

(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop)

(cons 62 mau) (cons 100 "AcDbText") (list 10 x y 0.0)

(cons 40 caochu) (cons 50 goc)(cons 1 noidung) (cons 7 kieu)

(cons 72 ha) (list 11 x y 0.0) (cons 100 "AcDbText") (cons 73 va))))

);defun

;Tra ve so lon nhat trong danh sach a

(defun maximum (a)

(setq i 0 maxa (max (nth 0 a) (nth 1 a)))

(repeat (length a) (setq maxa (max (nth i a) maxa)) (setq i (1+ i)))

maxa)

;;Doi so thuc sang chuoi (giong rtos)

;;VD (trtos 1.05 3) -> "1.050"

(defun trtos (Num dec / HSLT N0 N1 N2 N3 them0 them1 CHU)

(setq HSLT dec N0 (+ Num 0.000000001) N1 (- N0 (fix N0)) N2 (rtos N1 2 HSLT)

N3 (- (strlen N2) 2) them0 "." them1 "")

(if (>= N3 HSLT)

(setq CHU (rtos N0 2 HSLT))

(if (= N3 -1)

(setq CHU (strcat (rtos N0 2 HSLT)

(if (= HSLT 0)

(setq them0 "") (repeat HSLT (setq them0 (strcat them0 "0"))))))

(setq CHU (strcat (rtos N0 2 HSLT)

(repeat (- HSLT N3) (setq them1 (strcat them1 "0")))))

);if

);if

CHU)

;the end

 

ps: trên máy người dùng nhất định phải có font Aptima (vaptimn.ttf) nếu không lsp sẽ bị lỗi.

 Muốn thêm đuờng line ngăn cách giữa các toạ độ thì làm thế nào anh

phần ghitd muốn có hình tròn khi pick điểm và số thứ tự thì làm thế nào

Các pro giúp với. thanks

  • Vote giảm 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

Tọa độ địa chính thì như mình đã nói, không có gì phải bàn cả.

Nếu muốn sửa độ lớn của chữ thì bạn tìm dòng như vầy :

(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")

sửa giá trị 1.0 đi là đc.

PS: Nếu bạn muốn Trục XY như cũ thì hoặc là sửa code hoặc là move cột X thành Y thôi

À mà mình thấy có lẽ bạn cần cái này để lấy tọa độ diểm phải không ?


(defun c:T_id ()

(luuBHT) (setvar "cmdecho" 0)

(initget 1) (setq point01 (getpoint "\nChon diem 1 : \n"))

(setq x1 (rtos (car point01) 2 3) y1 (rtos (cadr point01) 2 3))

(setvar "osmode" 0)

(initget 1) (setq point02 (getpoint point01 "\nChon diem 2 :\n :"))

(setq Angle12 (angle Point01 Point02) dis12 (distance point01 point02))

(if (and (> Angle12 (/ pi 2)) (< Angle12 (* pi 1.5)))

(progn (setq Angle0 pi) (setq Jus "BR"))

(progn (setq Angle0 0.0) (setq Jus "BL")));end if

(setq Point03 (polar (polar Point01 Angle12 dis12) (/ pi 2) 0.275))

(taolop '("Hientrang")) (command "layer" "s" "Hientrang" "")

(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")

(command "pline" point01 "w" 0.0 0.4 (polar Point01 Angle12 1) "w" 0.0 0.0

(polar Point01 Angle12 dis12)

(polar (polar Point01 Angle12 dis12) Angle0 10.5) "")

(command ".text" Jus Point03 1.0 0.0 (strcat "X = " x1) "")

(command ".text" Jus (polar Point03 (* pi 1.5) 2.5) 1.0 0.0 (strcat "Y = " y1) "")

(traBHT) (princ))

(Không có vòng tròn như bạn vì công việc của mình không cần vòng tròn đó )

 Nhờ anh xem dùm em dùng mà nó bị lỗi như sau: Command: T_id , ; error: no function definition: LUUBHT

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

 Nhờ anh xem dùm em dùng mà nó bị lỗi như sau: Command: T_id , ; error: no function definition: LUUBHT

Thiếu 2 hàm: LuuBHT và traBHT

Bạn mở file lên xóa 2 hàm đó đi

xóa 2 dong này

(LuuBHT)

(traBHT)

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

Thiếu 2 hàm: LuuBHT và traBHT

Bạn mở file lên xóa 2 hàm đó đi

xóa 2 dong này

(LuuBHT)

(traBHT)

 

Đã xóa như bạn nói nhưng vẫn lỗi như sau:

Command: t_id
Chon diem 1 :
Chon diem 2 :
 :; error: no function definition: TAOLOP

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

TaiNguyen79 nếu bạn co tron bộ Ndaitfunc 2013 cho minh với nhé (trước đây mình có bộ 2009 nhưng nay nó bị virut tân công không su dung được) nên tha thiết xin ban cho minh trọn bộ nay nhe (trkhanh.8321@gmail.com) cảm ơn bạn nhiều.

( Yêu cầu bài viêt sử dụng cỡ chữ mặc định của diễn đàn, không bôi đậm 1 cách không cần thiết bài viết ) - Danh Công

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


×