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

[bach1212 4]

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

[Doan Van Ha 3.182]

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.

[Tue_NV 3.912]

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:

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

[Doan Van Ha 3.182]

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

[bach1212 4]

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

[bach1212 4]

Đâ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?

[Doan Van Ha 3.182]

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

[bach1212 4]

: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

[Doan Van Ha 3.182]

: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'

[Tue_NV 3.912]

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

[bach1212 4]

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

 

[Doan Van Ha 3.182]

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!

[bach1212 4]

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è!

[xathuong 0]

Gửi các bác, e có tim lisp nôi suy cao độ trên diễn đàn

Đã tim được lisp "nscdpl" rất hay tuy nhiên các điểm chèn cao độ phải pick tay

Các bác có thể bổ sung thêm lựa chọn số lượng điểm chia hoặc khoảng cách các điểm chia để chèn cao độ theo đường Pline

Vì với số điểm cần chèn cao độ ít thì pick tay , chứ nếu các điểm chia nhiều và khoảng cách các điểm bằng nhau mà làm tay thì hơi mất công

Nhờ các bác xem giúp ạ