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

[Yêu cầu Lisp] Nội suy cao độ thiết kế tim đường

Bởi luongtienlanh , trong AutoLisp

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

luongtienlanh    2

luongtienlanh
Đã đăng

Vì đo và tính tay rất mất thời gian nên mong các cao thủ viết giúp em lisp này với ạ.

Em tạm nói sơ qua bài toán thế này ạ. biết 2 điểm A, B và cao độ dạng text, nội suy cao độ điểm C nằm trên đường thẳng AB và ghi kết quả ra text.

thứ tự thực hiện tính toán sơ qua thế này ạ:

Lệnh: tcd

pick điểm đầu=> pick điểm cuối=>chọn text cao độ điểm đầu=> chọn text cao độ điểm cuối=> pick điểm cần nội suy cao độ=> xuất giá trị nội suy được ra text

Giúp em tổng quát trong trường hợp điểm cần tính cao độ nằm ngoài đoạn thẳng giữa 2 điểm thì càng tốt ạ.

Xin cám ơn. Chúc các bác vui vẻ! :)

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

thanhduan2407    272

thanhduan2407
Đã đăng

Bạn thử dùng xem

(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3	loop
	     )
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made by thanhduan2407")

  (or *chieucao* (setq *chieucao* 1))
  (setq
    chieucao (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
			      (rtos *chieucao* 2 2)
			      "> :"
		      )
	     )
  )
  (if (not chieucao)
    (setq chieucao *chieucao*)
    (setq *chieucao* chieucao)
  )
  (setq Olmode (getvar "OSMODE"))
  (if (not sle)
    (setq sle 2)
  )
  (setq	sle0
	 (getint
	   (strcat
	     "\nS\U+1ED1 l\U+1EBB sau ph\U+1EA7n th\U+1EADp ph\U+00E2n (T\U+1ED1i \U+0111a = 10, t\U+1ED1i thi\U+1EC3u = 0) <"
	     (itoa sle)
	     ">: "
	   )
	 )
  )
  (if sle0
    (progn
      (if (< sle0 0)
	(setq sle0 0)
      )
      (if (> sle0 10)
	(setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and (setq item1 (entsel "\nCh\U+1ECDn Text th\U+1EE9 nh\U+1EA5t:  "))
	   (setq item2 (entsel "\nCh\U+1ECDn Text th\U+1EE9 hai:  "))
      )
    (progn
      (progn

	(setq temp1 (entget (car item1)))
	(setq Tdo1 (TD:Text-Base (car item1)))
	(setq Caodo1 (cdr (assoc 1 temp1))
	      x1     (car Tdo1)
	      y1     (cadr Tdo1)
	)
	(setq pt1 (list x1 y1))
	(setq z1 (atof Caodo1))

	(setq temp2 (entget (car item2)))
	(setq Tdo2 (TD:Text-Base (car item2)))
	(setq Caodo2 (cdr (assoc 1 temp2))
	      x2     (car Tdo2)
	      y2     (cadr Tdo2)
	)
	(setq pt2 (list x2 y2))
	(setq z2 (atof Caodo2))
      )
      (setq loop T)
      (while loop
	(setq
	  pt3 (getpoint
		"\nV\U+1ECB tr\U+00ED ch\U+00E8n \U+0111i\U+1EC3m : "
	      )
	)
	(cond
	  (T
	   (if pt3
	     (progn
	       (setvar "OSMODE" 512)
	       (setq x3 (car pt3))
	       (setq y3 (cadr pt3))
	       (setq d1 (distance pt1 pt3))
	       (setq d2 (distance pt2 pt3))
	       (setq d (+ d1 d2))
	       (setq dh (- z2 z1))
	       (setq dhz (* dh (/ d1 d)))
	       (setq z3 (+ z1 dhz))
	       (setq Caodo3 (rtos z3 2 sle))
	       (setq pt3 (list x3 y3 z3))
	       (entmake	(list (cons 0 "TEXT")
			      (cons 10 pt3)
			      (cons 1 Caodo3)
			      (cons 40 chieucao)
			)
	       )
	     )
	     (setq loop nil)
	   )
	  )
	)

      )

    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

(defun TD:Text-Base (ent / MA71 MA72 X11)
  (setq Ma10 (cdr (assoc 10 (entget ent))))
  (setq Ma11 (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71 (cdr (assoc 71 (entget ent))))
  (setq Ma72 (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3))
	  (and (= Ma71 0) (= Ma72 5))
      )
    Ma10
    Ma11
  )
)

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

luongtienlanh    2

luongtienlanh
Đã đăng

Cám ơn bác thanhduan2407 đã quan tâm.Em đã test và hình như kết quả xuất ra tính theo khoảng cách giữa điểm đặt 2 text phải không ạ. Em muốn kết quả tính ra là theo khoảng cách giữa 2 điểm mình kích nên bác có thể chỉnh lại giúp em như thế này không ạ:kích điểm 1=> chọn text cao độ điểm 1 => kích điểm 2=> chọn text cao độ điểm 2=>kích điểm chèn=> cao độ nội suy. Cao độ nội suy tính căn cứ vào khoảng cách của các đoạn thẳng. Công thức tính cao độ nội suy theo điểm có cao độ cao hơn (giả sử là điểm 1): CD=CD1- {(CD1-CD2)*L1/L}. Trong đó:

CD: là cao độ điểm chèn cần tính; CD1 là cao độ điểm 1(điểm cao hơn); CD2 là cao độ điểm 2; L là khoảng cách giữa 1 và 2; L1 là khoảng cách giữa điểm chèn và 1. Cám ơn bác 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

trinhhoanghieu090    29

trinhhoanghieu090
Đã đăng 
(defun c:CLT (/         CAODO1 CAODO2 CAODO3 CHIEUCAO    D      D1
          D2     DH        DHZ       ITEM1  ITEM2     PT1    PT2    PT3
          STT    TDO1   TDO2   TEMP1  TEMP2     X1    X2     X3
          Y1     Y2        Y3       Z1      Z2     Z3    loop
         )
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made by thanhduan2407, Edit By trinhhoanghieu090")

;  (or *chieucao* (setq *chieucao* 1))
;  (setq
;   chieucao (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
;                  (rtos *chieucao* 2 2)
;                  "> :"
;              )
;         )
;  )
;  (if (not chieucao)
;    (setq chieucao *chieucao*)
 ;   (setq *chieucao* chieucao)
;  )
  (setq Olmode (getvar "OSMODE"))
  (if (not sle)
    (setq sle 2)
  )
  (setq    sle0
     (getint
       (strcat
         "\nChon So Le Thap Phan <"
         (itoa sle)
         ">: "
       )
     )
  )
  (if sle0
    (progn
      (if (< sle0 0)
    (setq sle0 0)
      )
      (if (> sle0 10)
    (setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and
        (setq tdo1 (getpoint "\nChon Diem Thap:"))
        (setq item1 (entsel "\nChon Text Diem Thap:"))
        (setq tdo2 (getpoint "\nChon Diem Cao:"))
        (setq item2 (entsel "\nChon Text Diem Cao:"))
      )
    (progn
      (progn

    (setq temp1 (entget (car item1)))
;    (setq Tdo1 (TD:Text-Base (car item1)))

    (setq Caodo1 (cdr (assoc 1 temp1))
          x1     (car Tdo1)
          y1     (cadr Tdo1)
    )
    (setq pt1 (list x1 y1))
    (setq z1 (atof Caodo1))

    (setq temp2 (entget (car item2)))
;    (setq Tdo2 (TD:Text-Base (car item2)))
    (setq Caodo2 (cdr (assoc 1 temp2))
          x2     (car Tdo2)
          y2     (cadr Tdo2)
    )
    (setq pt2 (list x2 y2))
    (setq z2 (atof Caodo2))
      )
      (setq loop T)
      (while loop
    (setq
      pt3 (getpoint
        "\nChon Vi Tri Can Noi Suy Cao Do:"
          )
    )
    (cond
      (T
       (if pt3
         (progn
;           (setvar "OSMODE" 512)
           (setq x3 (car pt3))
           (setq y3 (cadr pt3))
;           (setq d1 (distance pt1 pt3))
;           (setq d2 (distance pt2 pt3))
;           (setq d (+ d1 d2))
;           (setq dh (- z2 z1))
;           (setq dhz (* dh (/ d1 d)))
;           (setq z3 (+ z1 dhz))
           (setq d1 (distance pt1 pt2))
           (setq d2 (distance pt1 pt3))
           (setq dh (- z2 z1))
           (setq dhz (* dh (/ d2 d1)))
           (setq z3 (+ z1 dhz))


           (setq Caodo3 (rtos z3 2 sle))
;          (setq pt3 (getpoint pt3 "\nChon Diem Dat Cao Do:"))
           (setq pt3 (list (car pt3) (cadr pt3) z3))

           (entmake
                  (list    
                  (cons 0 "TEXT")
                  (cons 10 pt3)
                  (cons 1 Caodo3)
                  (assoc 8 temp1)
                  (assoc 7 temp1)
                  (assoc 40 temp1)
                  (assoc 50 temp1)
                    )
                    
           )
         )
         (setq loop nil)
       )
      )
    )

      )

    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Tặng bạn, mình đã làm cả cho trường hợp tổng quát nằm phía bên ngoài 2 đầu đoạn thẳng rồi đó (nhưng 3 điểm vẫn phải thẳng hàng thì nội suy mới đúng)

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

trinhhoanghieu090    29

trinhhoanghieu090
Đã đăng

Cái này chuẩn hơn nè

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/118722-yeu-cau-lisp-noi-suy-cao-do-thiet-ke-tim-duong/#entry332837
(defun c:CLT (/	     CAODO1 CAODO2 CAODO3 CHIEUCAO	D      D1
	      D2     DH	    DHZ	   ITEM1  ITEM2	 PT1	PT2    PT3
	      STT    TDO1   TDO2   TEMP1  TEMP2	 X1	X2     X3
	      Y1     Y2	    Y3	   Z1	  Z2	 Z3
;		  goc1 goc2 hieugoc
	     ) 
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (prompt "Made_By_Thanhduan2407, Edit_By_Trinhhoanghieu090")

  (if (not sle)
    (setq sle 2)
  )
  (setq	sle0
	 (getint
	   (strcat
	     "\nChon So Le Thap Phan <"
	     (itoa sle)
	     ">: "
	   )
	 )
  )
  (if sle0
    (progn
      (if (< sle0 0)
	(setq sle0 0)
      )
      (if (> sle0 10)
	(setq sle0 10)
      )
      (setq sle sle0)
    )
  )
  (if (and 
		(setq tdo1 (getpoint "\nChon Diem Thap:"))
		(setq item1 (entsel "\nChon Text Diem Thap:"))
		(setq tdo2 (getpoint "\nChon Diem Cao:"))
	    (setq item2 (entsel "\nChon Text Diem Cao:"))
      )
    (progn
      (progn

	(setq temp1 (entget (car item1)))


	(setq Caodo1 (cdr (assoc 1 temp1))
	      x1     (car Tdo1)
	      y1     (cadr Tdo1)
	)
	(setq pt1 (list x1 y1))
	(setq z1 (atof Caodo1))

	(setq temp2 (entget (car item2)))

	(setq Caodo2 (cdr (assoc 1 temp2))
	      x2     (car Tdo2)
	      y2     (cadr Tdo2)
	)
	(setq pt2 (list x2 y2))
	(setq z2 (atof Caodo2))
      )

	(while
		(setq  pt3 (getpoint "\nChon Vi Tri Can Noi Suy Cao Do:"))
		
		(setq	goc1	(* 180.0 (angle pt1 pt2) (/ 1.0 pi))
				goc2	(* 180.0 (angle pt1 pt3) (/ 1.0 pi))
				hieugoc (rem  (+ goc1 (- goc2) 360.0) 360.0)
		)
	   (if
			(or (equal hieugoc 0.0 0.0001) 
				(equal hieugoc 180.0 0.0001)
				(equal hieugoc 360.0 0.0001)
			)

	     (progn
	       (setq x3 (car pt3))
	       (setq y3 (cadr pt3))
	       (setq d1 (distance pt1 pt2))
	       (setq d2 (distance pt1 pt3))
	       (setq dh (- z2 z1)) 
	       (setq dhz (* dh (/ d2 d1)))
		   (if	(equal hieugoc 180.0 0.0001)
				(setq dhz (- dhz))
			)
	       (setq z3 (+ z1 dhz))


	       (setq Caodo3 (rtos z3 2 sle))
;		   (setq pt3 (getpoint pt3 "\nChon Diem Dat Cao Do:"))
	       (setq pt3 (list (car pt3) (cadr pt3) z3))

	       (entmake
				  (list	
                  (cons 0 "TEXT")
			      (cons 10 pt3)
			      (cons 1 Caodo3)
				  (assoc 8 temp1)
				  (assoc 7 temp1)
			      (assoc 40 temp1)
				  (assoc 50 temp1)
					)
					
	       )
	     ); end progn
		 (alert "\Ban Da Pick Diem Khong Thang Hang")
	   ); end if
    ) ; end while

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

bEan    1

bEan
Đã đăng

Bác có thể chính 1 chút là lúc lấy cao độ điểm thấp hoặc điểm cao thì chọn đc cả đối tượng text trong block thuộc tính ko

Em cám ơn bá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

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
Về Đầu Trang AutoLisp
×