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.
amateurday

nội suy cao độ đường cong

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

bach1212    2

"Em thấy lisp này chưa có lựa chọn đó"

Lisp viết ra là theo y/c của chủ topic, chưa chắc đã phù hợp với y/c của người khác. Vì vậy, nếu bạn cần thì cứ y/c thêm.

Y/c của bạn có thể làm được!

Hjj e yêu cầu ở trên rùi ah. Chờ tin bác. :D

Nhưng đây là topic cũ, không biết có được viết tiếp ở đây lun khô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
Doan Van Ha    2.676

Hjj e yêu cầu ở trên rùi ah. Chờ tin bác. :D

Nhưng đây là topic cũ, không biết có được viết tiếp ở đây lun không.

đợi sáng mai ở đây chứ đừng mở topic mới sẽ nhạt forum.

  • 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
Tue_NV    3.841

Nhiều khi e cần chọn 2 điểm đầu và cuối bất kỳ VD: A,B.... nằm trên curve (chứ không phải lúc nào cũng là 2 điểm mút của đường curve) đã có cao độ, rồi nội suy ra cao độ tại 1 điểm nằm giữa 2 điểm được chọn đó (vẫn nằm trên curve). Em thấy lisp này chưa có lựa chọn đó. Mong các bác giúp e bổ sung thêm lựa chọn cho lisp:

111.jpg

1. Chọn điểm mốc thứ nhất

2.Chọn cao độ của mốc thứ nhất (Có thể pick vào text có sẵn hoặc nhập tay vào)

3. Chọn điểm mốc thứ hai

4.Chọn cao độ của mốc thứ hai (Có thể pick vào text có sẵn hoặc nhập tay vào)

(Lisp tự động tính độ dốc giữa 2 điểm A-B: lấy cao độ 2 đầu trừ nhau chia cho chiều dài đoạn AB, AB không phân biệt cong thẳng, chỉ cần lấy chiều dài)

5.Chọn vị trí cần nội suy (xin đừng làm mất chế độ bắt điểm :D)

6.Kết quả nội suy thể hiện trên command

7.Chọn vị trí tiếp theo hoặc thoát lệnh

.......

 

Lisp này Tue_NV viết đã khá lâu, dành cho Line, nay nâng cấp lên cho 1 Curve


(defun c:nsuy(/ curve p1 Z1 p2 Z2 cao dis Hz tana a)
 (setq curve (car(entsel "\n Chon Curve :")))
 (setq p1 (getpoint "\n Nhap diem P1 :"))
 (setq Z1 (getreal "\n Nhap cao do Z1 :"))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
 (setq Z2 (getreal "\n Nhap cao do Z2 :"))
 (setq cao (getdist "\n Nhap chieu cao chu :"))
 (setq dis (abs (- (vlax-curve-getdistatpoint curve p1) (vlax-curve-getdistatpoint curve p2))))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))

(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
(if (< Z1 Z2)
  (if (< (vlax-curve-getparamatpoint curve p1)  (vlax-curve-getparamatpoint curve p2))
   (progn (setq a (- (vlax-curve-getdistatpoint curve p) (vlax-curve-getdistatpoint curve p1))
   Z (+ Z1 (* tana a))) (in (rtos Z 2 3) p cao 0.0) )
   (progn (setq a (- (vlax-curve-getdistatpoint curve p1) (vlax-curve-getdistatpoint curve p))
   Z (+ Z1 (* tana a))) (in (rtos Z 2 3) p cao 0.0) )
  )
)
(if (> Z1 Z2)
  (if (< (vlax-curve-getparamatpoint curve p1)  (vlax-curve-getparamatpoint curve p2))
 (progn (setq a (- (vlax-curve-getdistatpoint curve p2) (vlax-curve-getdistatpoint curve p))
   Z (+ Z2 (* tana a))) (in (rtos Z 2 3) p cao 0.0) )
 (progn (setq a (- (vlax-curve-getdistatpoint curve p) (vlax-curve-getdistatpoint curve p2))
   Z (+ Z2 (* tana a))) (in (rtos Z 2 3) p cao 0.0) )
  )
)
 );while
