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

Di chuyển các điểm node của đường Pline

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

Em là dân giao thông, công việc này thường xuyên lặp đi lặp lại mà em phải làm thủ công suốt, tốn thời gian quá. Vậy em xin mạo muội tạo Topic này xin các anh/chị cao thủ giúp để em tiết kiệm được thời gian cho công việc nhàm chán này. em xin chân thành cảm ơn. em xin trình bày nội dung như sau: khi em làm trắc ngang tuyến đường cũ thì phải kéo địa chất lớp dưới cho trùng với lớp trên ở 1 số điểm. Do vậy 1 số điểm em phải di chuyển lên cho trùng với lớp trên cùng, 2 điểm ở 2 đầu (không phải điểm đầu và điểm cuối của pline) thì sẽ phải di chuyển theo hướng kéo dài để gặp đường lớp trên. Em có thử loay hoay viết lisp để xử lý vấn đề này nhưng mãi không xong.  Nói thì mông lung dài dòng nên em gửi kèm theo file cad lên để nhờ các Anh/Chị cao thủ giúp đỡ. Bác nào giúp đỡ được em xin chân thành cảm ơn và hậu tạ.

http://www.cadviet.com/upfiles/4/137223_km10_5.dwg

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

Bạn thử cái này, nhấp chọn pline màu vàng, chọn điểm đầu và cuối của pline cần di chuyển , sau đó chọn pline màu xanh.

(defun c:nha (/ os a b pt1 pt2 ad bg cg sg l1 l2 pt3 pt4 en)
  (vl-load-com)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun ints (o1 o2 mo)
    (defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l)))
    (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo))
  )
  (defun getvertex (pl d1 d2 / lst p1 p2 p3 p4)
    (setq lst nil
 p1 (if d1 (vlax-curve-getParamatPoint pl (vlax-curve-getclosestpointto pl d1)) 1)
 p2 (if d2 (vlax-curve-getParamatPoint pl (vlax-curve-getclosestpointto pl d2))
          (1- (vlax-curve-getEndParam pl)))
 p3 (1- (min p1 p2))
 p4 (1+ (max p1 p2))
    )
    (while (<= p3 p4) 
      (setq lst (cons (vlax-curve-getpointatParam pl p3) lst)
   p3 (1+ p3))
    )
    (reverse lst)
  )
  
  (setq os (getvar 'osmode))
  (vl-cmdf "ucs" "w" "undo" "be") (setvar 'osmode 1)
  (setq a (car (entsel "\nChon Pline can di chuyen: "))
pt1 (getpoint "\nTu diem: ") 
pt2 (getpoint "\nDen diem: ") 
b (car (entsel "\nDen Pline: "))
ag (getvertex a pt1 pt2)
bg (getvertex b nil nil)
cg (getvertex a nil nil))
  (setvar 'osmode 0)
  (setq l1 (entmakex (list '(0 . "LINE") (cons 10 (car ag)) (cons 11 (cadr ag))))
l2 (entmakex (list '(0 . "LINE") (cons 10 (last ag)) (cons 11 (cadr (reverse ag)))))
ag (vl-remove (last ag) (cdr ag))
pt3 (ints l1 b acextendboth)
pt3 (car (vl-sort pt3 '(lambda (x y) (< (distance (car ag) x) (distance (car ag) y)))))
pt4 (ints l2 b acextendboth)
pt4 (car (vl-sort pt4 '(lambda (x y) (< (distance (last ag) x) (distance (last ag) y)))))
sg (mapcar '(lambda (x) (list x (nth (vl-position x cg) bg))) (vl-remove (last ag) (cdr ag)))
sg (append (cons (list (car ag) pt3) sg) (list (list (last ag) pt4)))
  )
  (setq en a)
  (while (not (equal (dxf 0 (setq en (entnext en))) "SEQEND"))
    (if (setq tm (assoc (dxf 10 en) sg))
       (entmod (subst (cons 10 (last tm)) (cons 10 (car tm)) (entget en))))
  )
  (entdel l1) (entdel l2) (vl-cmdf "regen" "ucs" "p" "undo" "e") (setvar 'osmode os) (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

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


×