Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 hungpmanh

hungpmanh

    Chưa sử dụng CAD

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

Đã gửi 19 June 2015 - 03:43 PM

 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

;;; this lisp was downloaded from http://www.cadviet.c...-toa-do-vn2000/
(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)
            )
        )
    )
)
 

  • -1

#2 hungpmanh

hungpmanh

    Chưa sử dụng CAD

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

Đã gửi 19 June 2015 - 04:02 PM

Không có cao thủ nào vào giúp ạ


  • -1

#3 tuanchung90

tuanchung90

    Chưa sử dụng CAD

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

Đã gửi 12 August 2015 - 12:54 PM

Dùng lisp này đi bạn !

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


  • 0