namgiangduy89
-
Số lượng nội dung
57 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi namgiangduy89
-
-
lựa chon thứ 3 là cad and excel đó. chỉ xuất tọa độ trên cad còn excel không thấy có dấu hiệu nào.
-
Tôi bổ sung thêm dòng này vào code của a Tr.CongSon theo yêu cầu của bạn.
(command "circle" D1 (* 0.2 caot1) "")
http://www.cadviet.com/upfiles/5/139246_ttd.lsp
đã loád lisp nhưng bị lỗi như sau: Anh cho em hỏi làm sao để đưa lisp lên diễn đàn có nút download như mọi người
:[cmd : TTD] - THONG KE TOA DO
Edit : @ Trần Công Sơn _ XDDD & CN; error: malformed list on inputCommand: -
Phải tạo block ha anh, lisp trên không sữa đuợc ha
-
Ok anh đã đuợc ,nhờ anh xem dùm em ở câu lệnh thứ 3 với
-
Không ai có lisp giống như hình ha, bạn nào có cho mình với.thanks
-
2
-
-
vậy phải làm sao bạn. mình tự chỉnh ha
-
Vẫn báo lỗi như trên anh oi
-
Bạn chỉnh dùm mình
1. Lisp này toạ độ x, y bị đảo lôn ,không giống của mình
2. Không có số thập phân phía sau
3. Bạn thêm vòng tròn cho mình luôn với
-
2
-
-
Lisp thay đổi Att tăng dần 1 đơn vị cho các Block_Att được chọn theo Att được chọn đầu tiên.
;; Thay doi att tang dan 1 don vi cho cac block_att duoc chon theo att duoc chon dau tien. ;; Doan Van Ha - CadViet.com - ngay 26/7/2013 (vl-load-com) (defun C:HA( / ent ss tag lst pre suf int len num #SS->List #String:Split-First VxSetAtts) (defun #SS->List (ss / i lst) (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)))) (defun #String:Split-First (string symbol / i) (if (setq i (vl-string-position (ascii symbol) string)) (list (substr string 1 (1+ i)) (substr string (+ 2 i))) (list string))) (defun VxSetAtts (Obj Lst / AttVal) (mapcar '(lambda (Att) (if (setq AttVal (cdr (assoc (vla-get-TagString Att) Lst))) (vla-put-TextString Att AttVal))) (vlax-invoke Obj 'GetAttributes)) (vla-update Obj)) (if (and (setq ent (car (nentsel "\nChon Att So hieu cua ban ve dau tien: "))) (princ "\nChon cac Block theo thu tu de thay So hieu ban ve...") (setq ss (ssget '((0 . "Insert") (66 . 1))))) (progn (setq tag (cdr (assoc 2 (setq elist (entget ent))))) (setq lst (#String:Split-First (cdr (assoc 1 elist)) "-")) (setq pre (car lst)) (setq suf (cadr lst)) (setq int (atoi suf)) (setq len (strlen suf)) (foreach n (#SS->List ss) (setq num (itoa (setq int (1+ int)))) (repeat (- len (strlen num)) (setq num (strcat "0" num))) (VxSetAtts (vlax-ename->vla-object n) (list (cons tag (strcat pre num))))))))
sao mình làm load nó bị lỗi như vậy là gì ai chỉ dùm với:
APPLOAD ha.lsp successfully loaded.
Command: ; error: syntax errorCommand: -
Pro nào có lisp pick tọa độ như hình cho emm xin với.
-
MÌnh không rành về lisp , các tọa độ x, y khi xuất sang Excel có thể chia ra từng cột được không bạn, hay phai coppy làm thủ công
-
File excel của mình ra như vậy có giống bạn không, nó nằm chung hết một cột.
Nhờ bạn chỉ thêm cho mình, trường hợp mình muốn đổi tọa độ X thành Y thì phải sữa lisp ở dòng lệnh nào
-
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_idChon diem 1 :Chon diem 2 ::; error: no function definition: TAOLOP -
Cảm ơn Bác hiệp đã giúp, khi nào Bác có thời gian chỉnh dùm em để hoàn thiện luôn nha.
Câu lệnh thứ 3 Cad and excel em đã thử mà vẫn không đuợc, chỉ có cad đươc ah.
Phần xuất toạ độ sang Excel Bác chỉnh từng cột luôn cho em với.
-
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
-
Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D
>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/ (defun c:EC( / i p point lst key base_pnt last_pnt fn pw) ;Export Coordinates (setq i 1) (while (setq p (getpoint "\nPick Point: ")) (setq point p) (MakeText (itoa i) 2.5 0 "L" nil nil 1 nil) (setq p (list i (car p) (cadr p)) i (1+ i) lst (cons p lst))) (if (> (length lst) 2) (progn (initget "Cad Excel cadAndexcel") (setq key (NGT key "Cad" getkword "Enter an option [Cad/Excel/cad_And_excel]")) (cond ((wcmatch key "Cad") (setq #textheight (NGT #textheight 2 getint "Chieu cao chu")) (setq base_pnt (getpoint "\nDiem chen: ")) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil) ;;Xong tieu de (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil) (setq last_pnt (cdr (last lst))) ;;Xong dong 1 (foreach p (cdr (reverse lst)) (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil) ) ;;Xong cac diem giua (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil) ;;Xong lap lai dong 1 + k/cach khep ) ((wcmatch key "Excel") (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1)) (setq pw (open fn "w")) (write-line "STT,X,Y,K/cach (m)" pw) (write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw) (setq last_pnt (cdr (last lst))) (foreach p (cdr (reverse lst)) (write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw) ) (write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw) (close pw) ) (t (setq #textheight (NGT #textheight 2 getint "Chieu cao chu")) (setq base_pnt (getpoint "\nDiem chen: ")) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil) ;;Xong tieu de (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil) (setq last_pnt (cdr (last lst))) ;;Xong dong 1 (foreach p (cdr (reverse lst)) (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil) ) ;;Xong cac diem giua (setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil) (setq base_pnt (polar base_pnt 0 (* 5 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil) (setq base_pnt (polar base_pnt 0 (* 15 #textheight))) (H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil) ;;Xong lap lai dong 1 + k/cach khep ;;Xong chen bang trong cad (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1)) (setq pw (open fn "w")) (write-line "STT,X,Y,K/cach (m)" pw) (write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw) (setq last_pnt (cdr (last lst))) (foreach p (cdr (reverse lst)) (write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw) ) (write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw) (close pw) ) ) ) (princ "\n***** Phai pick >2 diem ! ***") ) (princ) ) ;;;End main ;=============================================================================================== (defun NGT(a mac_dinh ham str_nhac / modul) ;;Nhan gia tri (or a (setq a mac_dinh)) (setq a (cond ((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a) (modul) (a) ) ) ) ;===================== (defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point) ;================================= (defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "LINE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 62 (if Color Color 256)) (cons 10 PT1) (cons 11 PT2) (cons -3 (if xdata (list xdata) nil)))) );end ;================================= (if (null celheight) (setq celheight (+ textheight (* 2 offset)))) (setq pnt2 (polar base_pnt 0 celwidth) pnt3 (polar pnt2 (* 1.5 pi) celheight) pnt4 (polar pnt3 pi celwidth) ) (if justify (setq justify (strcase justify))) (cond ((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth)))) ((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2))))) ((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth)))) ((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth)))) ((wcmatch justify "TL") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset))) ((wcmatch justify "TC") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight)))) ((wcmatch justify "TR") (setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2))))) ((wcmatch justify "ML") (setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset))) ((wcmatch justify "MR") (setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset))) (t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2))))) ) (if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil)) (if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil)) (if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil)) (if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil)) (if string (MakeText string textheight Ang justify nil nil nil nil)) ) ;=================================== (defun MakeText (string Height Ang justify Style Layer Color xdata / Lst) ; Ang: Radial (setq Lst (list '(0 . "TEXT") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 Height) (cons 1 string) (cons 50 (if Ang Ang 0)) (cons 7 (if Style Style (getvar "Textstyle"))) (cons -3 (if xdata (list xdata) nil))) ;justify (strcase justify) ) (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))) ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3))))) ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3))))) ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3))))) ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2))))) ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))) ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2))))) ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1))))) ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1))))) ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))) ) (entmakex Lst) );end ;=================================
p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.
Phải chăng là do mình đã để ngõ tham số point trong đó.
Cảm ơn bác hiepttr nhiều cơ bản lisp đã gần đúng ý em, em đã text và nhờ bác chỉnh lại cho em tí.
1. Khoảng cách các cột Tọa độ X,Y , K/CÁCH hơi rộng
2. Các Text chưa được canh giữa.
3. Phần câu lệnh xuất bảng kết quả sang Cad thì đã Ok, còn xuất sang Excel em đã làm nhưng xuất sang excel nhìn rất rối( các số gộp lại chung một cột) bác có cách nào khắc phục không, nếu không bác chuyển qua định dạng TXT luôn để e chuyển vào máy toàn đạt cắm mốc luôn.
4. Câu lênh xuất kết quả trên Cad và excel thì chỉ thấy kết quả trên cad còn trên Excel không thấy dấu hiệu gì.
Tiện thể mình gỡi Bác File cad mình bố trí bảng kết quả để bác chỉnh lại kích thước cho phù hợp
-
1
-
-
Để lisp chạy bạn tạo 2 layer khung đuờng và text
-
Hề hề hề,
Đêm có tí đêm , ngày có tí ngày chớ bộ.
Đây là cái tí đêm hôm qua cho bạn nè:
(defun c:aaa (/ lacol ladin laos tl esty h tl1 cao1 k tdt ss pt p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 pa pt1 pt2 e ep et dtcon cvcon klcon klt klr kl0 cvt ten oldla) (setvar "cmdecho" 0) (setq lacol (getvar "CEColor")) (setq ladin (getvar "dimzin")) (setq laos (getvar "osmode")) (setq oldla (getvar "clayer")) (setq esty (tblsearch "style" (getvar "textstyle"))) (if (not tl) (setq tl 1)) (if (= (cdr (assoc 40 esty)) 0.0) (if (= (cdr (assoc 42 esty)) 0.0) (setq h 1) (setq h (cdr (assoc 42 esty))) ) (progn (setq h (cdr (assoc 40 esty))) (command "style" (getvar "textstyle") "" 0.0 "" "" "" "") ) ) (if (not kl0) (setq kl0 2500)) (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/")) caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")) klr (getreal (strcat "\n Khoi luong rieng < " (rtos kl0 2 2) " >: "))) (if tl1 (setq tl tl1)) (if caot1 (setq h caot1)) (if klr (setq kl0 klr) (setq klr kl0) ) (command "undo" "be") (setq k 0 tdt 0 cvt 0 klt 0) (setq ss (ssadd)) (setvar "dimzin" 0) (setvar "OSMODE" 0) (setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):")) (setq P1 (list (+ (car PT)(* 6 h)) (cadr PT)) P2 (list (+ (car PT)(* 22 h)) (cadr PT)) P3 (list (car PT) (- (cadr PT)(* 3 h))) P4 (list (car P1) (cadr P3)) P5 (list (car P2) (cadr P3)) P6 (list (+ (car PT)(* 45 h)) (+ (cadr PT)(* 2 h))) P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h))) P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h))) P9 (list (+ (car P2) (* 16 h)) (cadr P2)) P10 (list (+ (car P9) (* 16 h)) (cadr P9)) P11 (list (+ (car P10) (* 20 h)) (cadr P10)) P12 (list (+ (car P11) (* 16 h)) (cadr P11)) P13 (list (car P9) (cadr P5)) P14 (list (car P10) (cadr P5)) P15 (list (car P11) (cadr P5)) P16 (list (car P12) (cadr P5)) P17 (list (+ (car P8) (* 16 h)) (cadr P8)) P18 (list (+ (car P17) (* 16 h)) (cadr P8)) P19 (list (+ (car P18) (* 18 h)) (cadr P8)) P20 (list (+ (car P19) (* 18 h)) (cadr P8)) );setq (setvar "clayer" "khung duong") (command "pline" PT P12 P16 P3 "C" "pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "") (setvar "clayer" "text") (command "text" "m" P6 (* 1.35 h) 0 "BANG THONG KE TONG HOP" "text" "m" P7 (* 1.2 H) 0 "STT" "text" "m" P8 (* 1.2 h) 0 "TEN VUNG" "TEXT" "M" P17 (* 1.2 h) 0 "CHU VI (M)" "TEXT" "M" P18 (* 1.2 h) 0 "DIEN TICH (M2)" "TEXT" "M" P19 (* 1.2 h) 0 "KHOI LUONG (KG)" "TEXT" "M" P20 (* 1.2 h) 0 "GHI CHU" );command (setq PA (getstring "\n Ban chon phuong an chon doi tuong < 1 or 2 > : ")) (if (= pa "1") (setq pt1 (getpoint "\n Chon mien tinh dien tich : ")) (setq ep (car (setq e (entsel "\n Chon doi tuong la polyline kin"))) pt2 (cadr e) ) ) (while (or (/= pt1 nil) (/= ep nil) ) (setq k (+ 1 k)) (if pt1 (command "TEXT" "m" pt1 (* 1.2 h) 0 (rtos k 2 0)) ) (if ep (command "TEXT" "m" pt2 (* 1.2 h) 0 (rtos k 2 0)) ) (setq PT (list (car P3) (cadr P3) ) P1 (list (+ (car PT)(* 6 h)) (cadr PT)) P2 (list (+ (car PT)(* 22 h)) (cadr PT)) P3 (list (car PT) (- (cadr PT)(* 3 h))) P4 (list (car P1) (cadr P3)) P5 (list (car P2) (cadr P3)) ;;;;P6 (list (+ (car PT)(* 43 h)) (+ (cadr PT)(* 2 h))) P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h))) P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h))) P9 (list (+ (car P2) (* 16 h)) (cadr P2)) P10 (list (+ (car P9) (* 16 h)) (cadr P9)) P11 (list (+ (car P10) (* 20 h)) (cadr P10)) P12 (list (+ (car P11) (* 16 h)) (cadr P11)) P13 (list (car P9) (cadr P5)) P14 (list (car P10) (cadr P5)) P15 (list (car P11) (cadr P5)) P16 (list (car P12) (cadr P5)) P17 (list (+ (car P8) (* 16 h)) (cadr P8)) P18 (list (+ (car P17) (* 16 h)) (cadr P8)) P19 (list (+ (car P18) (* 18 h)) (cadr P8)) P20 (list (+ (car P19) (* 18 h)) (cadr P8)) );setq (if pt1 (progn (command "CECOLOR" 4 "-boundary" pt1 "" ) (setvar "CECOLOR" lacol) (setq et (entlast)) (ssadd et ss) (command "area" "e" "last") ) ) (if ep (command "area" "o" ep) ) ;;;;;;(setq et (entlast)) ;;;;;;(ssadd et ss) (setq dtcon (* (getvar "AREA") tl tl)) (setq tdt (+ dtcon tdt)) (setq cvcon (* (getvar "Perimeter") tl) cvt (+ cvt cvcon) klcon (* dtcon klr) klt (+ klt klcon) ten (strcat "\n VUNG " (rtos k 2 0)) ) (command "erase" ss "") (setvar "clayer" "khung duong") (command "pline" PT P3 P16 P12 "" "pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "") (setvar "clayer" "text") (command "text" "m" P7 h 0 (rtos k 2 0) "text" "m" P8 h 0 ten "TEXT" "M" P17 (* 1.0 h) 0 (rtos cvcon 2 2) "TEXT" "M" P18 (* 1.0 h) 0 (rtos dtcon 2 2) "TEXT" "M" P19 (* 1.0 h) 0 (rtos klcon 2 2) "TEXT" "M" P20 (* 1.0 h) 0 ten ) (if pt1 (setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh...")) ) (if ep (setq ep (car (setq e (entsel "\n Chon polyline tiep theo hoac enter de ket thuc lenh ..."))) pt2 (cadr e) ) ) );while (setq ss nil) (setvar "DIMZIN" ladin) (setq PT (list (car P3) (cadr P3)) P1 (list (+ (car PT)(* 6 h)) (cadr PT)) P2 (list (+ (car PT)(* 22 h)) (cadr PT)) P3 (list (car PT) (- (cadr PT)(* 3 h))) P4 (list (car P1) (cadr P3)) P5 (list (car P2) (cadr P3)) ;;;P6 (list (+ (car PT)(* 43 h)) (+ (cadr PT)(* 2 h))) P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h))) P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h))) P9 (list (+ (car P2) (* 16 h)) (cadr P2)) P10 (list (+ (car P9) (* 16 h)) (cadr P9)) P11 (list (+ (car P10) (* 20 h)) (cadr P10)) P12 (list (+ (car P11) (* 16 h)) (cadr P11)) P13 (list (car P9) (cadr P5)) P14 (list (car P10) (cadr P5)) P15 (list (car P11) (cadr P5)) P16 (list (car P12) (cadr P5)) P17 (list (+ (car P8) (* 16 h)) (cadr P8)) P18 (list (+ (car P17) (* 16 h)) (cadr P8)) P19 (list (+ (car P18) (* 18 h)) (cadr P8)) P20 (list (+ (car P19) (* 18 h)) (cadr P8)) );setq (setvar "clayer" "khung duong") (command "pline" PT P3 P16 P12 "" "pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "") (setvar "clayer" "text") (command "text" "m" P7 (* 1.1 h) 0 "TONG" "text" "m" P8 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG") "TEXT" "M" P17 (* 1.1 h) 0 (rtos cvt 2 2) "TEXT" "M" P18 (* 1.1 h) 0 (rtos tdt 2 2) "TEXT" "M" P19 (* 1.1 h) 0 (rtos klt 2 2) "TEXT" "M" P20 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG") ) (command "undo" "e") (setvar "OSMODE" laos) (setvar "clayer" oldla) (setvar "cmdecho" 1) (princ) )Hy vọng đúng ý bạn.Riêng cái vụ khối lượng thì không thể có đơn vị là kg/m được nên mình đã tự sửa thành kg. Nếu bạn không thích thì tự sửa lại nhé.
Để kiểm soát được vùng lấy diện tích ngoài điền số mong Tác giả bổ sung thêm phần tô màu vùng chọn để không xảy ra những sai lầm khi tính diện tích. Xin chân thành cảm ơn.
-
1
-
-
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
-
-
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!
-
Cảm ơn bác nhưng Lisp bị lỗi rồi, chọn được một điểm rồi mất tiêu luôn.
-
Mình làm phân chia lô nền nếu làm bằng excel sẽ tốn nhiều thời gian hơn, nếu có lisp hổ trợ sẽ nhanh hơn nhiều. Cảm ơn bạn đã cho ý kiến.
-
Nhờ các Pro viết dùm mình lisp như hình trên:
Khi pick điểm hiện ra các số thứ tự trên bảng vẻ,khi pick xong sẽ cho ngưòi dùng 3 lựa chọn.
1. Số thập phận 2 hoặc3 hoặc 4
2. xuất bảng trong Cad hoặc xuất sang excel
3.xuất bảng ra cad và excel luôn.
-
4
-
-
sao không được ta
-
1
-
Việt Hoá Autocad
trong Sách - Giáo trình - Tài liệu
Đã đăng · Trả lời báo cáo
đó là chương trình speed cad thì phải, bạn tự search trên google đi