Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
17 replies to this topic

#1 theducw87

theducw87

    biết vẽ circle

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

Đã gửi 01 March 2013 - 08:14 PM

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


  • 0

#2 anhbkhcm

anhbkhcm

    biết vẽ circle

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

Đã gửi 02 March 2013 - 11:50 AM

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.


  • 0

#3 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 02 March 2013 - 12:17 PM

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



 


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#4 Hantinhsaycad

Hantinhsaycad

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 1073 Bài viết
Điểm đánh giá: 376 (khá)

Đã gửi 02 March 2013 - 01:18 PM

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


  • 1

Đừng để một ai chẳng nhận được gì khi rời chỗ bạn, cho dù bạn biết rằng không bao giờ gặp lại.

Ngạn ngữ Pháp


#5 theducw87

theducw87

    biết vẽ circle

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

Đã gửi 02 March 2013 - 06:31 PM

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!


  • 0

#6 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 641 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 02 March 2013 - 09:38 PM

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


  • 0

#7 theducw87

theducw87

    biết vẽ circle

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

Đã gửi 02 March 2013 - 11:28 PM

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


  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 03 March 2013 - 08:55 AM

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

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 theducw87

theducw87

    biết vẽ circle

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

Đã gửi 04 March 2013 - 07:23 AM

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.


  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 04 March 2013 - 08:37 AM

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

  • 3

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 March 2013 - 09:34 AM

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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 March 2013 - 10:26 AM

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


  • 0

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 04 March 2013 - 10:34 AM

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.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 March 2013 - 10:36 AM

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

#15 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 04 March 2013 - 10:46 AM

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


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#16 carlzeiss

carlzeiss

    Chưa sử dụng CAD

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

Đã gửi 22 March 2013 - 10:16 AM

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:


  • 0

#17 huykhanh_xd

huykhanh_xd

    biết pan

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

Đã gửi 07 February 2014 - 11:52 AM

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.


  • 0

#18 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 07 February 2014 - 09:34 PM

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.c...7168_tmp1_3.lsp


  • 0


Trở lại AutoLisp