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

toiyeuvietnam

Thành viên
  • Số lượng nội dung

    76
  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi toiyeuvietnam


  1. Trong nội dung trả lời #14 em chạy đoạn đầu của lisp: chay thấy ok. nó đã lưu ra 1 file do mình đặt tên là hoanchinh.txt (tức là file số liệu thô đã được chuyển thành các trạm máy, điểm mia ra góc và cạnh). đúng ra chương trình sẽ tiếp tục chạy và phun điểm mia ra màn hình nếu như file số liệu hoanchinh.txt nó được khai báo các trạm máy lên trên hoặc ít nhất 2 trạm máy thì nó sẽ phun điểm mia ra màn hình rồi. Nó sẽ phải có file số liệu hoanchinh.txt như sau:

    TR A 1000.0000 1000.0000 (TR A và TR B phải khai báo ở trên đây nó mới hiểu và chạy)

    TR B 1013.225 1000.000 (TR A và TR B có thể cho tọa độ giả định cũng được và nó mặc định luôn 2 trạm máy này ở trên đây khi lưu file hoanchinh.txt của các xử lý đo khác!)

    TR A

    DH B 359.5958 13.225

    1 159.2151 12.830

    2 173.3153 10.333

    3 176.1120 7.545

    4 160.0905 8.767

    5 161.2952 6.784

    6 287.2502 1.664

    7 92.3453 1.446

    8 9.0236 8.322

    9 356.0835 8.282

    10 348.2042 7.823

    11 353.2437 13.805

    12 267.2044 8.623

    13 268.1017 12.724

    14 263.1002 17.713

    TR B

    DH A 0.0000 13.225

    15 57.1949 10.382

    16 64.2908 14.114

    17 79.5016 20.308

    18 123.4920 7.380

    19 139.5210 7.830

    .................................

    các anh có thể sửa giúp em trong cái lisp chế biến (CB) nó mặc định luôn dòng:

    TR A 1000.0000 1000.0000

    TR B 1200.0000 1000.0000

    sau đó nó sẽ nối tiếp là các số liệu đo lưu bình thường là

     

    TR A

    DH B 359.5958 13.225

    1 159.2151 12.830

    2 173.3153 10.333

    3 176.1120 7.545

    4 160.0905 8.767

    ...............................

    vậy coi như là số liệu đã ổn và phun ra màn hình!


  2. em cũng chỉ xin từ anh cùng làm bưa trước, nhưng giờ anh chuyển đi về sài gòn rồi mà em thì không liên hệ được.

    em mới đi làm lên không có kinh nghiệm gì cả, chỉ là cầm ghương cho máy anh đứng máy đọc. em rất muốn được làm thoăn thoắt như máy anh sử lý trên máy tinh, nhưng toàn phải học lỏm thôi!

    hay anh giúp em được không a? em biết anh không có nhiều thời gian cho nội dung của em nhưng em rất cảm kích khi anh quan tâm đến vấn đề nhỏ mà to với em!

    có file số liệu thô trút từ máy đo làm thế nào để xử lý phun điểm mia ra màn hình 1 cách nhanh nhất được anh nhỉ (ngoài cách em đã hỏi) anh có thể giúp được em chứ? em rất trân thành cảm ơn anh!

    đây là file số liệu trút từ máy đo topcom:

    http://www.cadviet.com/upfiles/3/89068_solieutho.txt


  3. Em tìm thấy hàm (defun DPGTOD rồi nhưng vẫn không được vậy bác ketxu nhỉ?

    	;******\\\\\\\\\**chuong trinh che bien cho may TOPCON 223*********\\\\\\\\\\\\\\*********////////
    	;khong dung chenh cao, chi su dung de thanh lap ban do dia chinh
    (defun c:chay()
    (c:cb) ;1
    (c:pdm) ;2
    (c:vl) ;3
    (c:tm) ;4
    (c:pdm) ;5
    )
    (defun c:cb (/ ch i FN FD sosanh j trammay
    ccmay tramdh ccguong canhng hm hg goctd
    canhb gocdung cd dem tam
    )
    (setq
    FN (getfiled "NhËp file nguån : "
    ""
    ""
    4
    )
    )
    (setq i (strlen FN))
    (setq ch "")
    (while (/= ch "\\")
    (setq ch (substr FN i 1))
    (setq i (- i 1))
    )
    (setq xuat (substr FN 1 (+ i 1)))
    (setq FD (strcat (getstring "Nhap ten file ket qua  (khong can .txt): ") ".txt" ) )
    (setq FD (strcat xuat FD))
    (setq FD (open FD "w"))
    ; (setq mo (getreal "Nhap sai so MO cua may (giay) : "))
    (if (= mo nil)
    (progn (setq mo 0)
    (princ "\n")
    (princ " Lay MO=0")
    (princ "\n")
    )
    )
    (setq mo (/ mo 3600))
    (setq FN (open FN "r"))
    (while (and (setq PR (read-line FN)) (/= PR ""))
    (progn
    (setq i 1)
    (setq sosanh "")
    (setq ch "")
    (while (/= ch " ")
    (setq ch (substr PR i 1))
    (setq i (+ i 1))
    )
    (setq sosanh (substr PR 1 (- i 2)))
    (cond ((= sosanh "STN")
    (progn
    ;///////////////////////lay ten tram may//////////
    (setq j i)
    (while (/= ch ",")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    (if (or (= ch "`") (= ch " "))
    (setq i j)
    )
    )
    (setq trammay (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao may/////////
    (setq i j)
    (while (/= ch "")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    )
    (setq ccmay (substr PR i (- j i 2)))
    (write-line (strcat "TR " trammay) FD)
    ) ;end progn
    ) ;end cond1
    ((= sosanh "BS")
    (progn
    ;///////////////////////lay ten tram dinh huong//////////
    (setq j i)
    (while (/= ch ",")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    (if (or (= ch "`") (= ch " "))
    (setq i j)
    )
    )
    (setq tramdh (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao guong/////////
    (setq i j)
    (while (/= ch "")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    )
    (setq ccguong (substr PR i (- j i 2)))
    (setq tam "bs")
    ) ;end progn
    ) ;end cond2
    ((= sosanh "SD")
    (progn
    (setq j i)
    (while (/= ch ",")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    (if (= ch " ")
    (setq i j)
    )
    )
    (setq gocbang (substr PR i (- j i 1)))
    ;///////////////////////////////
    (setq i j)
    (setq j (+ j 2))
    (setq ch "")
    (while (/= ch ",")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    )
    (setq goctd (substr PR i (- j i 1)))
    ;////////////////////////////////
    (setq i j)
    (setq j (+ j 2))
    (setq ch " ")
    (while (/= ch "")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    )
    (setq canhng (substr PR i (- j i 1)))
    ;/////////////////////////////////////
    (setq hg (atof ccguong))
    (setq hm (atof ccmay))
    (setq gocdung (- (- 90.0 (dpgtod (atof goctd))) mo))
    (setq gocdung (/ (* gocdung pi) 180))
    (setq canhng (atof canhng))
    (setq canhb (* canhng (cos gocdung)))
    (setq h (+ (- hg hm) (* canhng (sin gocdung))))
    (setq cd (strlen gocbang))
    (setq i cd)
    (setq dem 0)
    (setq ch "")
    (while (/= ch ".")
    (setq ch (substr gocbang i 1))
    (setq i (- i 1))
    (setq dem (+ dem 1))
    )
    (if (= dem 6)
    (setq gocbang (substr gocbang 1 (- cd 1)))
    )
    (if (= tam "bs")
    (write-line
    (strcat "DH "
    (dd tramdh)
    (dd gocbang)
    " "
    (rtos canhb 2 3)
    )
    FD
    )
    (write-line
    (strcat (dd stt)
    (dd gocbang)
    " "
    (rtos canhb 2 3)
    )
    FD
    )
    )
    ) ;end progn
    ) ;end cond3
    ((= sosanh "SS")
    (progn
    (setq j i)
    (while (/= ch ",")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    (if (or (= ch "`") (= ch " "))
    (setq i j)
    )
    )
    (setq stt (substr PR i (- j i 1)))
    (setq i j)
    (while (/= ch "")
    (setq ch (substr PR j 1))
    (setq j (+ j 1))
    )
    (setq ccguong (substr PR i (- j i 2)))
    (setq tam "ss")
    ) ;end progn
    ) ;end cond4
    )
    ) ;end progn
    ) ;end while
    (close FN)
    (close FD)
    (princ "\n")
    (princ "\nOK!")
    (princ)
    )
    ------------------------------------------------------------------------------------------------------------------------------------------------------------------
    ------------------------------------------------------------------------------------------------------------------------------------------------------------------
    ;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
    	;          	DUNG CHO BAN DO DIA CHINH 	*
    	;* TR  DCII-04  1014424.593 516275.846       	*
    	;* TR  DCII-07  1014339.861 516213.914       	*
    	;* TR  DCII-03  1014491.054  516180.297        	*
    	;* TR  DCII-06  1014670.141  516433.592         	*
    	;* TR  DCTI-04       	*
    	;* DH  DCII-03         	*
    	;* 1    	355.1447 	66.896        	*
    	;* 2    	355.1519 	47.576         	*
    	;* 3    	1.4545   	48.375        	*
    	;************************************************************************
    (defun c:pdm (/    	tam ms  PR   FN	thunhat
      	tentram  caodotram  xtram   ytram	htram
      	tentrammay tendh
     	)
     (bdau)
     (setq tam ())
     (setq ms (getreal "Nhap vao mau so ty le : "))
     (setq
    FN (getfiled "NhËp file nguån : "
      ""
      ""
      4
      	)
     )
     (progn
    (command "-osnap" "")
    (setvar "cmdecho" 0)
    (setvar "luprec" 8)
    (setvar "pdmode" 0)
    (command "-layer" "m" "diem" "c" "red" "" "")
    ;	(command "-layer" "m" "caodo" "c" "cyan" "" "")
    (command "-layer" "m" "sothutu" "c" "magenta" "" "")
    (command "-layer" "m" "khongche" "c" "red" "" "")
    (setq st (/ ms 1000))
    (setq st1 st)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    (setq FN (open FN "r"))
    (while (and (setq PR (read-line FN)) (/= PR ""))
     	(progn
    (setq PR (strcat "(" PR ")"))
    (setq PR (read PR))
    (setq thunhat (nth 0 PR))
    (if
      (numberp thunhat)
    (gapsoA)
    (gaptramA)
    )
     	) 	;end progn
    ) 	;end while
     ) 	;end progn
    ;;;;;ket thuc viet lenh
     (close FN)
     (command "zoom" "e")
     (kthuc)
     (princ "\nVAY LA XONG!)*****")
     (princ)
    )
    (defun gaptramA (/ x y)
     (setq thunhat (convtostr thunhat))
     (if (= thunhat "TR")
    (progn
     	(setq ktra (nth 3 PR))
     	(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
    (progn
      (setq tentram (convtostr (nth 1 PR)))
      (setq Y (nth 2 PR))
      (setq X ktra)
    ;   (setq h (nth 4 PR))
      (setq tam (append tam (list (list tentram x y ))))
    )   ;GAP TRAM DO THUC TE
    (progn
      (setq tentrammay (convtostr (nth 1 PR)))
    ;   (if (/= (nth 2 PR) nil)
    ; 	(setq caodotram (nth 2 PR))
    ; 	(setq caodotram 0)
    ;   )
      (laytdgoc tentrammay)
      (setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
      (setq xxtram xtram)
      (setq yytram ytram)
      (setq tdtram (list xtram ytram))
      (command "-layer" "s" "khongche" "")
    ;(command "point" tdtram)
      (command "insert" "cdkc" tdtram st st "")
      (setq sss (strlen tentrammay))
      (setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
        	(- ytram (* 0.65 st))       
      )
      )
    ;   (command "insert"
    ; 	"l"
    ; 	tdtram1
    ; 	(* st sss)
    ; 	(* st sss)
    ; 	""
    ;   )
      (command "-style"
    	"mota"
    	"txt.shx"
    	st
    	"1"
    	"0"
    	"n"
    	"n"
    	"n"
      )
      (command "text" "j" "bl" tdtram1 "" tentrammay)
      (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;   (command "-layer" "s" "khongche" "")
    ;   (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
    )
     	)
    ) 	;end progn
    (if (= thunhat "DH")  ;else
     	(progn
    (setq tendh (convtostr (nth 1 PR)))
    (laytdgoc tendh)
    (setq tddh (list xtram ytram ))
    (setq tddh1 (list (+ xtram (* 2 st)) ytram ))
    (command "-layer" "s" "khongche" "")
    (command "insert" "cdkc" tddh st st "")
    ;(command "point" tddh)
    (setq sss (strlen tendh))
    (setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
    	(- ytram (* 0.65 st))    
     	)
    )
    ;(command "insert"
    ;  "l"
    ;  tddh1
    ;  (* st sss)
    ;  (* st sss)
    ;  ""
    ;)
    (command "-style"
      "mota"
      "txt.shx"
      st
      "1"
      "0"
      "n"
      "n"
      "n"
    )
    (command "text" "j" "bl" tddh1 "" tendh)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ; (command "-layer" "s" "khongche" "")
    ; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
     	)
    )
     )
    )
    (defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
     (setq gocbang (nth 1 PR))
     (setq kc (nth 2 PR))
    ;  (setq dentah (nth 3 PR))
     (setq gocbang (dpgtod gocbang))
     (setq gocbang (- 360 gocbang))
     (setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
     (setq tdX (+ xxtram (* kc (cos gocbang))))
     (setq tdY (+ yytram (* kc (sin gocbang))))
    ;  (if (/= dentah nil)
    ;	(setq tdz (+ caodotram (nth 2 tdtram) dentah))
    ;	(setq tdz 0)
    ;  )
     (setq td (list tdx tdy))
     (setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
     (setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
     (command "-layer" "s" "diem" "")
     ;(command "insert" "cdc" td st st "")
     (command "point" td)
     (command "-style"
    "mota"
    "txt.shx"
    (* st 2)
    "1"
    "0"
    "n"
    "n"
    "n"
     )
     (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
     (command "-layer" "s" "sothutu" "")
     (command "text" td "" thunhat)
    ;  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;  (command "-layer" "s" "caodo" "")
    ;  (command "text" "tl" td "" (rtos tdz 2 1))
    )
    ------------------------------------------------------------------------------------
    chuong trinh tinh toa do diem dua vao goc va canh nhap vao
    (defun c:vl ()	;/ diemgoc diemdh goc canh)
     (bdau)
     (command "-layer" "m" "veluoi" "c" "cyan" "" "")
     (command "-layer" "m" "point" "c" "red" "" "")
     (command "-layer" "m" "text" "c" "yellow" "" "")
     (setq diemgoc (getpoint "\nChon diem goc : "))
     (setq diemdh (getpoint "\nChon diem dinh huong : "))
     (setq goc (getreal "\nNhap goc(do.phutgiay) : "))
     (setq canh (getreal "\nNhap chieu dai canh : "))
     (setq tendiem (getstring "Nhap ten diem : "))
     (setq goc2 (dpgtod goc))
     (setq goc1 (/ (* goc2 pi) 180))
     (setq gocbang (- (* 2 pi) goc1))
     (setq gocbang (+ gocbang (angle diemgoc diemdh)))
     (setq x1 (nth 0 diemgoc))
     (setq y1 (nth 1 diemgoc))
     (setq x2 (nth 0 diemdh))
     (setq y2 (nth 1 diemdh))
     (setq x3 (+ x1 (* canh (cos gocbang))))
     (setq y3 (+ y1 (* canh (sin gocbang))))
     (setq td3 (list x3 y3))
     (command "-layer" "s" "point" "")
     (command "point" td3)
     (command "-layer" "s" "veluoi" "")
     (command "line" diemgoc td3 "")
     (command "-layer" "s" "text" "")
     (command "-style" "mota" "txt.shx" 2 "1" "0" "n" "n" "n")
     (command "text" td3 "" tendiem)
     (kthuc)
    )
    ------------------------------------------------------------------------------------
    ; CHUONG TRINH LAY TOA DO 1 DIEM SAP XEP THEO X : Y : Z XUAT TRANG TEXT
    (defun C:TM (/ DIEM)
     (command "osnap" "endpoint")
     (setq DIEM (getpoint "Chon tram may can lay toa do"))
     (princ "\n TOA DO TRAM MAY:   ")
     (princ (rtos (cadr DIEM) 2 3))
     (princ "  ")
     (princ (rtos (car DIEM) 2 3))
     (princ "  ")
     (princ (rtos (caddr DIEM) 2 3))
     (princ)
    ) 	;END DEFUN
    ---------------------------------------------------------------------------------------
    CHUONG TRINH CON:
    ---------------------------------------------------------------------------------------
    (defun c:thuhoi (/ tenfile tenfile1 timfile dodaichuoi)
     (setq dodaichuoi (strlen (getvar "dwgname")))
     (setq tenfile1 (strcat (substr (getvar "dwgname") 1 (- dodaichuoi 3)) "xls"))
     (setq tenfile (strcat (getvar "dwgprefix") (getvar "dwgname")))
     (setq timfile (findfile (strcat (getvar "dwgprefix") tenfile1)))
     (if (/= timfile nil)
     	(vl-file-delete timfile)
     )
     ;(command "-eattext" "" "n" "n" "C:\\Program Files\\thuhoi.blk" "X" tenfile);Ghi file nhung bo bot vai cot
     (command "-eattext" "" "n" "n" "" "X" tenfile);Ghi file nhung khong bo bot cot
    )
    (defun laytdgoc (tentrammay / len i sosanh)
     (setq len (length tam))
     (setq i 0)
     (setq j 0)
     (while (< i len)
    (progn
     	(setq sosanh (car (nth i tam)))
     	(if (= tentrammay sosanh)
    (progn
      (setq j (+ j 1))
      (setq xtram (cadr (nth i tam)))
      (setq ytram (caddr (nth i tam)))
      (if (/= (cadddr (nth i tam)) nil)
    	(setq htram (cadddr (nth i tam)))
    	(setq htram 0.0)
      )
    )
    (progn
      (if (= j 0)
    	(progn
      	(setq xtram 0)
      	(setq ytram 0)
      	(setq htram 0)
    	)
      )
    )
     	)
     	(setq i (+ i 1))
    )
     )
    )
    (defun ConvtoStr (Sym)
     (setq ftemp "temp.tmp")
     (setq ftmp (open ftemp "w"))
     (princ Sym ftmp)
     (close ftmp)
     (setq ftmp (open ftemp "r"))
     (setq sym (read-line ftmp))
     (close ftmp)
     (princ sym)
    )
    (defun *error* (msg)
     (princ "\nerror:")
     (princ msg)
     (command "osmode" h "")
     (command "_.undo" "end")
     (command "clayer" clay)
     (command "u" "")
     (alert "  - - - - ha ha ha- - - -"
     )
     (setq *error* olderr)
     (princ)
    )
    (defun bdau ()
    ;(setq FNr "c:\\program files\\sr.txt")
    ;(setq FNr (open FNr "r"))
    ;(setq PRr (read-line FNr))
    ;(if (/= PRr "0909.446.887")
    ;(alert "VAY LA OK!"  )
    
    ;)
    ;(close FNr)
     (command "_.undo" "begin")
     (setq cmd (getvar "cmdecho"))
     (setq plwid (getvar "plinewid"))
     (setq elev (getvar "elevation"))
     (setq thick (getvar "thickness"))
     (setq hh (getvar "osmode"))
     (setq clay (getvar "clayer"))
    )
    (defun kthuc ()
     (command "plinewid" plwid)
     (command "elevation" elev)
     (command "thickness" thick)
     (command "osmode" hh)
     (command "_.undo" "end")
     (command "clayer" clay)
     (command "cmdecho" cmd)
    )
    (defun dpgtod (nhap / do phut giay)
     (setq do (fix nhap))
     (setq phut (fix (* (- nhap do) 100)))
     (setq giay (* (- (* (- nhap do) 100) phut) 100))
     (setq xuat (+ do (/ (* phut 1.0) 60) (/ giay 3600)))
    )
    (defun dtodpg (nhap / do phut giay)
     (setq do (fix nhap))
     (setq phut (fix (* (- nhap do) 60)))
     (setq giay (* (- (* (- nhap do) 60) phut) 60))
     (setq xuat (strcat (rtos do 2 0) "." (rtos phut 2 0) (rtos giay 2 0)))
    )
    (defun dd (nhap)
     (setq len (strlen nhap))
     (cond ((= len 1)  (setq xuat (strcat nhap "      	")))
    ((= len 2)  (setq xuat (strcat nhap "     	")))
    ((= len 3)  (setq xuat (strcat nhap "    	")))
    ((= len 4)  (setq xuat (strcat nhap "   	")))
    ((= len 5)  (setq xuat (strcat nhap "  	")))
    ((= len 6)  (setq xuat (strcat nhap " 	")))
    ((= len 7)  (setq xuat (strcat nhap "	")))
    ((= len 8)  (setq xuat (strcat nhap "   ")))
    ((= len 9)  (setq xuat (strcat nhap "  ")))
    ((= len 10) (setq xuat (strcat nhap " ")))
    ((= len 11) (setq xuat (strcat nhap "")))
    ; ((= len 12) (setq xuat (strcat nhap "     	")))
    ; ((= len 13) (setq xuat (strcat nhap "    	")))
    ; ((= len 14) (setq xuat (strcat nhap "   	")))
    ; ((= len 15) (setq xuat (strcat nhap "  	")))
    ; ((= len 16) (setq xuat (strcat nhap " 	")))
    ; ((= len 17) (setq xuat (strcat nhap "	")))
    ; ((= len 18) (setq xuat (strcat nhap "   ")))
    ; ((= len 19) (setq xuat (strcat nhap "  ")))
    ; ((= len 20) (setq xuat (strcat nhap " ")))
    ; ((= len 21) (setq xuat (strcat nhap "")))
     )
    )
    (defun dd1 (nhap)
     (setq len (strlen nhap))
     (cond ((= len 1)  (setq xuat (strcat nhap "                	")))
    ((= len 2)  (setq xuat (strcat nhap "               	")))
    ((= len 3)  (setq xuat (strcat nhap "              	")))
    ((= len 4)  (setq xuat (strcat nhap "             	")))
    ((= len 5)  (setq xuat (strcat nhap "            	")))
    ((= len 6)  (setq xuat (strcat nhap "           	")))
    ((= len 7)  (setq xuat (strcat nhap "          	")))
    ((= len 8)  (setq xuat (strcat nhap "         	")))
    ((= len 9)  (setq xuat (strcat nhap "        	")))
    ((= len 10) (setq xuat (strcat nhap "       	")))
    ((= len 11) (setq xuat (strcat nhap "      	")))
    ((= len 12) (setq xuat (strcat nhap "     	")))
    ((= len 13) (setq xuat (strcat nhap "    	")))
    ((= len 14) (setq xuat (strcat nhap "   	")))
    ((= len 15) (setq xuat (strcat nhap "  	")))
    ((= len 16) (setq xuat (strcat nhap " 	")))
    ((= len 17) (setq xuat (strcat nhap "	")))
    ((= len 18) (setq xuat (strcat nhap "   ")))
    ((= len 19) (setq xuat (strcat nhap "  ")))
    ((= len 20) (setq xuat (strcat nhap " ")))
    ((= len 21) (setq xuat (strcat nhap "")))
     )
    )
    

     

    KHI CHẠY ĐẾN BƯỚC PHUN ĐIỂM MIA THÌ NÓ HIỆN LÊN DÒNG NÀY LÀ SAO ANH NHỈ:

     

    Command: chay

    Nhap ten file ket qua (khong can .txt): hoanchinh

     

     

    OK!Nhap vao mau so ty le : 200

    Regenerating model.

    TRA

    error:bad argument type: numberp: nil

    Requires an integer between 0 and 32767.

    ; error: An error has occurred inside the *error* functionFunction cancelled

     

    Enter new value for OSMODE <0>:

    NÓ KHÔNG PHUN ĐIỂM RA NGOÀI MÀN HÌNH ANH Ạ


  4. oh đúng là phức tạp thật bác phamthanhbinh nhỉ. thực ra em cũng chẳng hiểu gì về lisp nhưng khi chuyển qua lĩnh vực đo đạc thì em thấy nó bổ trợ cho công việc khá tốt.

    - anh bạn cùng làm đã cài cho em cái chương trình đó trước khi cái máy của em bị virut và phải cài lại. bầy giờ anh đó đã chuyển công tác và em thì không liên hệ được với anh đó.

    - em cần cái lisp nào có thể giải quyết được công việc của em nó đơn giản hơn mà dễ sử dụng theo số liệu em trút từ máy đo như lúc đầu em gửi.

    nhờ các anh em giúp em với.


  5. anh ketxu ơi, đúng là cái lisp của em nó có vấn để rồi. mấy bưa trước vẫn chạy vô tư, không hiểu sao gần đây chạy không được. không biết có con virut nào nó nhẩy vào can thiệp không nưa, anh giúp em sửa lỗi với.

    nó bị lỗi như sau:

     

    Command: cb

    Nhap ten file ket qua : SOLIEUDAXULY.TXT

    ; error: no function definition: DPGTOD


  6. Cảm ơn bác ketxu và phanthanhbinh đã quan tâm!

    - Em dùng đoạn code gộp của bác phanthanhbinh nó vẫn chạy lisp nhưng khi lưu kết quả thì không có gì trong file vừa lưu!

    - Em gửi file solieu thô khi trút từ máy đo, solieu đã chế biến sơ và solieu sau khi phun điểm tạm để vẽ lưới lấy tọa độ lưu vào file đã xử lý rồi phun ra điểm mia địa chính (Kèm theo bản vẽ sau khi xử lý xong)

    Rất cần các anh em giúp đỡ để có thể thực hiện 1 công đoạn cho ra bản vẽ 1!http://www.cadviet.com/upfiles/3/89068_banve.rar


  7. - hiện tại em phải dùng 5 thao tác riêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:

    1: Dùng lệnh chế biến File (CB) để chế biến File từ dạng thô của máy đo sang File tọa độ góc, cạnh dạng .TXT

    2; Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.

    3: Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.

    4: Dùng lệnh lấy trạm máy ™ để lấy tọa độ của trạm máy.

    5: Sau đó mới dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.

     

    Nhờ các anh em trên diễn đàn giúp em hoàn thiện lisp phun tọa độ lên màn hình Autocad là gộp các lisp riêng lẻ thành 1 lệnh chế biến (CB) với nội dung như sau:

    Mở AutoCAD ra và gõ lệnh chế biến (CB) sau đó tìm đến đường dẫn chứa File thô trút số liệu từ máy đo ra là có thể xuất tọa độ điểm đo ra ngoài màn hình và chỉ việc nối các điểm mia là xong mà không phải thực hiện từng thao tác như trước nữa!

     

    Còn nếu khó và phức tạp quá thì có thể giúp em gộp bước 1 và 2 thành 1 ở trên để phun điểm mia ra và tự làm các bước còn lại theo cách thủ công như cũ.

    Cảm ơn các anh em rất nhiều!

    ĐÂY LÀ CODE CẦN ANH EM SỬA GIÚP:

     

    C

    [/size][/font][/size][/font]
    [font=Arial][size=2] 	;******\\\\\\\\\**chuong trinh che bien cho may TOPCON 223*********\\\\\\\\\\\\\\*********////////
    ;khong dung chenh cao, chi su dung de thanh lap ban do dia chinh
    (defun c:cb (/ 	ch	i   FN  FD sosanh j  	trammay
     	ccmay  tramdh ccguong  canhng hm 	hg 	goctd
     	canhb  gocdung   cd  dem tam
    )
     (setq
    FN (getfiled "NhËp file nguån : "
      ""
      ""
      4
      	)
     )
     (setq i (strlen FN))
     (setq ch "")
     (while (/= ch "\\")
    (setq ch (substr FN i 1))
    (setq i (- i 1))
     )
     (setq xuat (substr FN 1 (+ i 1)))
     (setq FD (getstring "Nhap ten file ket qua : "))
     (setq FD (strcat xuat FD))
     (setq FD (open FD "w"))
    ;  (setq mo (getreal "Nhap sai so MO cua may (giay) : "))
     (if (= mo nil)
    (progn (setq mo 0)
    (princ "\n")
    (princ "  Lay MO=0")
    (princ "\n")
    )
     )
     (setq mo (/ mo 3600))
     (setq FN (open FN "r"))
     (while (and (setq PR (read-line FN)) (/= PR ""))
    (progn
     	(setq i 1)
     	(setq sosanh "")
     	(setq ch "")
     	(while (/= ch " ")
    (setq ch (substr PR i 1))
    (setq i (+ i 1))
     	)
     	(setq sosanh (substr PR 1 (- i 2)))
     	(cond ((= sosanh "STN")
     	(progn
    ;///////////////////////lay ten tram may//////////
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq trammay (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao may/////////
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccmay (substr PR i (- j i 2)))
       	(write-line (strcat "TR  " trammay) FD)
     	)	;end progn
    )	;end cond1
    ((= sosanh "BS")
     	(progn
    ;///////////////////////lay ten tram dinh huong//////////
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq tramdh (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao guong/////////
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccguong (substr PR i (- j i 2)))
       	(setq tam "bs")
     	)	;end progn
    )	;end cond2
    ((= sosanh "SD")
     	(progn
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (= ch " ")
    (setq i j)
      )
       	)
       	(setq gocbang (substr PR i (- j i 1)))
    ;///////////////////////////////
       	(setq i j)
       	(setq j (+ j 2))
       	(setq ch "")
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq goctd (substr PR i (- j i 1)))
    ;////////////////////////////////
       	(setq i j)
       	(setq j (+ j 2))
       	(setq ch " ")
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq canhng (substr PR i (- j i 1)))
    ;/////////////////////////////////////
       	(setq hg (atof ccguong))
       	(setq hm (atof ccmay))
       	(setq gocdung (- (- 90.0 (dpgtod (atof goctd))) mo))
       	(setq gocdung (/ (* gocdung pi) 180))
       	(setq canhng (atof canhng))
       	(setq canhb (* canhng (cos gocdung)))
       	(setq h (+ (- hg hm) (* canhng (sin gocdung))))
       	(setq cd (strlen gocbang))
       	(setq i cd)
       	(setq dem 0)
       	(setq ch "")
       	(while (/= ch ".")
      (setq ch (substr gocbang i 1))
      (setq i (- i 1))
      (setq dem (+ dem 1))
       	)
       	(if (= dem 6)
      (setq gocbang (substr gocbang 1 (- cd 1)))
       	)
       	(if (= tam "bs")
      (write-line
    (strcat "DH  "
     	(dd tramdh)
     	(dd gocbang)
     	"  "
     	(rtos canhb 2 3)
    )
    FD
      )
      (write-line
    (strcat (dd stt)
     	(dd gocbang)
     	"	"
     	(rtos canhb 2 3)
    )
    FD
      )
       	)
     	)	;end progn
    )	;end cond3
    ((= sosanh "SS")
     	(progn
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq stt (substr PR i (- j i 1)))
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccguong (substr PR i (- j i 2)))
       	(setq tam "ss")
     	)	;end progn
    )	;end cond4
     	)
    ) 	;end progn
     ) 	;end while
     (close FN)
     (close FD)
     (princ "\n")
     (princ "\nOK!")
     (princ)
    )
    ------------------------------------------------------------------------------------------------------------------------------------------------------------------
    ;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
    ;          	DUNG CHO BAN DO DIA CHINH 	*
    ;* TR  DCII-04  1014424.593 516275.846   		*
    ;* TR  DCII-07  1014339.861 516213.914   		*
    ;* TR  DCII-03  1014491.054  516180.297        	*
    ;* TR  DCII-06  1014670.141  516433.592     		*
    ;* TR  DCTI-04   		*
    ;* DH  DCII-03     		*
    ;* 1    	355.1447 	66.896        	*
    ;* 2    	355.1519 	47.576     		*
    ;* 3    	1.4545   	48.375        	*
    ;************************************************************************
    (defun c:pdm (/    	tam ms  PR   FN	thunhat
      	tentram  caodotram  xtram   ytram	htram
      	tentrammay tendh
     	)
     (bdau)
     (setq tam ())
     (setq ms (getreal "Nhap vao mau so ty le : "))
     (setq
    FN (getfiled "NhËp file nguån : "
      ""
      ""
      4
      	)
     )
     (progn
    (command "-osnap" "")
    (setvar "cmdecho" 0)
    (setvar "luprec" 8)
    (setvar "pdmode" 0)
    (command "-layer" "m" "diem" "c" "red" "" "")
    ;	(command "-layer" "m" "caodo" "c" "cyan" "" "")
    (command "-layer" "m" "sothutu" "c" "magenta" "" "")
    (command "-layer" "m" "khongche" "c" "red" "" "")
    (setq st (/ ms 1000))
    (setq st1 st)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    (setq FN (open FN "r"))
    (while (and (setq PR (read-line FN)) (/= PR ""))
     	(progn
    (setq PR (strcat "(" PR ")"))
    (setq PR (read PR))
    (setq thunhat (nth 0 PR))
    (if
      (numberp thunhat)
    (gapsoA)
    (gaptramA)
    )
     	) 	;end progn
    ) 	;end while
     ) 	;end progn
    ;;;;;ket thuc viet lenh
     (close FN)
     (command "zoom" "e")
     (kthuc)
     (princ "\nVAY LA XONG!)*****")
     (princ)
    )
    (defun gaptramA (/ x y)
     (setq thunhat (convtostr thunhat))
     (if (= thunhat "TR")
    (progn
     	(setq ktra (nth 3 PR))
     	(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
    (progn
      (setq tentram (convtostr (nth 1 PR)))
      (setq Y (nth 2 PR))
      (setq X ktra)
    ;   (setq h (nth 4 PR))
      (setq tam (append tam (list (list tentram x y ))))
    )   ;GAP TRAM DO THUC TE
    (progn
      (setq tentrammay (convtostr (nth 1 PR)))
    ;   (if (/= (nth 2 PR) nil)
    ; 	(setq caodotram (nth 2 PR))
    ; 	(setq caodotram 0)
    ;   )
      (laytdgoc tentrammay)
      (setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
      (setq xxtram xtram)
      (setq yytram ytram)
      (setq tdtram (list xtram ytram))
      (command "-layer" "s" "khongche" "")
    ;(command "point" tdtram)
      (command "insert" "cdkc" tdtram st st "")
      (setq sss (strlen tentrammay))
      (setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
    		(- ytram (* 0.65 st))      
      )
      )
    ;   (command "insert"
    ; 	"l"
    ; 	tdtram1
    ; 	(* st sss)
    ; 	(* st sss)
    ; 	""
    ;   )
      (command "-style"
    "mota"
    "txt.shx"
    st
    "1"
    "0"
    "n"
    "n"
    "n"
      )
      (command "text" "j" "bl" tdtram1 "" tentrammay)
      (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;   (command "-layer" "s" "khongche" "")
    ;   (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
    )
     	)
    ) 	;end progn
    (if (= thunhat "DH")  ;else
     	(progn
    (setq tendh (convtostr (nth 1 PR)))
    (laytdgoc tendh)
    (setq tddh (list xtram ytram ))
    (setq tddh1 (list (+ xtram (* 2 st)) ytram ))
    (command "-layer" "s" "khongche" "")
    (command "insert" "cdkc" tddh st st "")
    ;(command "point" tddh)
    (setq sss (strlen tendh))
    (setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
    (- ytram (* 0.65 st))    
     	)
    )
    ;(command "insert"
    ;  "l"
    ;  tddh1
    ;  (* st sss)
    ;  (* st sss)
    ;  ""
    ;)[/size][/font]
    [font=Arial][size=2](command "-style"
      "mota"
      "txt.shx"
      st
      "1"
      "0"
      "n"
      "n"
      "n"
    )
    (command "text" "j" "bl" tddh1 "" tendh)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ; (command "-layer" "s" "khongche" "")
    ; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
     	)
    )
     )
    )
    (defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
     (setq gocbang (nth 1 PR))
     (setq kc (nth 2 PR))
    ;  (setq dentah (nth 3 PR))
     (setq gocbang (dpgtod gocbang))
     (setq gocbang (- 360 gocbang))
     (setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
     (setq tdX (+ xxtram (* kc (cos gocbang))))
     (setq tdY (+ yytram (* kc (sin gocbang))))
    ;  (if (/= dentah nil)
    ;	(setq tdz (+ caodotram (nth 2 tdtram) dentah))
    ;	(setq tdz 0)
    ;  )
     (setq td (list tdx tdy))
     (setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
     (setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
     (command "-layer" "s" "diem" "")
     ;(command "insert" "cdc" td st st "")
     (command "point" td)
     (command "-style"
    "mota"
    "txt.shx"
    (* st 2)
    "1"
    "0"
    "n"
    "n"
    "n"
     )
     (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
     (command "-layer" "s" "sothutu" "")
     (command "text" td "" thunhat)
    ;  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;  (command "-layer" "s" "caodo" "")
    ;  (command "text" "tl" td "" (rtos tdz 2 1))
    )
    ------------------------------------------------------------------------------------
    chuong trinh tinh toa do diem dua vao goc va canh nhap vao
    (defun c:vl ()	;/ diemgoc diemdh goc canh)
     (bdau)
     (command "-layer" "m" "veluoi" "c" "cyan" "" "")
     (command "-layer" "m" "point" "c" "red" "" "")
     (command "-layer" "m" "text" "c" "yellow" "" "")
     (setq diemgoc (getpoint "\nChon diem goc : "))
     (setq diemdh (getpoint "\nChon diem dinh huong : "))
     (setq goc (getreal "\nNhap goc(do.phutgiay) : "))
     (setq canh (getreal "\nNhap chieu dai canh : "))
     (setq tendiem (getstring "Nhap ten diem : "))
     (setq goc2 (dpgtod goc))
     (setq goc1 (/ (* goc2 pi) 180))
     (setq gocbang (- (* 2 pi) goc1))
     (setq gocbang (+ gocbang (angle diemgoc diemdh)))
     (setq x1 (nth 0 diemgoc))
     (setq y1 (nth 1 diemgoc))
     (setq x2 (nth 0 diemdh))
     (setq y2 (nth 1 diemdh))
     (setq x3 (+ x1 (* canh (cos gocbang))))
     (setq y3 (+ y1 (* canh (sin gocbang))))
     (setq td3 (list x3 y3))
     (command "-layer" "s" "point" "")
     (command "point" td3)
     (command "-layer" "s" "veluoi" "")
     (command "line" diemgoc td3 "")
     (command "-layer" "s" "text" "")
     (command "-style" "mota" "txt.shx" 2 "1" "0" "n" "n" "n")
     (command "text" td3 "" tendiem)
     (kthuc)
    )
    ------------------------------------------------------------------------------------
    ; CHUONG TRINH LAY TOA DO 1 DIEM SAP XEP THEO X : Y : Z XUAT TRANG TEXT
    (defun C:TM (/ DIEM)
     (command "osnap" "endpoint")
     (setq DIEM (getpoint "Chon tram may can lay toa do"))
     (princ "\n TOA DO TRAM MAY:   ")
     (princ (rtos (cadr DIEM) 2 3))
     (princ "  ")
     (princ (rtos (car DIEM) 2 3))
     (princ "  ")
     (princ (rtos (caddr DIEM) 2 3))
     (princ)
    ) 	;END DEFUN
    ---------------------------------------------------------------------------------------[/size][/font]
    
    [font=Arial][size=2]


  8. - hiện tại em phải dùng 5 thao tác riêng biệt để xuất được các điểm đo ra ngoài màn hình AutoCAD là:

    1: Dùng lệnh chế biến File (CB) để chế biến File từ dạng thô của máy đo sang File tọa độ góc, cạnh dạng .TXT

    2; Dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.

    3: Dùng lệnh vẽ lưới (VL) để xác định góc cạnh, tọa độ của trạm máy.

    4: Dùng lệnh lấy trạm máy ™ để lấy tọa độ của trạm máy.

    5: Sau đó mới dùng lệnh phun điểm mia (PDM) để phun tọa độ ra ngoài màn hình AutoCAD.

     

    Nhờ các anh em trên diễn đàn giúp em hoàn thiện lisp phun tọa độ lên màn hình Autocad là gộp các lisp riêng lẻ thành 1 lệnh chế biến (CB) với nội dung như sau:

    Mở AutoCAD ra và gõ lệnh chế biến (CB) sau đó tìm đến đường dẫn chứa File thô trút số liệu từ máy đo ra là có thể xuất tọa độ điểm đo ra ngoài màn hình và chỉ việc nối các điểm mia là xong mà không phải thực hiện từng thao tác như trước nữa!

     

    Còn nếu khó và phức tạp quá thì có thể giúp em gộp bước 1 và 2 thành 1 ở trên để phun điểm mia ra và tự làm các bước còn lại theo cách thủ công như cũ.

    Cảm ơn các anh em rất nhiều!

    ĐÂY LÀ CODE CẦN ANH EM SỬA GIÚP:

     

    [/size][/font]
    ;khong dung chenh cao, chi su dung de thanh lap ban do dia chinh
    (defun c:cb (/ 	ch	i   FN  FD sosanh j  	trammay
     	ccmay  tramdh ccguong  canhng hm 	hg 	goctd
     	canhb  gocdung   cd  dem tam
    )
     (setq
    FN (getfiled "NhËp file nguån : "
      ""
      ""
      4
      	)
     )
     (setq i (strlen FN))
     (setq ch "")
     (while (/= ch "\\")
    (setq ch (substr FN i 1))
    (setq i (- i 1))
     )
     (setq xuat (substr FN 1 (+ i 1)))
     (setq FD (getstring "Nhap ten file ket qua : "))
     (setq FD (strcat xuat FD))
     (setq FD (open FD "w"))
    ;  (setq mo (getreal "Nhap sai so MO cua may (giay) : "))
     (if (= mo nil)
    (progn (setq mo 0)
    (princ "\n")
    (princ "  Lay MO=0")
    (princ "\n")
    )
     )
     (setq mo (/ mo 3600))
     (setq FN (open FN "r"))
     (while (and (setq PR (read-line FN)) (/= PR ""))
    (progn
     	(setq i 1)
     	(setq sosanh "")
     	(setq ch "")
     	(while (/= ch " ")
    (setq ch (substr PR i 1))
    (setq i (+ i 1))
     	)
     	(setq sosanh (substr PR 1 (- i 2)))
     	(cond ((= sosanh "STN")
     	(progn
    ;///////////////////////lay ten tram may//////////
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq trammay (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao may/////////
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccmay (substr PR i (- j i 2)))
       	(write-line (strcat "TR  " trammay) FD)
     	)	;end progn
    )	;end cond1
    ((= sosanh "BS")
     	(progn
    ;///////////////////////lay ten tram dinh huong//////////
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq tramdh (substr PR i (- j i 1)))
    ;//////////////////////lay chieu cao guong/////////
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccguong (substr PR i (- j i 2)))
       	(setq tam "bs")
     	)	;end progn
    )	;end cond2
    ((= sosanh "SD")
     	(progn
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (= ch " ")
    (setq i j)
      )
       	)
       	(setq gocbang (substr PR i (- j i 1)))
    ;///////////////////////////////
       	(setq i j)
       	(setq j (+ j 2))
       	(setq ch "")
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq goctd (substr PR i (- j i 1)))
    ;////////////////////////////////
       	(setq i j)
       	(setq j (+ j 2))
       	(setq ch " ")
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq canhng (substr PR i (- j i 1)))
    ;/////////////////////////////////////
       	(setq hg (atof ccguong))
       	(setq hm (atof ccmay))
       	(setq gocdung (- (- 90.0 (dpgtod (atof goctd))) mo))
       	(setq gocdung (/ (* gocdung pi) 180))
       	(setq canhng (atof canhng))
       	(setq canhb (* canhng (cos gocdung)))
       	(setq h (+ (- hg hm) (* canhng (sin gocdung))))
       	(setq cd (strlen gocbang))
       	(setq i cd)
       	(setq dem 0)
       	(setq ch "")
       	(while (/= ch ".")
      (setq ch (substr gocbang i 1))
      (setq i (- i 1))
      (setq dem (+ dem 1))
       	)
       	(if (= dem 6)
      (setq gocbang (substr gocbang 1 (- cd 1)))
       	)
       	(if (= tam "bs")
      (write-line
    (strcat "DH  "
     	(dd tramdh)
     	(dd gocbang)
     	"  "
     	(rtos canhb 2 3)
    )
    FD
      )
      (write-line
    (strcat (dd stt)
     	(dd gocbang)
     	"	"
     	(rtos canhb 2 3)
    )
    FD
      )
       	)
     	)	;end progn
    )	;end cond3
    ((= sosanh "SS")
     	(progn
       	(setq j i)
       	(while (/= ch ",")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
      (if (or (= ch "`") (= ch " "))
    (setq i j)
      )
       	)
       	(setq stt (substr PR i (- j i 1)))
       	(setq i j)
       	(while (/= ch "")
      (setq ch (substr PR j 1))
      (setq j (+ j 1))
       	)
       	(setq ccguong (substr PR i (- j i 2)))
       	(setq tam "ss")
     	)	;end progn
    )	;end cond4
     	)
    ) 	;end progn
     ) 	;end while
     (close FN)
     (close FD)
     (princ "\n")
     (princ "\nOK!")
     (princ)
    )
    ------------------------------------------------------------------------------------------------------------------------------------------------------------------
    ;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
    ;          	DUNG CHO BAN DO DIA CHINH 	*
    ;* TR  DCII-04  1014424.593 516275.846   		*
    ;* TR  DCII-07  1014339.861 516213.914   		*
    ;* TR  DCII-03  1014491.054  516180.297        	*
    ;* TR  DCII-06  1014670.141  516433.592     		*
    ;* TR  DCTI-04   		*
    ;* DH  DCII-03     		*
    ;* 1    	355.1447 	66.896        	*
    ;* 2    	355.1519 	47.576     		*
    ;* 3    	1.4545   	48.375        	*
    ;************************************************************************
    (defun c:pdm (/    	tam ms  PR   FN	thunhat
      	tentram  caodotram  xtram   ytram	htram
      	tentrammay tendh
     	)
     (bdau)
     (setq tam ())
     (setq ms (getreal "Nhap vao mau so ty le : "))
     (setq
    FN (getfiled "NhËp file nguån : "
      ""
      ""
      4
      	)
     )
     (progn
    (command "-osnap" "")
    (setvar "cmdecho" 0)
    (setvar "luprec" 8)
    (setvar "pdmode" 0)
    (command "-layer" "m" "diem" "c" "red" "" "")
    ;	(command "-layer" "m" "caodo" "c" "cyan" "" "")
    (command "-layer" "m" "sothutu" "c" "magenta" "" "")
    (command "-layer" "m" "khongche" "c" "red" "" "")
    (setq st (/ ms 1000))
    (setq st1 st)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    (setq FN (open FN "r"))
    (while (and (setq PR (read-line FN)) (/= PR ""))
     	(progn
    (setq PR (strcat "(" PR ")"))
    (setq PR (read PR))
    (setq thunhat (nth 0 PR))
    (if
      (numberp thunhat)
    (gapsoA)
    (gaptramA)
    )
     	) 	;end progn
    ) 	;end while
     ) 	;end progn
    ;;;;;ket thuc viet lenh
     (close FN)
     (command "zoom" "e")
     (kthuc)
     (princ "\nVAY LA XONG!)*****")
     (princ)
    )
    (defun gaptramA (/ x y)
     (setq thunhat (convtostr thunhat))
     (if (= thunhat "TR")
    (progn
     	(setq ktra (nth 3 PR))
     	(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
    (progn
      (setq tentram (convtostr (nth 1 PR)))
      (setq Y (nth 2 PR))
      (setq X ktra)
    ;   (setq h (nth 4 PR))
      (setq tam (append tam (list (list tentram x y ))))
    )   ;GAP TRAM DO THUC TE
    (progn
      (setq tentrammay (convtostr (nth 1 PR)))
    ;   (if (/= (nth 2 PR) nil)
    ; 	(setq caodotram (nth 2 PR))
    ; 	(setq caodotram 0)
    ;   )
      (laytdgoc tentrammay)
      (setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
      (setq xxtram xtram)
      (setq yytram ytram)
      (setq tdtram (list xtram ytram))
      (command "-layer" "s" "khongche" "")
    ;(command "point" tdtram)
      (command "insert" "cdkc" tdtram st st "")
      (setq sss (strlen tentrammay))
      (setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
    		(- ytram (* 0.65 st))      
      )
      )
    ;   (command "insert"
    ; 	"l"
    ; 	tdtram1
    ; 	(* st sss)
    ; 	(* st sss)
    ; 	""
    ;   )
      (command "-style"
    "mota"
    "txt.shx"
    st
    "1"
    "0"
    "n"
    "n"
    "n"
      )
      (command "text" "j" "bl" tdtram1 "" tentrammay)
      (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;   (command "-layer" "s" "khongche" "")
    ;   (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
    )
     	)
    ) 	;end progn
    (if (= thunhat "DH")  ;else
     	(progn
    (setq tendh (convtostr (nth 1 PR)))
    (laytdgoc tendh)
    (setq tddh (list xtram ytram ))
    (setq tddh1 (list (+ xtram (* 2 st)) ytram ))
    (command "-layer" "s" "khongche" "")
    (command "insert" "cdkc" tddh st st "")
    ;(command "point" tddh)
    (setq sss (strlen tendh))
    (setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
    (- ytram (* 0.65 st))    
     	)
    )
    ;(command "insert"
    ;  "l"
    ;  tddh1
    ;  (* st sss)
    ;  (* st sss)
    ;  ""
    ;)[/size][/font]
    [font=Arial][size=2](command "-style"
      "mota"
      "txt.shx"
      st
      "1"
      "0"
      "n"
      "n"
      "n"
    )
    (command "text" "j" "bl" tddh1 "" tendh)
    (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ; (command "-layer" "s" "khongche" "")
    ; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
     	)
    )
     )
    )
    (defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
     (setq gocbang (nth 1 PR))
     (setq kc (nth 2 PR))
    ;  (setq dentah (nth 3 PR))
     (setq gocbang (dpgtod gocbang))
     (setq gocbang (- 360 gocbang))
     (setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
     (setq tdX (+ xxtram (* kc (cos gocbang))))
     (setq tdY (+ yytram (* kc (sin gocbang))))
    ;  (if (/= dentah nil)
    ;	(setq tdz (+ caodotram (nth 2 tdtram) dentah))
    ;	(setq tdz 0)
    ;  )
     (setq td (list tdx tdy))
     (setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
     (setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
     (command "-layer" "s" "diem" "")
     ;(command "insert" "cdc" td st st "")
     (command "point" td)
     (command "-style"
    "mota"
    "txt.shx"
    (* st 2)
    "1"
    "0"
    "n"
    "n"
    "n"
     )
     (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
     (command "-layer" "s" "sothutu" "")
     (command "text" td "" thunhat)
    ;  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
    ;  (command "-layer" "s" "caodo" "")
    ;  (command "text" "tl" td "" (rtos tdz 2 1))
    )
    ------------------------------------------------------------------------------------
    chuong trinh tinh toa do diem dua vao goc va canh nhap vao
    (defun c:vl ()	;/ diemgoc diemdh goc canh)
     (bdau)
     (command "-layer" "m" "veluoi" "c" "cyan" "" "")
     (command "-layer" "m" "point" "c" "red" "" "")
     (command "-layer" "m" "text" "c" "yellow" "" "")
     (setq diemgoc (getpoint "\nChon diem goc : "))
     (setq diemdh (getpoint "\nChon diem dinh huong : "))
     (setq goc (getreal "\nNhap goc(do.phutgiay) : "))
     (setq canh (getreal "\nNhap chieu dai canh : "))
     (setq tendiem (getstring "Nhap ten diem : "))
     (setq goc2 (dpgtod goc))
     (setq goc1 (/ (* goc2 pi) 180))
     (setq gocbang (- (* 2 pi) goc1))
     (setq gocbang (+ gocbang (angle diemgoc diemdh)))
     (setq x1 (nth 0 diemgoc))
     (setq y1 (nth 1 diemgoc))
     (setq x2 (nth 0 diemdh))
     (setq y2 (nth 1 diemdh))
     (setq x3 (+ x1 (* canh (cos gocbang))))
     (setq y3 (+ y1 (* canh (sin gocbang))))
     (setq td3 (list x3 y3))
     (command "-layer" "s" "point" "")
     (command "point" td3)
     (command "-layer" "s" "veluoi" "")
     (command "line" diemgoc td3 "")
     (command "-layer" "s" "text" "")
     (command "-style" "mota" "txt.shx" 2 "1" "0" "n" "n" "n")
     (command "text" td3 "" tendiem)
     (kthuc)
    )
    ------------------------------------------------------------------------------------
    ; CHUONG TRINH LAY TOA DO 1 DIEM SAP XEP THEO X : Y : Z XUAT TRANG TEXT
    (defun C:TM (/ DIEM)
     (command "osnap" "endpoint")
     (setq DIEM (getpoint "Chon tram may can lay toa do"))
     (princ "\n TOA DO TRAM MAY:   ")
     (princ (rtos (cadr DIEM) 2 3))
     (princ "  ")
     (princ (rtos (car DIEM) 2 3))
     (princ "  ")
     (princ (rtos (caddr DIEM) 2 3))
     (princ)
    ) 	;END DEFUN
    ---------------------------------------------------------------------------------------
    
    


  9. em cảm ơn anh TUE và Anh Ha, không biết sao em dùng lisp của anh TUE thì khi hatch nó có chớp khung bao xong rồi không hiện nét hatch lên, còn lisp của anh Ha thì hatch được nhưng hatch cả hình chứ không hatch khoảng 0.5 xung quanh hình. cái đoạn lisp ban đầu em gửi nó đơn giản hơn chỉ cần gõ lệnh xong là chọn vào tâm khung hình (dùng được cả đường Line và Pline) vậy là xong nhưng nó lại đè lên Dim. nhờ các anh giúp nó không đè lên dim là ok. rất chân thành cảm ơn các anh đã giúp nhiệt tình!


  10. em cảm ơn anh Tue_NV đã quan tâm và giúp em! em doawload về nhưng khi dùng em pick điểm và kết thúc lệnh thì không thấy nó Hatch gì cả! anh có thể giúp em khi thực hiện lệnh nó ngắn gọn hơn, không phải chon nhiều thứ như là chọn khoảng cách OFFSET (mặc định sẵn cho tỉ lệ 500)

    * anh giúp em là khi gõ lệnh HH5 -> chọn điểm cần Hatch -> vậy là hatch xong rồi. còn khoảng cách OFFSET khi Hatch đặt mặc định là 0.5 nên không phải chọn. cảm ơn anh rất nhiều!


  11. Vấn đề em đang hỏi này đã hỏi trong phần: [Đã xong] lisp Hatch (gạch, bê tông, kính) những có lẽ là không đúng bài nên các anh trong diễn đàn chưa giúp được!

    em vẫn chưa có hướng giải quyết nên lại đưa vấn đề này ra mong các anh giúp và thông cảm cho em. em không biết về lisp nhưng không có lẽ là không dùng đến nó, rất mong các anh giúp cho.

    em muốn khi Hatch gõ lệnh HH5 sau đó pick vào bản vẽ nó sẽ hatch và không đè lên kích thước như hình B trong bản vẽ!

    ĐÂY LÀ LISP CẦN SỬA NHƯ BẢN VẼ, MONG CÁC ANH GIÚP:

    http://www.cadviet.com/upfiles/3/89068_hatch_1.lsp

    BẢN VẼ: http://www.cadviet.com/upfiles/3/89068_banve_1.dwg


  12. em dùng textmask sau đó chon Dim rồi dùng HH5 nhưng vẫn cứ hatch đè lên số, còn cái lisp bác gửi kia cũng vẫn vậy, hatch kín cả khung thì nó không đè lên số còn hatch theo cái lisp em gửi bao xung quanh 1 phần thì không được.

    em có đoạn code này thì hatch được như vậy nhưng phải tạo khung bao sau đó mới hatch được hơi lâu hơn cái kia 1 chút:

    (defun c:H5( / A B C)

    (command "-osnap" "none")

    (command "-layer" "m" "Hatch" "c" "8" "" "")

    (SETQ A (GETPOINT "CHON DIEM : "))

    (command "-boundary" A "")

    (setq B (ssget "L"))

    (command "offset" "0.8" B A "")

    (setq C (ssget "L"))

    (SETQ A (GETPOINT "CHON DIEM : "))

    (command "bhatch" "P" "ANSI31" "4" "0" A "")

    (COMMAND "-LAYER" "N" "HATCH" "")(PRINC)

    (COMMAND "CHPROP" (ssget "L") "" "c" "8" "LA" "HATCH" "")

    (command "erase" B "")

    (command "erase" C "")(prompt "\nDA TAO HATCH XONG!")(princ)

    (command "-osnap" "End,Mid,Int,Perp"))


  13. các bác ơi giúp em vấn đề này với, cái lisp hatch này muốn khi hatch nó không đè lên số như hình bền thì làm thế nào để nhanh và thuận tiện cho công việc em làm nhỉ

    (defun c:hh5 (/ A B C)

    (command "-layer" "m" "Hatch" "c" "8" "" "")

    (SETQ A (GETPOINT "CHON DIEM : "))

    (command "-boundary" A "")

    (setq B (ssget "L"))

    (command "offset" "0.5" B A "")

    (setq C (ssget "L"))

    (command "hatch" "ANSI31" "3" "0" C B "")

    (COMMAND "CHPROP" (ssget "L") "" "LA" "HATCH" "")

    (command "erase" B "")

    (command "erase" C "")

    (princ))

     

    untitled.jpg


  14. các Bác ơi cho em hỏi 1 chút là sao em dùng cái lisp của bác Hoành khi xuất tọa độ qua file xxx.txt mà không có kb nào vậy nhỉ?

    nhân tiện đây nhờ các chuyên gia giúp em có thể xuất tọa độ trực tiếp 1 bảng liệt kê tọa độ ngay trên bản vẽ như hình minh họa kèm theo dưới đây được không a? cảm ơn các Bác rất nhiều!

    Hình minh họa: http://www.cadviet.com/upfiles/3/drawing.dwg

×