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

[tamnv4 2]

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

[conghoa 123]

Cách thao tác move các điểm trên Cad của bạn như nào?, có thể do cách làm của bạn không nhanh nên thấy nhàm chán.

[Tot77 508]

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