Chuyển đến nội dung
Diễn đàn CADViet
akay_arch

[Nhờ chỉnh sửa] Nhờ các cao thủ sửa hộ lisp thống kê tọa độ theo ý muốn

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

Cái lisp thống kê tọa độ của bạn ThaiStreetz viết rất tốt cho công việc của mình link nó đây ạ: http://www.cadviet.com/forum/index.php?showtopic=12702&st=0. Nhưng có điều là khi xuất tọa độ trên Cad và ghi ra bản vẽ thì phải đổi vị trí tọa độ X và Y cho nhau - đấy là điều mình muốn nhờ tác giả hoặc bạn nào rành về lisp sửa hộ. Vì topic trên lâu quá rồi nên mình không yêu cầu ở đấy nữa. Mạo muội tạo topic mới. Xin phép mod cho xin 1 thời gian ngắn. hoặc ai biết lisp nào đã sửa theo đúng ý mình làm ơn chỉ dùm đường link. thank all

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

Việc sửa thì chắc không khó, nhưng bạn đang làm khó cho người sửa:

1). Lisp nằm ở đâu thì hỏi ngay ở đó, chứ đừng mở topic khác => nhạt forum.

2). Tôi đọc link bạn chỉ thì trong link đó có rất nhiều lisp sửa đi sửa lại, không thể biết cái nào bạn nhờ.

=> qua lại topic đó hỏi, chỉ ngay bài đó (ví dụ ở #3 chẳng bạn).

  • 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

Bạn đổi 2 dòng sau

  	x   (rtos (car D1) 2 4)
   	y   (rtos (cadr D1) 2 4)
TX (strcat "X="(rtos (Car D1) 2 4))
TY (strcat "Y="(rtos (Cadr D1) 2 4))

Thành

   	y   (rtos (car D1) 2 4)
   	x   (rtos (cadr D1) 2 4)
TY (strcat "X="(rtos (Car D1) 2 4))
TX (strcat "Y="(rtos (Cadr D1) 2 4))

  • 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

@Doan Van Ha: lý do mở topic mới mình đã nêu rồi. lần sâu mình sẽ rút kinh nghiệm. :))

@CD2k44: Cám ơn bạn nhiều. Bạn học cầu đường K44 ĐHXD à. mình 44KD4 của ĐHXD đây. Mỗi tội gà về lisp lắm.

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

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là "X=582027.2825 Y=2187655.3823" nhưng mình muốn ghi ra trên bản vẽ là "X=2187655.3823 Y=582027.2825". Bạn xem giúp mình được không.

@ Doan Van Ha: Code của lisp gốc là:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
 	ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq   D1 (getpoint "\nPick diem toa do:"))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint "\nDiem dat text:" D1)
   	x   (rtos (car D1) 2 4)
   	y   (rtos (cadr D1) 2 4)
