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  
nvhoang

Toạ độ hiển thị của toạ độ điểm

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

Tôi có sử dụng một LISP để xác định toạ độ của các điểm trên bản vẽ, nhưng vướng ở chỗ là toạ độ không đồng nhất, và sau khi chỉ điểm và lôi toạ độ ra thì tuỳ theo hướng kéo toạ độ mà cách hiển thị toạ độ khác nhau, không giống nhau. Nhờ mọi người cho cách căn chỉnh các vị trí hiển thị của X, Y , Z sao cho thẳng cho dù ở bất kì điểm nào, kéo toạ độ theo bất cứ huớng nào.

Cảm ơn nhiều

LISP như sau:

(DEFUN C:DSD()

(prompt"\nGet EAST and NORTH of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setvar "Textstyle" "Romans")

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pxy (strcat "E: " pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0)) ;y distance

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;y printing

(setq *error* oer seterr nil)

(princ)

)

 

;*********************************************

(DEFUN C:SSD()

(prompt"\nGet EAST,NORTH and ELEVATION of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

(setq pz (caddr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pzt (strcat "EL.: " (rtos pz 2 (getvar "luprec")))) ;z value

(setq pxy (strcat pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;text input (print)

(setq txtpnt2 (list (car txtpnt1)

(- (cadr txtpnt1) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt2 ts "0.0" pzt)

(setq *error* oer seterr nil)

(princ)

 

)

(Prompt"\nDSD--> Get East, North.")

(Prompt"\nSSD--> Get East, North, Elevation.\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
Tôi có sử dụng một LISP để xác định toạ độ của các điểm trên bản vẽ, nhưng vướng ở chỗ là toạ độ không đồng nhất, và sau khi chỉ điểm và lôi toạ độ ra thì tuỳ theo hướng kéo toạ độ mà cách hiển thị toạ độ khác nhau, không giống nhau. Nhờ mọi người cho cách căn chỉnh các vị trí hiển thị của X, Y , Z sao cho thẳng cho dù ở bất kì điểm nào, kéo toạ độ theo bất cứ huớng nào.

Cảm ơn nhiều

LISP như sau:

(DEFUN C:DSD()

(prompt"\nGet EAST and NORTH of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setvar "Textstyle" "Romans")

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pxy (strcat "E: " pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0)) ;y distance

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;y printing

(setq *error* oer seterr nil)

(princ)

)

 

;*********************************************

(DEFUN C:SSD()

(prompt"\nGet EAST,NORTH and ELEVATION of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

(setq pz (caddr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pzt (strcat "EL.: " (rtos pz 2 (getvar "luprec")))) ;z value

(setq pxy (strcat pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;text input (print)

(setq txtpnt2 (list (car txtpnt1)

(- (cadr txtpnt1) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt2 ts "0.0" pzt)

(setq *error* oer seterr nil)

(princ)

 

)

(Prompt"\nDSD--> Get East, North.")

(Prompt"\nSSD--> Get East, North, Elevation.\n")

;*******************************************************************************

 

 

*****

mình không tự viết được, nhưng có cho bạn đây. lệnh td

;This function is used to pick up coordinates(X,Y)

;then display coordinates on drawing

;

(defun C:td(/ PNT1 P1X P1Y STDX STDY COORDN COORDE PTXT)

(setq PNT1 (getpoint

"\nPick coordinate point: "))

(setq P1Y (cadr pnt1)) ;Y coord

(setq P1X (car pnt1)) ;X coord

(setq STDX (rtos P1X 2 3))

(setq STDY (rtos P1Y 2 3))

(setq COORDN (strcat "X""="STDX ))

(setq COORDE (strcat "Y""="STDY ))

(setq PTXT (getpoint

"\nPick text location: "))

(command "LEADER" PNT1 PTXT "" COORDN COORDE "")

(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ôi có sử dụng một LISP để xác định toạ độ của các điểm trên bản vẽ, nhưng vướng ở chỗ là toạ độ không đồng nhất, và sau khi chỉ điểm và lôi toạ độ ra thì tuỳ theo hướng kéo toạ độ mà cách hiển thị toạ độ khác nhau, không giống nhau. Nhờ mọi người cho cách căn chỉnh các vị trí hiển thị của X, Y , Z sao cho thẳng cho dù ở bất kì điểm nào, kéo toạ độ theo bất cứ huớng nào.

Cảm ơn nhiều

LISP như sau:

(DEFUN C:DSD()

(prompt"\nGet EAST and NORTH of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setvar "Textstyle" "Romans")

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pxy (strcat "E: " pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0)) ;y distance

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;y printing

(setq *error* oer seterr nil)

(princ)

)

 

;*********************************************

(DEFUN C:SSD()

(prompt"\nGet EAST,NORTH and ELEVATION of selected point utility")

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE"))) ;dimension text size

(setq pt1 (getpoint "Pick a point for getting information:\n"))

(setq pt2 (getpoint pt1 "Pick a point for display information:\n"))

(setq px (car pt1))

(setq py (cadr pt1))

(setq pz (caddr pt1))

;****** real to string

(setq pxt (strcat "E: " (rtos px 2 (getvar "luprec")))) ;x value

(setq pyt (strcat "N: " (rtos py 2 (getvar "luprec")))) ;y value

(setq pzt (strcat "EL.: " (rtos pz 2 (getvar "luprec")))) ;z value

(setq pxy (strcat pxt)) ;x value

(command "dim1" "leader" pt1 pt2 "" pxt)

(command "EXPLODE" "L")

(setq txtpnt (cdr (assoc 10 (entget (entlast))))) ;text location

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt1 ts "0.0" pyt) ;text input (print)

(setq txtpnt2 (list (car txtpnt1)

(- (cadr txtpnt1) (* 2.0 ts)) 0.0))

(command "TEXT" "ML" txtpnt2 ts "0.0" pzt)

(setq *error* oer seterr nil)

(princ)

 

)

(Prompt"\nDSD--> Get East, North.")

(Prompt"\nSSD--> Get East, North, Elevation.\n")

;*******************************************************************************

 

 

*****

Để hiện thị tất cả ra màn hình mà thẳng bạn phải sử dụng hàm ENTMAKE và hàm TRANS thì mới có kết quả.

  • 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  

×