Đến nội dung


Hình ảnh
- - - - -

nội suy cao độ tại giao điểm


  • Please log in to reply
22 replies to this topic

#21 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 16 September 2009 - 10:33 PM

em cũng đi tìm cái này lâu lắm rùi mà chưa thấy.cám ơn bác ssg nhiều nhưng có một vấn đề thế này.em muốn chọn đườg đồng mức sau đó cấy điểm liên tiếp đến lúc nào mình thoát lệnh thì thôi (tại vì lúc mình cấy text vào bình đồ thì cần rất nhiều nếu cấy 1 điểm lại phải chọn ddm thì hơi lâu)
vấn đề thứ 2 là khi mình select DDM thì mình có thể chọn nhiều DDM sau đó chương trình sẻ tìm ra 2 DDM gần với điểm point mình cần cấy nhất
một lần nữa xin cảm ơn bác SSG. có jì bác mail cho em theo địa chỉ (tridungtecco2@gmail.com em là dân công trình nên cũng ít khi được lên mạng lắm đi suốt mà)

Cụ thể bạn muốn lệnh như thế nào, tận dụng được cái gì so với lisp zz bác Ssg đã viết.

Bạn đừng dùng thuật ngữ 'cấy điểm' hay DDM gì cả, vì người viết lisp chỉ biết CAD+Lisp, không biết chuyên ngành của bạn. Cứ mô tả như bạn đang nói chuyện với trẻ nhỏ, càng đơn giản, càng ngắn gọn, càng mạch lạc thì cơ hội bạn nhận được câu trả lời đúng càng cao.
  • 1

#22 kegiaumat

kegiaumat

    biết vẽ circle

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

Đã gửi 01 November 2009 - 03:49 PM

ý của em là muốn mình chọn nhiều đường đồng mức một lúc sau đó pick các điểm cần nội suy chương trình sẽ chọn 2 đường pline đồng mức gần nhất (có thể theo cách của bác hoành là kẻ liên tiếp các đường pline quanh điểm p) và chương trình sẽ nội suy liên tiếp các điểm mình pick trên bản vẽ và đến khi mình thoát khỏi chương trình ko pick nữa thì thôi
  • 0

#23 thanhluuqt

thanhluuqt

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 February 2016 - 12:14 AM

Chương trình nội suy cao độ theo các đường đồng mức và/hoặc các điểm tham chiếu. Cung cách hoạt động đúng như ssg đã trình bày ở bài trước. Tên lệnh: ZZ

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;
;;;This program interpolate elevation at 1 point-object
;;;from 2 equal level polylines and/or reference point-objects
;;;Elevation of each reference point-object is specified by nearest text_object
;;;Written by ssg - December 2007 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;

