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

    • Nguyen Hoanh

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

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

Nhờ sửa lisp

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

San_Mocmoc    1

Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi

 

;CHUONG TRINH PHUN DIEM MIA X,Y,Z
;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU
;-------------DINH DANG MAU----------------------
;TENDIEM   X      Y    Z    CODE
;KV1         0      0    0    1
;KV2       10      0    0    1
;1       5      10    0
;2       10      6    0
;KV3       10      10    0    1
(defun c:pdm (/ ms PR FN thunhat tentram caodotram xtram ytram
        htram tentrammay tendh
        )
  (bdau)
  (setq tam ())
  (setq i 0)
 ;  (setq ms 1000)
  (setq
    FN (getfiled "NhËp file nguån : "
         ""
         ""
         4
       )
  )
 (SETQ MS (GETREAL "Nhap vao mau so ty le ban do : "))
(setq ms (* ms 2))
  (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" "diemmia" "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))
        (thuchien)
    (if (= (nth 4 PR) 1);neu code= 1 thi ve
    (ve)
        )
      )                    ;end progn
    )                    ;end while
  );end progn
  (close FN)
  (command "zoom" "e")
  (kthuc)
  (princ)
)
(defun thuchien (/ TEN )
  (setq ten (convtostr (nth 0 PR)));chuyen tu symbol sang string
  (setq td (list (nth 2 PR) (nth 1 PR) (nth 3 PR)))
  (setq tam (append tam td));dua toa do diem thu n vao trong list tam
  (command "-layer" "s" "diem" "")
  (command "point" td)
  (command "-style" "diemmia" "txt.shx" st1  "1" "0" "n" "n" "n")
  (command "-layer" "s" "sothutu" "")
  (command "text" td "" ten)
  (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n")
  (command "-layer" "s" "caodo" "")
  (command "text" "tl" td "" (rtos (nth 3 PR) 2 1))
)
(defun ve ()
  (setq diemcuoi td)
  (if (/= i 0)
    (progn
      (command "line" diemdau diemcuoi "")
    )
  )
  (setq diemdau diemcuoi)
  (setq i (+ i 1))
)
;CHUONG TRINH CHUYEN HAI COT X VA Y CHO NHAU
;---------DINH DANG MAU----------
;TEN       X      Y     Z    CODE
;KV1    100.00    50.00    1.5    1
;KV2    200.00    31.00    2.1
(defun c:chuyencot(/ FN FD i ch PR TEN X Y Z CODE TD XUAT)
  (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 FN (open FN "r"))
  (while (and (setq PR (read-line FN)) (/= PR ""))
      (progn
        (setq PR (strcat "(" PR ")"))
        (setq PR (read PR))
    (setq ten (dd (convtostr (nth 0 PR))))
        (setq x (dd (convtostr (nth 1 PR))))
    (setq y (dd (convtostr (nth 2 PR))))
    (setq z (dd (convtostr (nth 3 PR))))
    (setq code (nth 4 PR))
    (if (/= code nil)
      (setq td (strcat ten y x z (convtostr code)))
      (setq td (strcat ten y x z))
    )
    (write-line td FD)
      )                    ;end progn
    )                    ;end while
  (close FD)
  (close FN)
)

(defun bdau ()
  (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 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- - - -
<Chaudaubac 0913.167111> ")
    (setq *error* olderr)
(princ)
)
(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 "")))
  )
)
 
________________________________________________

File So Lieu

1    2339097.81    549068.55    1
2    2339127.18    549077.58    2
3    2339131.33    549078.35    3
4    2339135.72    549077.89    4
5    2339139.53    549076.32    5
6    2339142.77    549073.78    6
7    2339302.5    548908.23    7
8    2339294.43    548887.96    8
9    2339402.91    548767.01    9
10    2339273.21    548697.27    10
11    2339253.31    548705.86    11
12    2339231.99    548709.79    12
13    2339210.33    548708.84    13
14    2339175.48    548820.72    14
15    2339172.28    548830.99    15
16    2339114.96    549015.01    16
17    2339106.61    549041.66    17

http://www.cadviet.com/upfiles/4/139428_

  • Vote giảm 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi

