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

[theducw87 2]

Đầ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ó!

[anhbkhcm 6]

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.

[haanh 1.590]

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

 

 

 

[Hantinhsaycad 379]

Hi hi,

Lệnh thì bạn ấy đã biết ,trên hình upload , Giờ bạn ấy mún cái Lisp cơ mà.................

[theducw87 2]

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!

[quansla 259]

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à?

[theducw87 2]

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

Vì khối lượng cv nhiều nên làm thế cũng k tiện lắm :d

[Doan Van Ha 3.192]

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

[theducw87 2]

 

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.

[Doan Van Ha 3.192]

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

[ketxu 2.984]

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

[NguyenNgocSon 43]

Hình như cái lisp HA trên khi đường PL chéo không đúng ?

[Doan Van Ha 3.192]

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.

[NguyenNgocSon 43]

Update luôn cho trường hợp pick chọn đối tượng đi bác HA

[Doan Van Ha 3.192]

Pick chọn đối tượng thì xãy ra trường hợp: xét chiều của đối tượng từ A đến B hay B đến A nữa

[carlzeiss 0]

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:

[huykhanh_xd 1]

Mình đang định hỏi câu này. Cảm ơn Dao Van Ha, và cảm ơn cả bạn theducw87 nữa.

[Tot77 508]

Chưa đọc cái lisp của bác Gia_Bach nhưng nghĩ không cần dài như vậy, có cái này ngắn hơn nhưng không biết có dung với yêu cầu chưa.http://www.cadviet.com/upfiles/3/127168_tmp1_3.lsp