Đến nội dung


Hình ảnh
* * * * - 5 Bình chọn

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


  • Please log in to reply
96 replies to this topic

#81 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 22 July 2013 - 05:08 PM

Ý 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...&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
  • 0

#82 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 23 July 2013 - 09:59 AM

Ý 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...&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)


  • 1

#83 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 23 July 2013 - 01:27 PM

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
  • 0

#84 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 23 July 2013 - 02:29 PM

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ố)
  • 1

#85 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 23 July 2013 - 10:51 PM

thực sự là ko biết nói gì hơn, chỉ một câu là em xin chân thành cảm ơn bác
  • 0

#86 thanhbdhl

thanhbdhl

    Edu level: li3

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

Đã gửi 10 December 2013 - 07:13 PM

Thì đây.
http://www.cadviet.c.../1285_btd_2.lsp

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


  • 0

#87 thanhbdhl

thanhbdhl

    Edu level: li3

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

Đã gửi 04 March 2014 - 02:08 PM

hu hu có sư phụ nào giúp e với không ạ


  • 0

#88 pgt

pgt

    biết zoom

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

Đã gửi 04 March 2014 - 11:14 PM

ý bạn chắc là cái này 

 

29482_hhhhh.png

 

29482_7.png


  • 0

Khi chúng ta cùng nhau - Không gì là không thể
http://ytuonglamgiau.vn 14.png


#89 mehonphap88

mehonphap88

    biết zoom

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

Đã gửi 27 March 2015 - 10:48 AM

em có thể xin file lisp này được không a? em cảm ơn

lisp tạo các diểm theo chiều thuận kim đồng hồ nha a

 

ý bạn chắc là cái này 

 

29482_hhhhh.png

 

29482_7.png


  • 0

#90 mehonphap88

mehonphap88

    biết zoom

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

Đã gửi 27 March 2015 - 11:07 AM

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.


  • 0

#91 mehonphap88

mehonphap88

    biết zoom

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

Đã gửi 27 March 2015 - 11:14 AM

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

http://www.cadviet.c...py_of_laytd.lsp

file này ạ


  • 0

#92 mehonphap88

mehonphap88

    biết zoom

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

Đã gửi 30 March 2015 - 04:33 PM

forum mình không còn ai online hết ah. moi ng ? :(


  • -1

#93 namgiangduy89

namgiangduy89

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: -19 (hơi kém)

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

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.c...dotrichthua.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" "&#167;&#216;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 14) (- (cadr dvbd) 1.75)) 1 0 "giua" "T&#228;a &#167;&#233;" "" "" "");;;"T&#228;a &#167;&#233;"
(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&#170;n" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 1.75)) 1 0 "giua" "C&#185;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 4.25)) 1 0 "giua" "C&#185;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!


  • 0

#94 namgiangduy89

namgiangduy89

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: -19 (hơi kém)

Đã gửi 21 November 2015 - 05:12 PM

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


  • -1

#95 namgiangduy89

namgiangduy89

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: -19 (hơi kém)

Đã gửi 22 November 2015 - 08:33 PM

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


  • 0

#96 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 23 November 2015 - 10:25 AM

 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)


  • 0

#97 namgiangduy89

namgiangduy89

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: -19 (hơi kém)

Đã gửi 23 November 2015 - 01:07 PM

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

  • 0