;CHUONG TRINH PHUN DIEM MIA X,Y,Z
;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU
;-------------DINH DANG MAU----------------------
;TENDIEM   X      Y    Z    CODE
;KV1         0      0    0    1
;KV2       10      0    0    1
;1       5      10    0
;2       10      6    0
;KV3       10      10    0    1
(defun c:pdm (/ ms PR FN thunhat tentram caodotram xtram ytram
        htram tentrammay tendh
        )
  (bdau)
  (setq tam ())
  (setq i 0)
 ;  (setq ms 1000)
  (setq
    FN (getfiled "NhËp file nguån : "
         ""
         ""
         4
       )
  )
 (SETQ MS (GETREAL "Nhap vao mau so ty le ban do : "))
(setq ms (* ms 2))
  (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" "diemmia" "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))
        (thuchien)
    (if (= (nth 4 PR) 1);neu code= 1 thi ve
    (ve)
        )
      )                    ;end progn
    )                    ;end while
  );end progn
  (close FN)
  (command "zoom" "e")
  (kthuc)
  (princ)
)
(defun thuchien (/ TEN )
  (setq ten (convtostr (nth 0 PR)));chuyen tu symbol sang string
  (setq td (list (nth 2 PR) (nth 1 PR) (nth 3 PR)))
  (setq tam (append tam td));dua toa do diem thu n vao trong list tam
  (command "-layer" "s" "diem" "")
  (command "point" td)
  (command "-style" "diemmia" "txt.shx" st1  "1" "0" "n" "n" "n")
  (command "-layer" "s" "sothutu" "")
  (command "text" td "" ten)
  (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n")
  (command "-layer" "s" "caodo" "")
  (command "text" "tl" td "" (rtos (nth 3 PR) 2 1))
)
(defun ve ()
  (setq diemcuoi td)
  (if (/= i 0)
    (progn
      (command "line" diemdau diemcuoi "")
    )
  )
  (setq diemdau diemcuoi)
  (setq i (+ i 1))
)
;CHUONG TRINH CHUYEN HAI COT X VA Y CHO NHAU
;---------DINH DANG MAU----------
;TEN       X      Y     Z    CODE
;KV1    100.00    50.00    1.5    1
;KV2    200.00    31.00    2.1
(defun c:chuyencot(/ FN FD i ch PR TEN X Y Z CODE TD XUAT)
  (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 FN (open FN "r"))
  (while (and (setq PR (read-line FN)) (/= PR ""))
      (progn
        (setq PR (strcat "(" PR ")"))
        (setq PR (read PR))
    (setq ten (dd (convtostr (nth 0 PR))))
        (setq x (dd (convtostr (nth 1 PR))))
    (setq y (dd (convtostr (nth 2 PR))))
    (setq z (dd (convtostr (nth 3 PR))))
    (setq code (nth 4 PR))
    (if (/= code nil)
      (setq td (strcat ten y x z (convtostr code)))
      (setq td (strcat ten y x z))
    )
    (write-line td FD)
      )                    ;end progn
    )                    ;end while
  (close FD)
  (close FN)
)

(defun bdau ()
  (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 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- - - -
<Chaudaubac 0913.167111> ")
    (setq *error* olderr)
(princ)
)
(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 "")))
  )
)
 
________________________________________________

File So Lieu

1    2339097.81    549068.55    1

2    2339127.18    549077.58    2

3    2339131.33    549078.35    3

4    2339135.72    549077.89    4

5    2339139.53    549076.32    5

6    2339142.77    549073.78    6

7    2339302.5    548908.23    7

8    2339294.43    548887.96    8

9    2339402.91    548767.01    9

10    2339273.21    548697.27    10

11    2339253.31    548705.86    11

12    2339231.99    548709.79    12

13    2339210.33    548708.84    13

14    2339175.48    548820.72    14

15    2339172.28    548830.99    15

16    2339114.96    549015.01    16

17    2339106.61    549041.66    17

 

http://www.cadviet.com/upfiles/4/139428_

Hề hề hề,

Nhắc bạn chủ thớt lần sau nên cho mã lisp vào codebox. Lần này mình làm giúp, nếu lần sau bạn không tự làm thì e rằng bài viết sẽ bị xóa đấy.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
San_Mocmoc    1

"Nhắc bạn chủ thớt lần sau nên cho mã lisp vào codebox. Lần này mình làm giúp, nếu lần sau bạn không tự làm thì e rằng bài viết sẽ bị xóa đấy". Quả thật là mình cũng chưa biết cách vào codebox. Mong bạn phamthanhbinh sửa giup mình với. Xin cảm ơn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

"Nhắc bạn chủ thớt lần sau nên cho mã lisp vào codebox. Lần này mình làm giúp, nếu lần sau bạn không tự làm thì e rằng bài viết sẽ bị xóa đấy". Quả thật là mình cũng chưa biết cách vào codebox. Mong bạn phamthanhbinh sửa giup mình với. Xin cảm ơn

Hề hề hề,

Bạn hãy đọc kỹ phần hướng dẫn sử dụng của forum.

Việc đưa code vào trong codebox chỉ đơn giản là nhập thêm các mã quy định của forum vào trước và sau đoạn mã code của bạn mà thôi. 

Cụ thể mã trước là

và mã sau là

Bạn hãy thử làm xem sao.

Về cái lisp của bạn do người viết làm trên cơ sở file dữ liệu có cấu trúc khác với file dữ liệu mà bạn đã post, do vậy để sửa theo file dữ liệu của bạn có khi còn lâu hơn là viết code mới cho file dữ liệu này. Vấn đề là ở chỗ chưa rõ yêu cầu fun điểm mia của bạn có giống với các yêu cầu mà file lisp đã post thực hiện hay không nên chưa thể viết được bạn ạ. Giá như bạn có gửi kèm file Cad có mô tả cái kết quả bạn cần thì có lẽ mình đã có thể giúp bạn được.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×