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

Giúp mình lisp Dim chia đoạn thẳng

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

Đầu tiên mình có một polyline, các bạn giúp mình một lisp tạo dim chia đoạn polyline đó thành các đoạn bằng nhau và bằng kích thước mình nhập vào, ngoài ra phần lẻ còn lại thì điền đúng với kích thước của nó!81217_1.png81217_3.png

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 dùng lệnh DIV của cad là được rồi. lưu ý: lẹnh này chia ra các đoạn bằng nhau.

Hình như anh đã nhầm:

- Lệnh DIV chỉ chia được đoạn thẳng thành n đoạn bằng nhau

- ME chia đoạn thẳng ra thành n đoạn thẳng có chiều dài a cho trước và dư một đoạn ≤ a

 

 

 

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

mình biết lệnh chia điểm nhưng mình muốn là khi mình chọn đường thẳng thì nó dim cho mình luôn như trong hình vẽ ấy!

Sao bạn không DIm trước một DIM rồi copy tiếp, cũng nhanh mà?

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

Cái này dựa trên lisp của anh Gia_Bach (thanks!), sửa lại vài tí cho bạn dùng.


(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd ss1 x)

 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
             old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if (and (setq pt1 (getpoint "\nDiem dau :"))
               (setq pt2 (getpoint pt1 "\nDiem cuoi :"))
               (setq pt3 (getpoint "\nDiem dat duong dim :")))
  (progn
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pt3a (polar px (+ (angle px pt3) pi) 1))
    (entmakex (list (cons 0 "LINE") (cons 10 pt3) (cons 11 pt3a)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (entmakex (list (cons 0 "LINE") (cons 10 pt2) (cons 11 (polar pt2 (+ (angle pt2 pt3) pi) 1))))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ss (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
             line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
   (command "erase" ss1 "")
 (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

 

Cái này dựa trên lisp của anh Gia_Bach (thanks!), sửa lại vài tí cho bạn dùng.


(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd ss1 x)

 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
             old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if (and (setq pt1 (getpoint "\nDiem dau :"))
               (setq pt2 (getpoint pt1 "\nDiem cuoi :"))
               (setq pt3 (getpoint "\nDiem dat duong dim :")))
  (progn
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pt3a (polar px (+ (angle px pt3) pi) 1))
    (entmakex (list (cons 0 "LINE") (cons 10 pt3) (cons 11 pt3a)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (entmakex (list (cons 0 "LINE") (cons 10 pt2) (cons 11 (polar pt2 (+ (angle pt2 pt3) pi) 1))))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ss (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
             line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
   (command "erase" ss1 "")
 (princ))

Nó vẫn bị lỗi bạn à! mình chọn điểm đầu và điểm cuối của đoạn thẳng nhưng nếu có 2 line khác cắt ngang line đấy thì nó sẽ dim cả khoảng cách đoạn cắt đấy. Bạn có cách nào sửa không? mình chỉ muốn chia một đoạn thẳng mà mình chọn thôi, các đường khác không quan tâm đế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

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.


;Chia Dim doan thang (03/03/2013).

(defun C:HA (/ i pts act end line pt1 pt2 ss sta n cd x)
 (defun Get_pts_ss_inter_obj (ss obj / e i lst_pt obj pts)
  (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) new)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
    (setq lst_pt (append (list->3pair pts) lst_pt))))
  (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y)))))
 (vl-load-com)
 (setq cd (getreal "\nChieu dai moi doan chia: "))
 (if
  (and
   (setq pt1 (getpoint "\nDiem dau: "))
   (setq pt2 (getpoint pt1 "\nDiem cuoi: "))
   (setq pt3 (getpoint "\nDiem dat duong dim: ")))
  (progn
   (setq ssc (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (setq n (fix (/ (distance pt1 pt2) cd)) x 0 ss1 (ssadd))
   (repeat (1+ n)
    (setq px (polar pt1 (angle pt1 pt2) (* cd x)) pxt (polar px (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar px (- (angle pt1 pt2) (* 0.5 pi)) 100))
    (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
    (setq ss1 (ssadd (entlast) ss1))
    (setq x (1+ x)))
   (if (not (equal n (/ (distance pt1 pt2) cd) 1E-8))
    (progn
     (setq pxt (polar pt2 (+ (angle pt1 pt2) (* 0.5 pi)) 100) pxd (polar pt2 (- (angle pt1 pt2) (* 0.5 pi)) 100))
     (entmakex (list (cons 0 "LINE") (cons 10 pxt) (cons 11 pxd)))
     (setq ss1 (ssadd (entlast) ss1))))
   (setq ssm (ssget "f" (list pt1 pt2) (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))    
   (defun TRUSS (ssm ssc / i) (repeat (setq i (sslength ssc)) (ssdel (ssname ssc (setq i (1- i))) ssm)))
   (setq ss (TRUSS ssm ssc))
   (setq act (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
         line (vla-addline act (vlax-3d-point pt1) (vlax-3d-point pt2)))
   (setq pts (Get_pts_ss_inter_obj ss line))
   (if (> (vl-list-length pts) 1)
    (progn
     (setq sta (car pts) i 1)
     (repeat (- (vl-list-length pts)1)
      (setq end (nth i pts) i (1+ i))
      (vla-AddDimAligned act (vlax-3d-point sta) (vlax-3d-point end) (vlax-3d-point pt3))
      (setq sta end))))
   (vla-delete line)))
 (command "erase" ss1 "")
 (princ))
  • Vote tăng 3

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

Nó vẫn bị lỗi bạn à! mình chọn điểm đầu và điểm cuối của đoạn thẳng nhưng nếu có 2 line khác cắt ngang line đấy thì nó sẽ dim cả khoảng cách đoạn cắt đấy. Bạn có cách nào sửa không? mình chỉ muốn chia một đoạn thẳng mà mình chọn thôi, các đường khác không quan tâm đến.

 

 

Quên mất trường hợp có các đường cắt ngang. Sửa lại cho bạn đây.

 

Đầu vào thế kia thôi mà 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

Khổ lắm! Chủ topic ra đề chỉ là chia đoạn thẳng thôi nên chỉ lấy lisp của người khác thêm vài dòng. Chứ y/c hẳn hoi thì chắc phải viết tươm tất hơ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

Pick chọn đối tượng cũng tiện mà bác. Chiều dài thì cứ từ trái qua phải giống như cách trình bày phổ thông đi.

Và làm cho đường chéo nữa...  :unsure:

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


×