Xin lisp ghi được cao độ cụ thể các điểm trên mặt cắt dọc

Tháng 11 17, 2008

Gửi bác Hoành:

Bác có thể viết lisp cho em với yêu cầu sau được không?

Nội dung là có thể ghi được cao độ cụ thể các điểm trên mặt cắt dọc.

Ví dụ cao độ tim đường là 15m, cao độ chân taluy la 12.5m, khi vẽ theo tỉ lệ 1:1 thì khoảng cách 2 vị trí này là 2500mm.

Ý em muốn là khi píc chuột vào vị trí tim đường thì sẽ xuất hiện luôn cao độ của nó là 15 (được hiển thị dưới dạng 1 bock ghi cao độ )

Và tương tự khi pic vào chân mái taluy thì cũng hiển thị cao độ la 12.5m.

Cảm ơn bác nhiều

Tháng 11 17, 2008

Gửi bác Hoành:
Bác có thể viết lisp cho em với yêu cầu sau được không?

Nội dung là có thể ghi được cao độ cụ thể các điểm trên mặt cắt dọc.

Ví dụ cao độ tim đường là 15m, cao độ chân taluy la 12.5m, khi vẽ theo tỉ lệ 1:1 thì khoảng cách 2 vị trí này là 2500mm.

Ý em muốn là khi píc chuột vào vị trí tim đường thì sẽ xuất hiện luôn cao độ của nó là 15 (được hiển thị dưới dạng 1 bock ghi cao độ )

Và tương tự khi pic vào chân mái taluy thì cũng hiển thị cao độ la 12.5m.

Cảm ơn bác nhiều

bạn hãy upload 1 file dwg lên diễn đàn.

Tháng 11 17, 2008

bạn hãy upload 1 file dwg lên diễn đàn.

Đây bác: http://www.cadviet.com/upfiles/Coc_12.dwg

Tháng 11 18, 2008

Đây bác: http://www.cadviet.com/upfiles/Coc_12.dwg

Bác Hoành đâu rồi nhỉ!

Tháng 11 18, 2008

Em up file rồi mà chẳng thấy bác nói j cả vậy?!

Tháng 11 18, 2008

Em up file rồi mà chẳng thấy bác nói j cả vậy?!

Ối rời, cái việc này đâu cần tới bác Hoành. Giết gà cần gì dao mổ trâu!

Bạn dùng con này; mà bạn nên sửa cho phú hợp!

;;==============================================================================

=========================

(defun cctn()

(setq pt1 (getpoint " Diem xac dinh bat ki :"))

(Setq l (car (entsel "\Cao do cua diem do: ")))

(Setq cd (atof (Cdr (assoc 1 (entget l)))))

(Setq cd2 (* cd -1))

(Setq cd1 (+ cd2 0))

(setq pt2 (polar pt1 (/ pi 2) cd1))

(command "ucs" "M" pt2 " "))

