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  
chien_lv

Nhờ Mọi Người Viết Giùm Lisp Lấy Cao Độ Trên Trắc Dọc

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

chien_lv    7

Nhờ mọi người viết giúp em một cái lisp phục vụ cho việc lấy cao độ trên trắc dọc

Đầu bài là:

 Khi chạy lisp:

B1: Chọn đường gốc (có thể line hoặc pline đều nhận) đường số (1)

B2: Nhập mức so sánh (nhập từ bàn phím) cho đường gốc đó

B3: Chọn đường cần lấy cao độ (đường 2)

B4: chọn điểm đặt cao độ (vị trí 4, tuỳ chọn)

B5: chọn vị trí đường dóng text (3), mục đích của việc này là để text sau khi chạy ra sẽ thẳng hàng với những đường đó 

em gửi bản vẽ:  http://www.mediafire.com/file/a47u35j6d7dddaa/DB.dwg

 

Em cảm ơn mọi người

 

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
chien_lv    7

Hóng mấy anh chị hay viết lisp free chắc đợt này bận. Mọi người ai có thể viết được thì xin giúp giùm với ạ. Cảm ơn mọi người đã quan tâm

  • Vote giảm 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

Nhờ mọi người viết giúp em một cái lisp phục vụ cho việc lấy cao độ trên trắc dọc

Đầu bài là:

 Khi chạy lisp:

B1: Chọn đường gốc (có thể line hoặc pline đều nhận) đường số (1)

B2: Nhập mức so sánh (nhập từ bàn phím) cho đường gốc đó

B3: Chọn đường cần lấy cao độ (đường 2)

B4: chọn điểm đặt cao độ (vị trí 4, tuỳ chọn)

B5: chọn vị trí đường dóng text (3), mục đích của việc này là để text sau khi chạy ra sẽ thẳng hàng với những đường đó 

em gửi bản vẽ:  http://www.mediafire.com/file/a47u35j6d7dddaa/DB.dwg

 

Em cảm ơn mọi người

Hehe

Muốn điền cao độ trắc dọc à???

Thấy thừa bước chọn số 1 nhưng thiếu tỷ lệ đứng.

Chưa mở file nên chưa tìm hiểu kỹ được.

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
chien_lv    7

Đúng rồi anh ah, bước 1 không thừa vì dùng để xác định vị trí gốc (đường thằng gốc nằm ngang). Tỷ lệ thì chắc là em thiếu bước đó

 

Cảm ơn mọi người đã quan tâ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

Đúng rồi anh ah, bước 1 không thừa vì dùng để xác định vị trí gốc (đường thằng gốc nằm ngang). Tỷ lệ thì chắc là em thiếu bước đó

 

Cảm ơn mọi người đã quan tâm

chỉ cần 1 điểm thôi không cần đường đâ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
hiepttr    523

Lâu ngày vào lại forum, mần tới cho bạn :D

;;;lisp dien cao do TD
(defun c:ddd( / lst_va old base_pt base_text  base_h dg p p1 p2 dong lst_dong ob_dong lst_giao pt_int cont_text)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(1 0))
(setq base_pt (getpoint "\n Chon diem chuan: "))
(mapcar 'setvar lst_va '(0 0))
(prompt "\n Chon text cao do tuong ung diem chuan <enter de nhap>: ")
(setq base_text (ssget "+.:E:S" '((0 . "*TEXT"))))
(cond 
	((and base_text 
		(setq base_h (distof (cdr (assoc 1 (entget (ssname base_text 0))))))
		))
	(t (setq base_h (getreal "\n Nhap cao do diem chuan: ")))
)
(setq dg (car (entsel "\nPick duong can lay cao do: ")))
(setq dg (vlax-ename->vla-object dg))
;;;;==========
(mapcar 'setvar lst_va '(3 0))
(setq p (getpoint "\nChon diem dat cao do: ")
		p1 (list (- (car p) 1000) (cadr p) 0)
		p2 (list (+ (car p) 1000) (cadr p) 0)
		)
	(grvecs (list 1 p1 p2))
(prompt "\n Chon (cac) duong dong: ")
(setq dong (ssget '((0 . "LINE"))))
(setq lst_dong (vl-remove-if 'listp (mapcar 'cadr (ssnamex dong))))
(setq #tl (NGT #tl 1000 getreal "Nhap ti le dung"))
(if (and 
		base_pt
		base_h
		dg
		p
		lst_dong
		#tl
		)
	(foreach elem lst_dong
		(setq ob_dong (vlax-ename->vla-object elem))
		(cond ((setq lst_giao (H:inter-group3 ob_dong dg))
			(setq pt_int (car lst_giao)
					cont_text (rtos (+ base_h (/ (* #tl (- (cadr pt_int) (cadr base_pt))) 1000)) 2 2)
				)
			  (MakeText (list (car pt_int) (cadr p)) cont_text 0.25 (/ pi 2) "MC" nil nil 3 nil)
			)
		)
	)
	(princ "\n *** Dau vao chua dung ***")
)
(mapcar 'setvar lst_va old)
(princ)
)
;===================================|;
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(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")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 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)))))
					  )	
					  (entmakex Lst)
);end
;=================================
(defun H:inter-group3(ob1 ob2 / modul res)
(cond 
	((null (setq modul (vlax-invoke ob1 'intersectwith ob2 acExtendThisEntity))) nil)
	((= (length modul) 3) (list modul))
	(t 
		(while (> (length modul) 0)
			(setq	res (cons (list (car modul) (cadr modul) (caddr modul)) res)
					modul (cdddr modul)
			)
		)
		(reverse res)
	)
)
)
;;;;===================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
  • 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
chien_lv    7

anh cho hỏi em dùng nó toàn báo:  *** Dau vao chua dung ***, chỗ tỷ lệ nó yêu cầu nhập thì em nhập 1/100 hoặc 100 hoặc 0.01 vẫn báo   *** Dau vao chua dung ***.

 

Thanks

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  

×