TX (strcat "X="(rtos (Car D1) 2 4))
TY (strcat "Y="(rtos (Cadr D1) 2 4))
  	tapx (append tapx (list x))
  	tapy (append tapy (list y))
   	k   (+ 1 k)
   	N   (strcat ten (rtos k 2 0))
   	stt (append stt (list N))
 );setq
 (if (>= (car DX) (car D1))
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BL" D2 h 0 tX)
  (setq   TB  (textbox (entget(entlast)))
 	LC  (car TB)
RC  (cadr TB)
 	di  (distance LC RC)
 PT3 (polar D2 0 (+ di (* 0.6 h)))
 pt4 (list (car D2) (- (cadr D2) (* 1.4 h)))
 pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 h)))
 C   (polar PT3 0 (* 1.5 h))
  );setq
  (command "text" "F" PT4 PT5 h ty
    		"pline" D1 DX PT3 ""
    		"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
    		"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
    		"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
    		"CECOLOR" 8
  "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1))
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BR" D2 h 0 tx)
(setq   TB  (textbox (entget(entlast)))
   	LC  (car TB)
  	RC  (cadr TB)
   	di  (distance LC RC)
PT3 (polar D2 0 (- (+ di (* 0.6 h))))
pt4 (list (- (car D2) di) (- (cadr D2) (* 1.4 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.4 h)))
PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h TY
      		"pline" D1 DX PT3 ""
      		"circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
      		"text" "m" (polar PT6 0 (* 1.5 h)) h 0 N
      		"CECOLOR" 8
"circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
;=============================================
;tao bang thong ke
 (setq di (- di (* 2 h))
kc (* 2 di)
   	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
  	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
  	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
  	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
 	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 	PTY (list (+ kc (car PTX)) (cadr PTX))
  	p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  	p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  	p33 (list (+ kc (car p22)) (cadr p22))
  	L1 (list (+ di (car p3))(cadr p3))
  	L2 (list (+ kc (car L1))(cadr L1))
PTB (list (+ (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
 	n (length tapx)
 	k 0
);setq
 (setvar "osmode" 0)
 (command "CECOLOR" 3
"line" p1 p2 ""
   	"line" p3 p4 ""
   	"CECOLOR" 2
   	"text" "m" p11 h 0 "STT"
   	"text" "m" p22 h 0 "Täa ®é X"
   	"text" "m" p33 h 0 "Täa ®é Y"
   	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")  
 (while (< k n)
(setq xx (nth k tapx)
 	yy (nth k tapy)
tstt(nth k stt))
(command "CECOLOR" 2
 	"text" "m" PTD h 0 tstt
    		"text" "m" PTX h 0 xx
    		"text" "m" PTY h 0 yy
 	"CECOLOR" 3
    		"line" PT PTC "")  
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
     	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
     	PTY (list (+ kc (car PTX)) (cadr PTX))
     	k (+ 1 k));setq
 );while
 (if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	L11 (list (+ di (car PT))(cadr PT))
     	L22 (list (+ kc (car L11))(cadr L11))
);setq
  );if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

Bạn xem giúp mình với. Cám ơn nhiều.

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

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là "X=582027.2825 Y=2187655.3823" nhưng mình muốn ghi ra trên bản vẽ là "X=2187655.3823 Y=582027.2825". Bạn xem giúp mình được không.

@ Doan Van Ha: Code của lisp gốc là:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
 	ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq   D1 (getpoint "\nPick diem toa do:"))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint "\nDiem dat text:" D1)
   	x   (rtos (car D1) 2 4)
   	y   (rtos (cadr D1) 2 4)
TX (strcat "X="(rtos (Car D1) 2 4))
TY (strcat "Y="(rtos (Cadr D1) 2 4))
  	tapx (append tapx (list x))
  	tapy (append tapy (list y))
   	k   (+ 1 k)
   	N   (strcat ten (rtos k 2 0))
   	stt (append stt (list N))
 );setq
 (if (>= (car DX) (car D1))
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BL" D2 h 0 tX)
  (setq   TB  (textbox (entget(entlast)))
 	LC  (car TB)
RC  (cadr TB)
 	di  (distance LC RC)
 PT3 (polar D2 0 (+ di (* 0.6 h)))
 pt4 (list (car D2) (- (cadr D2) (* 1.4 h)))
 pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 h)))
 C   (polar PT3 0 (* 1.5 h))
  );setq
  (command "text" "F" PT4 PT5 h ty
			"pline" D1 DX PT3 ""
			"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
			"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
			"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
			"CECOLOR" 8
  "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1))
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BR" D2 h 0 tx)
(setq   TB  (textbox (entget(entlast)))
   	LC  (car TB)
  	RC  (cadr TB)
   	di  (distance LC RC)
PT3 (polar D2 0 (- (+ di (* 0.6 h))))
pt4 (list (- (car D2) di) (- (cadr D2) (* 1.4 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.4 h)))
PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h TY
  			"pline" D1 DX PT3 ""
  			"circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
  			"text" "m" (polar PT6 0 (* 1.5 h)) h 0 N
  			"CECOLOR" 8
"circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
;=============================================
;tao bang thong ke
 (setq di (- di (* 2 h))
kc (* 2 di)
   	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
  	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
  	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
  	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
 	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 	PTY (list (+ kc (car PTX)) (cadr PTX))
  	p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  	p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  	p33 (list (+ kc (car p22)) (cadr p22))
  	L1 (list (+ di (car p3))(cadr p3))
  	L2 (list (+ kc (car L1))(cadr L1))
PTB (list (+ (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
 	n (length tapx)
 	k 0
);setq
 (setvar "osmode" 0)
 (command "CECOLOR" 3
"line" p1 p2 ""
   	"line" p3 p4 ""
   	"CECOLOR" 2
   	"text" "m" p11 h 0 "STT"
   	"text" "m" p22 h 0 "Täa ®é X"
   	"text" "m" p33 h 0 "Täa ®é Y"
   	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")  
 (while (< k n)
(setq xx (nth k tapx)
 	yy (nth k tapy)
tstt(nth k stt))
(command "CECOLOR" 2
 	"text" "m" PTD h 0 tstt
			"text" "m" PTX h 0 xx
			"text" "m" PTY h 0 yy
 	"CECOLOR" 3
			"line" PT PTC "")  
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
     	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
     	PTY (list (+ kc (car PTX)) (cadr PTX))
     	k (+ 1 k));setq
 );while
 (if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	L11 (list (+ di (car PT))(cadr PT))
     	L22 (list (+ kc (car L11))(cadr L11))
);setq
  );if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

Bạn xem giúp mình với. Cám ơn nhiều.

đoạn code lấy tọa độ điểm của bạn chính là đoạn mình ghi ở trên.Theo lisp của bác Thai thì nó lấy x, y như vậy, khi bạn đổi vị trí này thì kết quả sẽ như bạn muốn

  • 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

Sửa 4 dòng này:

x (rtos (car D1) 2 4)

y (rtos (cadr D1) 2 4)

TX (strcat "X="(rtos (Car D1) 2 4))

TY (strcat "Y="(rtos (Cadr D1) 2 4))

Thành 4 dòng này:

x (rtos (cadr D1) 2 4)

y (rtos (car D1) 2 4)

TX (strcat "X="(rtos (Cadr D1) 2 4))

TY (strcat "Y="(rtos (Car D1) 2 4))

  • 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

@ CD2K44:

Mình thử rồi nhưng chỉ là thay đổi vị trí đặt hiển thị giữa Y=2187655.3823/X=582027.2825 so với cái code gốc là X=582027.2825/Y=2187655.3823. cái mình muốn là X=2187655.3823/Y=582027.2825

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

Xin chào các bạn!

mình mới nhận được lips tọa độ này. Khi dùng nếu không đổi trục tọa độ thì bình thường nhưng nếu đổi trục theo lệnh UCS thì vòng tròn ở một nơi, tên điểm ở một nơi. Xin nhờ các Pro giúp với:

 

GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst)
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 tapx tapy obj ss
           x y xx yy h n di kc ten
           C PT PTX PTY PTD PTC N
           p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
    tapy '()
    stt '()
    k 0
    h (getreal "\nNhap chieu cao chu:")
    ten (getstring "\nNhap ten diem:"))
(while
  (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
    (setq   PT1 (getpoint diem "Nhap diem thu 2")
         x (rtos(car diem) 2 4)
             y (rtos (cadr diem) 2 4)
       tapx (append tapx (list x))
       tapy (append tapy (list y))
         k (+ 1 k)
         N (strcat ten (rtos k 2 0))
        stt (append stt (list N))      );setq
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast))
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss))
LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
         "circle" C (* 1.8 h))
         (textM C h N)
    (setvar "osmode" om)    );dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

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


×