;;;--------------------------------------------------------------------
(defun mod(x y) (fix (rem x y)) ) ;;;Remainder result of divide, return INT
;;;--------------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt at p
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
;;;--------------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;--------------------------------------------------------------------
(defun ss2Lp(ssp / Lp i e p) ;;;Convert ss of points to list of 3Dpoints
(setq i 0 Lp nil)
(repeat (sslength ssp)
(setq
e (ssname ssp i)
p (cdr (assoc 10 (entget e)))
Lp (append Lp (list p))
i (1+ i)
)
)
Lp
)
;;;--------------------------------------------------------------------
(defun aver(Ln / tot x) ;;;Average List of Number
(setq tot 0)
(foreach x Ln (setq tot (+ tot x)))
(/ tot (length Ln))
)
;;;--------------------------------------------------------------------
(defun distance_xy (p1 p2) ;;;Distance between 2 projections of p1 and p2
(setq
pp1 (list (car p1) (cadr p1) 0)
pp2 (list (car p2) (cadr p2) 0)
)
(distance pp1 pp2)
)
;;;--------------------------------------------------------------------
(defun inter2p(p p1 p2) ;;;Interpolate zp from p1, p2
(setq
d1 (distance_xy p p1)
d2 (distance_xy p p2)
z1 (caddr p1)
z2 (caddr p2)
)
(/ (+ (* d1 z2) (* d2 z1)) (+ d1 d2))
)
;;;--------------------------------------------------------------------
(defun ariang(p1 p2 p3) ;;;Arithmetic Angle between 2 vector p1p2 and p2p3
(setq
a1 (angle p2 p1)
a2 (angle p2 p3)
)
(abs (- (abs (- a1 a2)) pi))
)
;;;--------------------------------------------------------------------
(defun pair(p Lp / Lpair Lpass p1 p2 ass chk x y)
;;;Arrange list of points Lp in pairs, opposite by p. Return list of pair_list
(setq Lpair nil)
(while Lp
(setq
p1 (car Lp)
ass (lambda (x) (cons x (ariang p1 p x)))
chk (lambda (x y) (< (cdr x) (cdr y)))
Lpass (vl-sort (mapcar 'ass Lp) 'chk)
p2 (car (car Lpass))
Lpair (append Lpair (list (list p1 p2)))
Lp (vl-remove p1 Lp)
Lp (vl-remove p2 Lp)
)
)
Lpair
)
;;;--------------------------------------------------------------------
(defun getZ(p sst) ;;;Get nearest text in sst, assign to zp
(setq
Lt (ss2ent sst)
neap (lambda (x y)
(<
(distance_xy p (cdr (assoc 10 (entget x))))
(distance_xy p (cdr (assoc 10 (entget y))))
)
)
Lt (vl-sort Lt 'neap)
z (atof (cdr (assoc 1 (entget (car Lt)))))
p (subst z (caddr p) p)
)
)
;;;--------------------------------------------------------------------
(defun placp(pl p / pp) ;;;Check pl across p, different z
(vl-load-com)
(setq pp (vlax-curve-getClosestPointTo pl p))
(and (= (car p) (car pp)) (= (cadr p) (cadr pp)))
)
;;;--------------------------------------------------------------------


;;;MAIN PROGRAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;
(defun C:ZZ(/ oldos p Ln Lpp res sspl pl1 pl2 pp1 pp2 v1 ssp sst Lp x)

;;;INPUT DATA
(setq oldos (getvar "osmode"))
(setvar "osmode" 8)
(setq
p (getpoint "\nBase point:")
Ln nil Lpp nil res nil
)
(setvar "osmode" 0)
(prompt "\nSelect 2 Equal Level Polylines or ...")
(setq sspl (ssget '((0 . "LWPOLYLINE"))))

;;;INTERPOLATE FROM EQUAL LEVEL PLINE
(if (and sspl (setq pl1 (ssname sspl 0) pl2 (ssname sspl 1))) (progn
(vl-load-com)
(setq
pp1 (vlax-curve-getClosestPointTo pl1 p)
pp2 (vlax-curve-getClosestPointTo pl2 p)
)
;;;If pline across p then write result and exit
(if (and (= (car p) (car pp1)) (= (cadr p) (cadr pp1))) (setq res (caddr pp1)))
(if (and (= (car p) (car pp2)) (= (cadr p) (cadr pp2))) (setq res (caddr pp2)))
(if res (progn
(alert "The polyline across the point")
(wtxt (rtos res) p)
(setvar "osmode" oldos)
(princ)
(exit)
))
;;;Else continue...
(setq
v1 (inter2p p pp1 pp2)
Ln (append Ln (list v1))
)
))

;;;INTERPOLATE FROM REFERENCE POINTS
(prompt "\nSelect Reference Points or ...")
(if (and (setq ssp (ssget '((0 . "POINT"))))
(setq sst (ssget "X" '((0 . "TEXT"))))
)
(progn
(setq Lp (vl-remove p (ss2Lp ssp)))
(if (/= (mod (length Lp) 2) 0)
(progn
(alert "Number of reference points must be in Even (n = 2k). Action is canceled!")
(exit)
)
(progn
(foreach x Lp (setq Lp (subst (getZ x sst) x Lp)))
(setq Lpp (pair p Lp))
(foreach x Lpp (setq Ln (append Ln (list (inter2p p (car x) (cadr x))))))
)
)
)
)

;;;WRITE RESULT
(if Ln (wtxt (rtos (aver Ln)) p))
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;

Thuyết minh hoạt động của chương trình:
1) Nội suy theo đường đồng mức: từ điểm đang xét, kẻ 2 đường vuông góc (theo mặt bằng) với 2 đường đồng mức. Sau đó thực hiện nội suy theo công thức:
Z = (d1*Z2 + d2*z1) / (d1 + d2), không quan tâm đến 3 điểm có thẳng hàng hay không.

2) Nội suy theo các cặp điểm tham chiếu:
Công thức nội suy vẫn như trên. Yêu cầu tổng số điểm chọn, trừ điểm đang xét, phải là số chẵn. Nếu không, chương trình sẽ ra thông báo và sau đó exit.
Xem ra cũng khá dài dòng vì để lấy được dữ liệu của 1 điểm phải cần đến 2 đối tượng khác loại nhau (lấy X, Y từ point và lấy Z từ text). Trong 2 thành phần đó, chương trình dựa vào point là chính. Độ cao Z được lấy theo đối tượng text gần nhất so với point. Lưu ý: điểm chuẩn của text đối với chương trình là điểm insert của nó. Do đó, trong các vùng phức tạp, mật độ text dày đặc, có khả năng gặp phải trường hợp “râu ông nọ cắm cằm bà kia”! Nếu có thể, nên chuyển điểm insert của text về trùng (x, y) với đối tượng point mà nó biểu diễn để bảo đảm cho chương trình chạy chính xác.

3) Theo mình, các bản vẽ đã “lỡ có” rồi thì thôi. Nhưng khi lập bản vẽ mới, nên có quy ước nhất quán sẽ tạo điều kiện thuận lợi hơn cho lập trình khi cần. Chẳng hạn, cách ghi text và point, nếu bảo đảm được 1 trong 2 điều kiện sau thì chương trình này sẽ đơn giản hơn rất nhiều, và hoàn toàn không phải bận tâm đến vấn đề nêu trên:
- Các đối tượng point được vẽ đúng độ cao z (giống như các pline đồng mức).
- Các đối tượng text có điểm insert đúng tọa độ x, y của point

Vbao xem và test trong nhiều trường hợp khác nhau. Nếu có vấn đề gì thì phản hồi, mình sẽ sửa và bổ sung.

Anh cho e hỏi sao lisp này e k dùng dc ạ? load vào xong, nhưng đánh lệnh zz thì không được ạ.không tồn tại lệnh zz. còn  Cái lisp Test thì em lại dùng ok ạ? 


  • 0