Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hungpmanh

Nhờ các cao thủ chỉnh lips xuất tọa độ

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

 Em xin chào các cụ. Em có 1 lips xuất tọa độ ra bảng trên cad ( gồm tên điểm, tọa độ XY , chiều dài cạnh), cái này em lấy trên cad việt về ạ. Em muốn nhờ các cụ chỉnh sửa hộ em để phần tọa độ lấy sau dấu phẩy 3 số, phần chiều dài cạnh lấy sau dấu phẩy 1 số. Thanks các cụ.

 

;; free lisp from cadviet.com

(vl-load-com)
(defun C:TDKT (/ Olmode STT loop TD_Point Lts Pnt P_dat n i P1 P2 P3 P4 P_cuoi P_Text Pdat_KC  CDKC  Pnt_i P_i P_i_1  Pnt_KC Lts1);;;;;TOA DO KICH THUOC
(setvar "CMDECHO" 0)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(or *h* (setq *h* 2))
(setq h (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
 (rtos *h* 2 2)
"> :"
 )
 )
)
(if (not h) (setq h *h*) (setq *h* h))
(setvar "OSMODE" 9)
(setq STT 1)
(setq loop T)
(setq TD_Point (list))
(setq Lts (list))
(_layer2  "Heaven2407" 2)
(while loop
(setq Pnt (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m : "))
  (cond
 (T
(if Pnt
 (progn
   
;;;       (setq P_STT (Polar3 Pnt 0 (/ h 2.0)))
    (setq P_STT (Polar3 Pnt 0 0))
  (wtxt (rtos STT 2 0) P_STT (* h 2.0) 0 "L" "Heaven2407")
  (setq TD_Point (list STT (list (car Pnt) (cadr Pnt))))
    (setq Lts (append Lts (list TD_Point)))
   
 )
 (setq loop nil)
)
 )
)
  (setq STT (1+ STT))
 
)
(setq n (length Lts))
(setq P_dat (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n b\U+1EA3ng t\U+1ECDa \U+0111\U+1ED9 v\U+00E0 k\U+00EDch th\U+01B0\U+1EDBc: "))
(setq i 0)
(setq P1 (Polar3 P_dat (* 4.0 h) 0))
(setq P2 (Polar3 P1 (* h 8.0) 0))
(setq P3 (Polar3 P2 (* h 8.0) 0))
(setq P4 (Polar3 P3 (* h 6.0) 0))
(setq P_cuoi (Polar3 P_dat 0 (+ (* (* -2.0 h) (+ n 1)) 1)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P_cuoi)))
(entmake (list (cons 0 "LINE") (cons 10 P_cuoi) (cons 11 (list (car P4) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 (list (car P4) (cadr P_cuoi))) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P1) (cons 11 (list (car P1) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P2) (cons 11 (list (car P2) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P3) (cons 11 (list (car P3) (cadr P_cuoi)))))
(setq P_Text (Polar3 P_dat (* h 2.0) (* h -2.0)))
(setq Pdat_KC (Polar3 P_Text (* h 21.0) (* h -1.0)))
(setq PLine_ngangdau (Polar3 P_dat 0.0 (* h -2.25)))
(while (< i (- n 1))
  (setq P1 (car (cdr (nth i Lts))))
  (setq P2  (car (cdr (nth (+ i 1) Lts))))
  (setq KCLT  (distance P1 P2))
  
  
  ;;;GHI SO THU TU
  (setq Pnt_i (Polar3 P_Text 0.0 (* i (* h -2.0))))
  (setq NDSTT (car (nth i Lts)))
(wtxt (rtos NDSTT 2 0) Pnt_i h 0 "BC" nil)
 
  ;;;GHI TOA DO X
(setq Pnt_i_X (Polar3 P_Text (* h 6.0) (* i (* -2.0 h))))
  (setq TD_X (car P1))
(wtxt (rtos TD_X 2 2) Pnt_i_X h 0 "BC" nil)
 
  ;;;GHI TOA DO Y
(setq Pnt_i_Y (Polar3 P_Text (* h 14.0) (* i (* -2.0 h))))
  (setq TD_Y (cadr P1))
(wtxt (rtos TD_Y 2 2) Pnt_i_Y h 0 "BC" nil)
 
  ;;;GHI KHOANG CACH
(setq Pnt_KC (Polar3 Pdat_KC 0.0 (* i (* -2.0 h))))
(wtxt (rtos KCLT 2 2) Pnt_KC h 0 "BC" nil)
 
 
  ;;KE LINE NGANG
(setq P_Line (Polar3 PLine_ngangdau 0 (* i (* h -2.0))))
  (entmake (list (cons 0 "LINE") (cons 10 P_Line) (cons 11 (list (car P3) (cadr P_Line) ))))
 
(setq i (1+ i))
)
  ;;;GHI SO THU TU
  (setq Pnt_i1 (Polar3 P_Text 0 (* (- n 1) (* -2.0 h))))
  (setq NDSTT1 (car (nth 0 Lts)))
(wtxt (rtos NDSTT1 2 0) Pnt_i1 h 0 "C" nil)
 
  ;;;GHI TOA DO X
(setq Pnt_i_X1 (Polar3 P_Text (*  h 6.0) (* (- n 1) (* h -2.0))))
  (setq TD_X1 (car (car (cdr (nth 0 Lts)))))
(wtxt (rtos TD_X1 2 2) Pnt_i_X1 h 0 "C" nil)
 
  ;;;GHI TOA DO Y
(setq Pnt_i_Y1 (Polar3 P_Text (* h 14.0) (* (- n 1) (* -2.0 h))))
  (setq TD_Y1 (cadr (car (cdr (nth 0 Lts)))))
(wtxt (rtos TD_Y1 2 2) Pnt_i_Y1 h 0 "C" nil)
 
  
(setvar "OSMODE" Olmode)
;;;(princ Lts1)
(princ)
)
 
(defun Polar3 (Pnt KC1 KC2 /  P1)
(setq P1 (list (+ (car Pnt) KC1) (+ (cadr Pnt) KC2)))
)
 
(defun wtxt (string Point Height Ang justify Layer / Lst)
 (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)
   (if Ang (cons 50 Ang))
   (cons 7 (if Style Style (getvar "Textstyle"))))
  justify (strcase justify))
 (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
        ((= justify "L") (setq Lst (append Lst (list (cons 72 0)(cons 73 0) (cons 10 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))))))
 (entmake Lst)
)
 
 
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
 
  • Vote giảm 1

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


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

Tạ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  

×