(defun cEQ()

(setvar "cmdecho" 0)

(setq p nil bd nil nghieng nil text nil htext nil)

(command "layer" "make" "2" "c" "2" "" "")

(command "style" "hoa" "VntimeH.shx,vn1.shx" 0.0 "0.8" 0.0 "" "" "")

(setq p (getpoint "\nNhap diem can dat cao trinh : " ))

(setvar "OSMODE" 0)

(if #cd #cd (setq #cd 1))

(setq #cd (abs (UDIST 0 "" "Nhap ty le = Chieu cao chu " #cd nil)))

(command "insert" "CD2t" p #cd "" "")

(setq diem1t (* -1.7 #cd))

(setq diem2t (* 1.8 #cd))

(setq bd (list (+ (car p) diem1t) (+ (cadr p) diem2t)))

(setq htext (* 1 #cd))

(setq text (rtos (cadr p) 2 2))

(command "text" "j" "Mc" bd htext "0" text "")

(setvar "OSMODE" 1)

(command "-osnap" "end,mid,nod,int,per,app,nea")

)

(DEFUN C:cđt()

(cctn)

(ceq)

(princ)

)

;;==============================================================================

=========================

File cad block đây

http://www.cadviet.com/upfiles/CD2t.dwg

Đã biết sử dụng chưa?

Tháng 11 18, 2008

Gửi bác Hoành:
Bác có thể viết lisp cho em với yêu cầu sau được không?

Nội dung là có thể ghi được cao độ cụ thể các điểm trên mặt cắt dọc.

Ví dụ cao độ tim đường là 15m, cao độ chân taluy la 12.5m, khi vẽ theo tỉ lệ 1:1 thì khoảng cách 2 vị trí này là 2500mm.

Ý em muốn là khi píc chuột vào vị trí tim đường thì sẽ xuất hiện luôn cao độ của nó là 15 (được hiển thị dưới dạng 1 bock ghi cao độ )

Và tương tự khi pic vào chân mái taluy thì cũng hiển thị cao độ la 12.5m.

Cảm ơn bác nhiều

Code đây sẽ làm được điều bạn cần :

;--------------------------------------------------------
(defun gc_err (s)
(if (/= s "Function cancelled")
	(princ (strcat "\nError: " s))
)
(setvar "Osmode" old_osmode)
(setq *error* old_err)
 (princ)
)
;;; Main Function:
(defun C:Mgco (/ block_in cot_base dim_scl dim_txt old_base_ data_base cot_in
			 text_h text_clr text_point next_p ghi_base old_ortho cao_do
			 old_ortho c_base n_base c_unit moc_st lim_out)
(setq old_osmode(getvar "Osmode")
  old_ortho(getvar "Orthomode"))
(setvar "Osmode" (+ 1 8 512)); End Node Near
(setvar "Orthomode" 0)
(setvar "Cmdecho" 0)
(setq old_error *error* *error* gc_err)
(prompt "\nNhap: \"T\" neu xac dinh cot theo moc tuong doi.")
(command "_.Ucs" "W")
(initget 9 "T");(+ 1 8)
(setq c_base(getpoint "\n-> Diem goc xac dinh cot /T/: ")
  block_in "C:\\Tue\\cot.dwg"
  next_p 0
  c_unit 0
  dim_txt(getvar "Dimtxt")
  dim_scl(getvar "Dimscale"))
(if(= c_base "T")
  (progn
  (initget 8)
  (setq c_base NIL c_unit NIL
		c_base(getpoint "\n-> Diem goc xac dinh cot tuong doi: "))
  (initget 8)
  (if c_base 
	  (setq c_unit(getdist "\n->> Nhap cao do moc tuong doi : "))
  )
  (if(= c_unit NIL)(setq c_unit 0.000))
  )
  (setq c_unit 0.0)
)
(if(= dim_scl 0.0)
  (setq dim_scl dim_txt dim_txt NIL)
  (setq dim_scl (* dim_scl dim_txt) dim_txt NIL))
(setq dim_scl (* dim_scl 2.0))
(if(not(findfile block_in))
  (progn(alert (strcat "\n  Thieu file: \""block_in"\" !  "))(setq next_p NIL c_base NIL)))
(if (and c_base c_unit)
(while next_p
 (if(= next_p 0);ghi cot moc
	(progn
	  (if(/= c_unit 0)(setq moc_st c_unit c_unit 0)(setq moc_st 0.0))
	  (initget "Y N") 
	  (setq ghi_base(getkword "\n->> Ghi cot vao diem goc ?/Y/: "))
		(if(or(= ghi_base "Y")(/= ghi_base NIL))  

		   (pro_cot c_base moc_st);Ghi cot vao vi tri moc
		)
	  (setq ghi_base NIL)
	)
 )
 (setvar "Osmode" 1);(+ 1 8 128)) End Node Per


 (initget 8)
 (if (setq n_point(getpoint "\n->> Diem ghi cot tiep theo: " c_base))
	 (progn 
;Pack for Out-size Limits:
	  (if(			 (progn 
		  (if(				 (cond
			   ((					(setq lim_out -1.0) )
			   ((> (cadr c_base)(cadr n_point))
				(setq lim_out -1.0) )
			   ((= (cadr c_base)(cadr n_point))
				(setq lim_out 1.0) )
			 )
		  )
		  (if(>= (cadr n_point) 0)
			 (setq lim_out 1) )
		 )
	  );if c_base 		  (if(> (cadr c_base) 0)
		 (setq lim_out 1) )
;End Pack
	  (setq cao_do(* lim_out (- (abs(cadr n_point)) (abs(cadr c_base))) )
			next_p (+ next_p 1))
	  (pro_cot n_point (+ cao_do c_unit))
	 )
	 (setq next_p NIL cao_do NIL c_base NIL n_point NIL)
 );if
);while
);if c_base
(setq cot_in NIL text_point NIL text_h NIL text_clr NIL dim_scl NIL cao_do NIL
  moc_st NIL c_unit NIL)
(setvar "Osmode" old_osmode)
(setvar "Orthomode" old_ortho)
(setq *error* old_err)
(princ)
)
;;;

(defun pro_cot (cot_base old_base)
(if (and cot_base (findfile block_in))
(progn
  (if(not old_base)
	 (setq old_base 0.000 old_base_ "0.000")
	 (progn
	  (if(			 (progn
		   (if(>= (abs old_base) 1000)
			  (setq old_base_(strcat "-" (rtos (/ old_base -1000.000) 2 3)))
			  (progn 
				(if(/= (substr (rtos (/ old_base 1000.000) 2 3) 1 3) "-0.")
				   (setq old_base_(strcat "-0" (rtos (/ old_base -1000.000) 2 3)))
				   (setq old_base_(strcat "-" (rtos (/ old_base -1000.000) 2 3)))
				)
			  )
		   )
		 )
		 (progn 
		   (if(>= old_base 1000)
			  (setq old_base_(strcat "+" (rtos (/ old_base 1000.000) 2 3)))
			  (progn 
				(if(/= (substr (rtos (/ old_base 1000.000) 2 3) 1 2) "0.")
				   (setq old_base_(strcat "+0" (rtos (/ old_base 1000.000) 2 3)))
				   (setq old_base_(strcat "+" (rtos (/ old_base 1000.000) 2 3)))
				)
			  )
		   )
		 )
	  )
	  (if(= old_base 0)(setq old_base 0.000 old_base_ "0.000"))
	 );progn
  );if 
  (prompt "\nCot cao do tinh bang \"Milimet\" !")
  (initget 8)
  (setq data_base(getint(strcat "\n->> Cot cao do  :")))
  (if(not data_base)
	 (setq data_base old_base)
	 (setq old_base data_base)
  );if
  (if data_base
	  (progn
		(if(> data_base 0)
		   (if(>= data_base 1000)
			  (setq cot_in(strcat "+" (rtos (/ data_base 1000.000) 2 3)))
			  (progn 
				(if(/= (substr (rtos (/ data_base 1000.000) 2 3) 1 2) "0.")
				   (setq cot_in(strcat "+0" (rtos (/ data_base 1000.000) 2 3)))
				   (setq cot_in(strcat "+" (rtos (/ data_base 1000.000) 2 3)))
				)
			  )
		   )
		   (if(;				  (setq cot_in(strcat "-0" (rtos (/ data_base -1000.000) 2 3)))
			  (progn 
				(if(/= (substr (rtos (/ data_base 1000.000) 2 3) 1 3) "-0.")
				   (setq cot_in(strcat "-0" (rtos (/ data_base -1000.000) 2 3)))
				   (setq cot_in(strcat "-" (rtos (/ data_base -1000.000) 2 3)))
				)
			  )
			  (setq cot_in(strcat "-" (rtos (/ data_base -1000.000) 2 3)))
		   )
		)  
		(if(= data_base 0)(setq cot_in "%%p0.000"))
		(if (and cot_in cot_base dim_scl (findfile block_in))
			(progn
			  (setvar "Osmode" 0); Non Osmode
			  (command "_.Insert" block_in cot_base dim_scl "" "0")
			  (setq text_point(list (+ (car cot_base) (* 0.2 dim_scl))
									(+ (cadr cot_base)(* 0.6 dim_scl)) )
					text_h (* 0.4 dim_scl)
					text_clr 4)
			  (setq old_text_st(getvar "TextStyle"))
			  (MT_style "SYMBOL_TEXT" "Arial.ttf" "0.7")
			  (command "_.Text" text_point text_h "0.0" cot_in
					   "_.Chprop" "L" "" "C" text_clr "")
			  (setvar "TextStyle" old_text_st)
			  (setq old_text_st NIL text_point NIL text_h NIL text_clr NIL)
			)
		)
	  );progn
  );if old_base
);progn cot_base
);if cot_base
(setvar "Osmode" old_osmode)
(setq *error* old_err)
(princ)
)  
;;; Find and Make TextStyle: Symbol_Text
(defun MT_style(textst_name f_name wide_fit / tbl t1 t2 key)
  (setq tbl(tblnext "STYLE" 1) key NIL)
  (while tbl
  (setq t1 textst_name t2 (cdr(car(cdr tbl))) )
  (if (equal t1 t2) (setq key 1))  
  (setq tbl(tblnext "STYLE"))
  )  
  (if(/= key 1)
  (progn (setq tbl NIL ) 
	 (command "_.STYLE" textst_name f_name "" wide_fit "" "" "") 
	 (princ (strcat "\nText Style: " textst_name " was created !"))
  )
  (setvar "TextStyle" textst_name)
  )
  (setq textst_name NIL f_name NIL wide_fit NIL key NIL)
  (princ)
)
;;; Copy cot cao do:
(defun Ccot (/ op_cot op_pro_c moc_cot np_cot op_p op_text text_pro
			stt_c npc str_text cot_ins cot_new div_in num_text)
(setvar "Cmdecho" 0)
(setq old_osmode(getvar "Osmode")
  old_ortho(getvar "Orthomode"))
(setvar "Orthomode" 1)
(setq old_error *error* *error* gc_err lim_out NIL)
(setq op_cot(ssget) stt_c NIL npc NIL op_text NIL)
(if (and op_cot (> (sslength op_cot) 1))
(progn
  (setvar "Osmode" (+ 1 8 512)); End Node Near
  (initget 8)
  (setq moc_cot(getpoint "\n-> Diem moc copy: ") npc 1)
  (if moc_cot
	  (progn
	   (while npc
		 (setvar "Osmode" (+ 128 512));Per Ner
		 (initget 8) 
		 (if(setq np_cot(getpoint "\n->> Diem dat cot tiep theo: " moc_cot))
			(progn
			 (pack_out_lm moc_cot np_cot)
;				 (setq lim_out 1)
			 (setq op_p NIL str_text NIL text_pro NIL op_text NIL 
				   op_pro_c NIL stt_c 0 cot_new NIL div_in NIL cot_ins NIL)
			 (while (> (sslength op_cot) stt_c)
			   (setq op_pro_c(ssname op_cot stt_c))
			   (setvar "Osmode" 0) 
			   (command "_.Copy" op_pro_c "" moc_cot np_cot)
			   (setq op_cot_c(entlast))
			   (setq op_p op_cot_c
					 op_text(cdr(assoc 0 (setq text_pro(entget op_p)))) )
			   (if (and(= op_text "TEXT")
					   (= "SYMBOL_TEXT" (cdr(assoc 7 (entget op_p)))) )
				   (progn  
					(setq str_text(assoc 1 text_pro))
					(if (or (= (substr (cdr str_text) 1 1) "+") (= (substr (cdr str_text) 1 1) "-")(= (substr (cdr str_text) 1 3) "%%p"))
					   (progn 
						(if (or(= (substr (cdr str_text) 1 1) "+")
							   (= (substr (cdr str_text) 1 1) "-"))
							(setq num_t 2)(setq num_t 4))  
;							(setq div_in (- (abs(cadr np_cot)) (abs(cadr moc_cot)))
						(setq div_in (- (cadr np_cot) (cadr moc_cot))
								 num_text(atof (substr (cdr str_text) num_t))
								 num_t NIL
								 cot_new(+ num_text (/ div_in 1000.000))) 
						(if cot_new
						  (progn
						   (if(= div_in 0)(setq cot_ins "%%p0.000"))
						   (if(and(								  (if(>= (abs cot_new) 1)
								 (setq cot_ins(strcat "-" (rtos (* cot_new -1) 2 3)))
								 (progn 
								   (if(/= (substr (rtos cot_new 2 3) 1 3) "-0.")   
									  (setq cot_ins(strcat "-0"(rtos (* cot_new -1) 2 3)))
									  (setq cot_ins(strcat "-"(rtos (* cot_new -1) 2 3)))
								   )
								 )
							  )
							  (if(>= cot_new 1)
								 (setq cot_ins(strcat "+" (rtos cot_new 2 3)))
								 (progn 
								   (if(/= (substr (rtos cot_new 2 3) 1 2) "0.")   
									  (setq cot_ins(strcat "+0"(rtos cot_new 2 3)))
									  (setq cot_ins(strcat "+"(rtos cot_new 2 3)))
								   )
								 )
							  )
						   )
						   (if(= cot_new 0)(setq cot_ins "%%p0.000"))
						   (setq text_pro(subst (cons '1 cot_ins) str_text text_pro))
						   (entmod text_pro)
						  );progn
						);if cot_new
					   ) 
					);if str_text
				   )
			   );if op_text
			   (setq stt_c (+ 1 stt_c))
			 );while
			)
			(setq npc NIL) 
		 );if np_cot
	   );While npc
	 )
  );if moc_cot
  )
);if op_cot
(setq *error* old_err)
(setvar "Osmode" old_osmode)
(princ)
)
;;;Pack for Out-size Limits:
(defun pack_out_lm (c_base_p n_point_p)
(if(and c_base_p n_point_c)
  (progn
	  (if(			 (progn 
		  (if(				 (cond
			   ((					(setq lim_out 1.0) )
			   ((> (cadr c_base_p)(cadr n_point_p))
				(setq lim_out 1.0) )
			   ((= (cadr c_base_p)(cadr n_point_p))
				(setq lim_out -1.0) )
			 )
		  )
		  (if(>= (cadr n_point_p) 0)
			 (setq lim_out -1) )
		 )
	  );if c_base_p 		  (if(> (cadr c_base_p) 0)
		 (setq lim_out -1) )
  )
)
)
;End Pack
;;;
(defun C:Ccot () 
(setq old_error *error* *error* gc_err)
(ccot) (setq *error* old_err)
(princ))
;;; Load OK
;;;(princ "\nMCOT.lsp Loading... OK")

Cách thức hoạt động của đoạn code trên :

Bạn giải nén file tue.zip (Có chứa file ghicot.lsp và file cot.dwg) vào trong ổ đĩa C:\tue mà mình sẽ upload dưới đây

Sau đó vào CAD ->gõ option ->File -> Bạn chọn Support file Search path -> Add vào đường dẫn C:\tue ->OK.

Nếu bạn không làm những bước trên thì chương trình sẽ không chạy.

Bạn appload file ghicot.lsp lên và bắt đầu sử dụng :

Đơn vị ghi cot là đơn vị mm

Ở đây có thêm lệnh Ccot là lệnh copy cao độ từ cao độ có sẵn. Bạn ngâm cứu nhé. hay lắm

Mình sẽ làm ví dụ trong file của bạn

Command: mgco

Nhap: "T" neu xac dinh cot theo moc tuong doi.

-> Diem goc xac dinh cot /T/: _from Base point: (Pick vào điểm gốc xác định tọa độ tương đối) : @0,-368550 (đây là tọa độ điểm gốc 0,0 được xác định theo chế độ bắt điểm from từ điểm gốc xác định tọa độ tương đối)

->> Ghi cot vao diem goc ?/Y/: n