(princ)
)
(defun in(txt p cao ang)
(entmake (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 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    2.676

Hjj e yêu cầu ở trên rùi ah. Chờ tin bác. :D

Nhưng đây là topic cũ, không biết có được viết tiếp ở đây lun không.

Đây bạn!

;CadViet.com - Doan Van Ha (07/04/2012)
;Noi suy cao do tung diem tren Curve theo 2 Text cao do tai 2 diem bat ky tren Curve.
(defun C:HA (/ obj pa pb enta entb ha ha len p lenp hp)
(vl-load-com)
(command "undo" "be")
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Curve can noi suy cao do: ")))
      	pa (getpoint "\nChon diem moc thu 1: ")
      	enta (car (entsel "\nChon Text cao do thu 1: "))
      	pb (getpoint "\nChon diem moc thu 2: ")
      	entb (car (entsel "\nChon Text cao do thu 2: "))
      	ha (atof (cdr (assoc 1 (entget enta))))
      	hb (atof (cdr (assoc 1 (entget entb))))
      	len (- (vlax-curve-getDistAtPoint obj pb) (vlax-curve-getDistAtPoint obj pa)))
(or *sole* (setq *sole* 2))
(setq sole (getint (strcat "\nSo chu so thap phan <" (itoa *sole*) ">: ")))
(if (not sole) (setq sole *sole*) (setq *sole* sole))
(princ "\nLan luot chon cac diem tren Curve can noi suy cao do...")
(while (setq p (getpoint "\nChon diem: "))
 (setq lenp (- (vlax-curve-getDistAtPoint obj p) (vlax-curve-getDistAtPoint obj pa))
       	hp (+ ha (/ (* (- hb ha) lenp) len)))
 (command "text" "non" p 2 0 (rtos hp 2 sole)))
(command "undo" "end")
(princ))

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
bach1212    2

E chờ cả buổi sáng. hjj

Bác Tue_NV ơi, còn thiếu yêu cầu này ự:

2.Chọn cao độ của mốc thứ nhất (Có thể pick vào text có sẵn hoặc nhập tay vào)

4.Chọn cao độ của mốc thứ hai (Có thể pick vào text có sẵn hoặc nhập tay vào)

và có thể hiện thêm kết quả ở command được không ah?

Vì công việc e làm nếu điền text kết quả vào bản vẽ là phải thêm 1 thao tác xóa. Hiện tại text điền kết quả đang có 4 con số sau dấu phẩy đó ah.

Hjj Mong bác chỉnh sửa thêm giúp e......

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
bach1212    2

Đây bạn!

;CadViet.com - Doan Van Ha (07/04/2012)
;Noi suy cao do tung diem tren Curve theo 2 Text cao do tai 2 diem bat ky tren Curve.
(defun C:HA (/ obj pa pb enta entb ha ha len p lenp hp)
(vl-load-com)
(command "undo" "be")
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Curve can noi suy cao do: ")))
  		pa (getpoint "\nChon diem moc thu 1: ")
  		enta (car (entsel "\nChon Text cao do thu 1: "))
  		pb (getpoint "\nChon diem moc thu 2: ")
  		entb (car (entsel "\nChon Text cao do thu 2: "))
  		ha (atof (cdr (assoc 1 (entget enta))))
  		hb (atof (cdr (assoc 1 (entget entb))))
  		len (- (vlax-curve-getDistAtPoint obj pb) (vlax-curve-getDistAtPoint obj pa)))
(or *sole* (setq *sole* 2))
(setq sole (getint (strcat "\nSo chu so thap phan <" (itoa *sole*) ">: ")))
(if (not sole) (setq sole *sole*) (setq *sole* sole))
(princ "\nLan luot chon cac diem tren Curve can noi suy cao do...")
(while (setq p (getpoint "\nChon diem: "))
 (setq lenp (- (vlax-curve-getDistAtPoint obj p) (vlax-curve-getDistAtPoint obj pa))
       	hp (+ ha (/ (* (- hb ha) lenp) len)))
 (command "text" "non" p 2 0 (rtos hp 2 sole)))
(command "undo" "end")
(princ))

Post bài reply của bác Tue_NV sau bác chậm mấy giây. Của bác chuẩn rùi ah. Hôm nay không ấn LIKE được roài......

Nhưng E vẫn mong được thế này ah: thể hiện thêm kết quả ở command được không ah?

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    2.676

Post bài reply của bác Tue_NV sau bác chậm mấy giây. Của bác chuẩn rùi ah. Hôm nay không ấn LIKE được roài......

Nhưng E vẫn mong được thế này ah: thể hiện thêm kết quả ở command được không ah?

Cho "nợ" mai Like This

;CadViet.com - Doan Van Ha (07/04/2012)
;Noi suy cao do tung diem tren Curve theo 2 Text cao do tai 2 diem bat ky tren Curve.
(defun C:HA (/ obj pa pb enta entb ha ha len p lenp hp kieu1 kieu2)
(vl-load-com)
(command "undo" "be")
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Curve can noi suy cao do: "))))
(or *sole* (setq *sole* 2))
(setq sole (getint (strcat "\nSo chu so thap phan <" (itoa *sole*) ">: ")))
(if (not sole) (setq sole *sole*) (setq *sole* sole))
(initget "N L") (setq kieu1 (getkword "\nChon cach lay cao do [Nhap vao/Lay tu text] <N>: "))
(initget "T C") (setq kieu2 (getkword "\nChon cach xuat cao do [xuat ra Text/xuat ra Command] <C>: "))
(setq pa (getpoint "\nChon diem moc thu 1: "))
(if (or (= kieu1 "N") (= kieu1 nil))
 (setq ha (getreal "\nNhap Text cao do thu 1: "))
 (setq ha (atof (cdr (assoc 1 (entget (car (entsel "\nChon text de lay cao do thu 1: "))))))))
(setq pb (getpoint "\nChon diem moc thu 2: "))
(if (or (= kieu1 "N") (= kieu1 nil))
 (setq hb (getreal "\nNhap Text cao do thu 2: "))
 (setq hb (atof (cdr (assoc 1 (entget (car (entsel "\nChon text de lay cao do thu 2: "))))))))
(setq len (- (vlax-curve-getDistAtPoint obj pb) (vlax-curve-getDistAtPoint obj pa)))
(princ "\nLan luot chon cac diem tren Curve can noi suy cao do...")
(while (setq p (getpoint "\nChon diem: "))
 (setq lenp (- (vlax-curve-getDistAtPoint obj p) (vlax-curve-getDistAtPoint obj pa))
       	hp (+ ha (/ (* (- hb ha) lenp) len)))
 (if (= kieu2 "T")
  (command "text" "non" p 2 0 (rtos hp 2 sole))
  (princ (strcat (rtos hp 2 sole) "\n"))))
(command "undo" "end")
(princ))

P/S (10h25'-07/4/2012): bổ sung nhiều tuỳ chọ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
bach1212    2

:D Lisp này bị tụt hậu ở đoạn nhập cao độ rùi nè bác.... Không còn lựa chọn pick vào text trên bản vẽ nữa.

E thử xào nấu bằng cách copy đoạn code cho phép pick chọn text ở lisp trước thì thấy ở bước chọn text cao độ thứ 2: nếu không pick chọn text mà nhập bằng tay thì lisp báo lỗi:

Chon Curve can noi suy cao do:

Chon diem moc thu 1:

Chon Text cao do thu 1:

Nhap Text cao do thu 1: 0

Chon diem moc thu 2:

Chon Text cao do thu 2:

Nhap Text cao do thu 2: 20

; error: bad argument type: lentityp nil

Bác lồng ghép 2 trong 1 giúp e lại với ah

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    2.676

:D Lisp này bị tụt hậu ở đoạn nhập cao độ rùi nè bác.... Không còn lựa chọn pick vào text trên bản vẽ nữa.

E thử xào nấu bằng cách copy đoạn code cho phép pick chọn text ở lisp trước thì thấy ở bước chọn text cao độ thứ 2: nếu không pick chọn text mà nhập bằng tay thì lisp báo lỗi:

Chon Curve can noi suy cao do:

Chon diem moc thu 1:

Chon Text cao do thu 1:

Nhap Text cao do thu 1: 0

Chon diem moc thu 2:

Chon Text cao do thu 2:

Nhap Text cao do thu 2: 20

; error: bad argument type: lentityp nil

Bác lồng ghép 2 trong 1 giúp e lại với ah

2 trong 1 rồi, link cũ, sửa lúc 10h25'

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
Tue_NV    3.841

E chờ cả buổi sáng. hjj

Bác Tue_NV ơi, còn thiếu yêu cầu này ự:

2.Chọn cao độ của mốc thứ nhất (Có thể pick vào text có sẵn hoặc nhập tay vào)

4.Chọn cao độ của mốc thứ hai (Có thể pick vào text có sẵn hoặc nhập tay vào)

và có thể hiện thêm kết quả ở command được không ah?

Vì công việc e làm nếu điền text kết quả vào bản vẽ là phải thêm 1 thao tác xóa. Hiện tại text điền kết quả đang có 4 con số sau dấu phẩy đó ah.

Hjj Mong bác chỉnh sửa thêm giúp e......

Bạn dùng lệnh UN để chỉnh số lẻ thập phân rồi dùng Lisp này :


(defun c:nsuy(/ curve p1 Z1 p2 Z2 cao dis Hz tana a chontext)
(defun chontext()
(entget(car(entsel "\nChon Text :")))
)
 (setq curve (car(entsel "\n Chon Curve :")))
 (setq p1 (getpoint "\n Nhap diem P1 :"))
(initget "")
 (setq Z1 (getreal "\n Nhap cao do Z1 / Nhan Enter de chon Text :"))
 (if (null Z1)  (setq text (chontext) cao (cdr(assoc 40 text)) Z1 (atof (cdr(assoc 1 text)))  ) )

 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(initget "")
 (setq Z2 (getreal "\n Nhap cao do Z2 / Nhan Enter de chon Text :"))
 (if (null Z2)  (setq text (chontext) cao (cdr(assoc 40 text)) Z2 (atof (cdr(assoc 1 text)))  ) )

 (if (not cao) (setq cao (getdist "\n Nhap chieu cao chu :")))

 (setq dis (abs (- (vlax-curve-getdistatpoint curve p1) (vlax-curve-getdistatpoint curve p2))))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))

(While (setq p (getpoint p1 "\n Nhap diem P / Enter ket thuc lenh :"))
(if (< Z1 Z2)
  (if (< (vlax-curve-getparamatpoint curve p1)  (vlax-curve-getparamatpoint curve p2))
   (progn (setq a (- (vlax-curve-getdistatpoint curve p) (vlax-curve-getdistatpoint curve p1))
   Z (+ Z1 (* tana a))) )
   (progn (setq a (- (vlax-curve-getdistatpoint curve p1) (vlax-curve-getdistatpoint curve p))
   Z (+ Z1 (* tana a)))  )
  )
)
(if (> Z1 Z2)
  (if (< (vlax-curve-getparamatpoint curve p1)  (vlax-curve-getparamatpoint curve p2))
 (progn (setq a (- (vlax-curve-getdistatpoint curve p2) (vlax-curve-getdistatpoint curve p))
   Z (+ Z2 (* tana a)))  )
 (progn (setq a (- (vlax-curve-getdistatpoint curve p) (vlax-curve-getdistatpoint curve p2))
   Z (+ Z2 (* tana a)))  )
  )
)
(princ Z)
 );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
bach1212    2

2 trong 1 rồi, link cũ, sửa lúc 10h25'

Cho e hỏi, cái dòng này: enta (car (entsel "\nChon Text cao do thu 1: ")) thì chọn pick cũng oki mà nhập cũng oki

Còn cái dòng này: entb (car (entsel "\nChon Text cao do thu 2: ")) Cú pháp giống nhau sao chọn pick thì oki, chọn nhập thì báo lỗi (; error: bad argument type: lentityp nil) ???

Đây là trong code của lisp lần 1 của 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
Doan Van Ha    2.676

Cho e hỏi, cái dòng này: enta (car (entsel "\nChon Text cao do thu 1: ")) thì chọn pick cũng oki mà nhập cũng oki

Còn cái dòng này: entb (car (entsel "\nChon Text cao do thu 2: ")) Cú pháp giống nhau sao chọn pick thì oki, chọn nhập thì báo lỗi (; error: bad argument type: lentityp nil) ???

Đây là trong code của lisp lần 1 của bác

1). Lỗi là ở dòng sau khi đã enta và entb, nên khi mới enta xong nó chwa lỗi đâu.

2). Lấy lisp đã hiệu chỉnh 2 in 1 mà dùng cho thoải mái sở thích!

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
bach1212    2

1). Lỗi là ở dòng sau khi đã enta và entb, nên khi mới enta xong nó chwa lỗi đâu.

2). Lấy lisp đã hiệu chỉnh 2 in 1 mà dùng cho thoải mái sở thích!

ha (atof (cdr (assoc 1 (entget enta))))

hb (atof (cdr (assoc 1 (entget entb))))

Chắc là ở 2 thằng này. Vậy bổ sung sao để nhận cái thằng nhập vào ở : entb trong entb (car (entsel "\nChon Text cao do thu 2: ")), bác nhỉ?

E đang ngâm cứu tí. :D

@Tue_NV: Like bác phát nè!

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


×