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  
031113

[Nhờ chỉnh sửa] lisp xuất tọa độ

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

Em đang dùng lệnh xuất toạ độ vc của diễn đàn, nhưng em muốn chỉnh lại 1 chút cho phù hợp với công việc ( em muốn thay đổi vị trí 2 cột tọa độ X và Y cho nhau) mong các anh chỉnh giúp em. Em xin cảm ơn trước.Untitled_zps607b4f8e.png

 

http://www.mediafire.com/download/eg45wylb5osw1tt/vc.lsp

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

Em đang dùng lệnh xuất toạ độ vc của diễn đàn, nhưng em muốn chỉnh lại 1 chút cho phù hợp với công việc ( em muốn thay đổi vị trí 2 cột tọa độ X và Y cho nhau) mong các anh chỉnh giúp em. Em xin cảm ơn trước.Untitled_zps607b4f8e.png

 

http://www.mediafire.com/download/eg45wylb5osw1tt/vc.lsp

Đã sửa lại cho bạn, của bạn đây:

;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by Ssg - September 2008 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
    (setq p1 (polar p0 (dtr a) r))
    (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
    (setq L (append L (list (vlax-curve-getPointAtParam e i))))
    (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0  "TEXT") (cons 7 (getvar "textstyle"))
    (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 h) (cons 72 1) (cons 73  2)))
)
;;;-------------------------------------------------------------------------------
(defun Collect(e / e2 SS) ;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil) (setq ss (collect (entnext)))
	(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
    p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
    p2 (polar p1 0 (* 8 h))
    p3 (polar p2 0 (* 12 h))
    p4 (polar p3 0 (* 8 h))
    pL (list p1 p2 p3 p4)
    i 0
)
(repeat 3
    (wtxtMC (nth i txtL) (nth i pL) h)
    (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun mesh1() ;;;Make 1 mesh unit
(linepy p0 (* -3 h))
(command "copy" "L" "" p0 (list (+ (car p0) (* 4 h)) (cadr p0)))
(command "array" "L" "" "r" 1 3 (* 12 h))
(linepx (polar p0 (* 1.5 pi) (* 3 h)) (* 28 h))
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 pvL oldos j pv num txtL ss bn)
;;;Vertex Co-ordinate

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
    p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
    p0 p00
    pvL (reverse (getvert et))
    oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 28 h))
(mesh1)
(txt1 (list "TT" "X" "Y"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0)
(repeat (1- (length pvL))
    (mesh1)
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
        txtL (list num (rtos (cadr pv)) (rtos (car pv)) )
    )
    (txt1 txtL)
    ;(wtxtMC num (polar pv 0 h) h)
    (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
    (setq j (1+ j))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(command "erase" et "")
(setq bn "1")
(while (tblsearch "block" bn) (setq bn (itoa (1+ (atoi bn)))))
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setq j 0)
(repeat (1- (length pvL))
    (setq
        pv (nth j pvL)
        num (itoa (1+ j))
    )
    (wtxtMC num (polar pv 0 h) h)
    (setq j (1+ j))
)

;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

  • 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

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  

×