Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
8 replies to this topic

#1 chien_lv

chien_lv

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 28 September 2016 - 02:37 PM

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...6d7dddaa/DB.dwg

 

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

 

  • 0

#2 chien_lv

chien_lv

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 02 October 2016 - 07:49 PM

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


  • -1

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 02 October 2016 - 08:33 PM

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...6d7dddaa/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.
  • 0

#4 chien_lv

chien_lv

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 03 October 2016 - 08:31 AM

Đú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


  • 0

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 03 October 2016 - 10:17 AM

Đú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


  • 0

#6 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 05 October 2016 - 07:32 PM

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

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#7 chien_lv

chien_lv

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 05 October 2016 - 08:26 PM

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


  • 0

#8 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 06 October 2016 - 11:09 AM

Srr, do mình bất cẩn.
Đã fix.

p/s: Bước nhập tỉ lệ chỉ nhập phần mẫu số.


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#9 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 06 October 2016 - 03:10 PM

Test chơi: https://drive.google...iew?usp=sharing

Lệnh: CDTD

P/s: Giảm thiểu thao tác nhập dữ liệu


  • 1