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

[yêu cầu] Lisp chia đoạn thẳng!

Bởi khongbietthihoi , trong AutoLisp

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

leetunghoanh    0

leetunghoanh
Đã đăng

bạn KangKung  có thể nâng cấp chương trình dùm mình với :

 

Nếu chọn đối tượng là arc thì sẽ tự động convert đối tượng đó sang pline rùi mới thực hiện lệnh chia đoạn thẳng

 

việc này có thể thưc hiện thủ công bằng dùng pedit trước khi dùng lisp của bạn nhưng vậy thì hơi tốn công quá

 

Thanks !

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

leetunghoanh    0

leetunghoanh
Đã đăng

Hi, mình tự mài mò sửa nhưng bị vướng chổ điều kiện cho hàm if

 

mọi người gúp mình thực hiện thêm  logicExpr của hàm if với, mình mới tìm hiểu autolisp nên ko rành lăm, ko biết điều kiện để xác định đối tượng là arc phải viết thế nào

 

 

(setq taphop(ssget '((0 . "ARC,LINE,POLYLINE,LWPOLYLINE"))))
;=======================
;start if
;if taphop is arc

(if ..........................

; moi người giúp mình logicExpr chổ này để xác định đối tượng taphop là arc

 

  (command ".pedit" "M" taphop "" "" "")

  (princ "\n Object Arc converted to Polyline, Please select this object again")

  (setq taphop(ssget '((0 . "ARC,LINE,POLYLINE,LWPOLYLINE"))))

;if taphop is not arc => don't do anything

) ;end if

;=======================

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Hi, mình tự mài mò sửa nhưng bị vướng chổ điều kiện cho hàm if

 

mọi người gúp mình thực hiện thêm  logicExpr của hàm if với, mình mới tìm hiểu autolisp nên ko rành lăm, ko biết điều kiện để xác định đối tượng là arc phải viết thế nào

 

 

(setq taphop(ssget '((0 . "ARC,LINE,POLYLINE,LWPOLYLINE"))))

;=======================

;start if

;if taphop is arc

 

(if ..........................

; moi người giúp mình logicExpr chổ này để xác định đối tượng taphop là arc

 

  (command ".pedit" "M" taphop "" "" "")

 

  (princ "\n Object Arc converted to Polyline, Please select this object again")

 

  (setq taphop(ssget '((0 . "ARC,LINE,POLYLINE,LWPOLYLINE"))))

 

;if taphop is not arc => don't do anything

 

) ;end if

 

;=======================

Hề hề hề,

Cứ theo cái logic của bạn là : ;if taphop is not arc => don't do anything

thì sao phải khổ vậy?????

Chỉ dơn giản là hãy chọn tập hợp chỉ bao gồm các arc là xong. Vậy thì chỉ cần  (setq taphop(ssget '((0 . "ARC"))))

  • 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

leetunghoanh    0

leetunghoanh
Đã đăng

hi tại cái lisp của bạn kangkung ko dung đuoc cho arc nên mình mới dùng thủ thuật này tức ,mà bạn biêt thì chỉ mình vơi,cái này mình cung muốn biết thêm cách xác đinh đuoc đối tượng mình chon là arc như thế nào

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

quocmanh04tt    635

quocmanh04tt
Đã đăng

Bạn tham khảo:

(defun c:tt  (/ els ent ety lst sodem soptu taphop)
 (if (setq taphop (ssget '((0 . "*LINE,ARC"))))
  (progn (setq soptu (sslength taphop)
               sodem    0)
         (repeat soptu
          (setq ent (ssname taphop sodem)
                lst (assoc 0 (entget ent))
                ety (cdr lst))
          (cond ((eq ety "LWPOLYLINE") (princ (strcat "\nEm la:" ety)) (Thuc_hien_gi_do))
                ((eq ety "POLYLINE") (princ (strcat "\nEm la:" ety)) (Thuc_hien_gi_do))
                ((eq ety "LINE") (princ (strcat "\nEm la:" ety)) (Thuc_hien_gi_do))
                ((eq ety "ARC") (princ (strcat "\nEm la:" ety)) (Thuc_hien_gi_do)))
          (setq sodem (1+ sodem)))))
 (princ))
(defun Thuc_hien_gi_do () (princ ". Anh muon lam gi em?"))

+ Trong lsp của KangKung bạn có thể thay dòng này: (setq vlaobj (vlax-ename->vla-object obj)) bằng cụm này:

(if (wcmatch (cdr (assoc 0 (entget obj))) "ARC,LINE")
   (progn (command "_.PEDIT" obj "Y" "")
          (setq obj    (entlast)
                vlaobj (vlax-ename->vla-object obj)))
   (setq vlaobj (vlax-ename->vla-object obj)))

+ Sử dụng theo hướng này thì ARC sau khi chia nó không cong nữa mà thành Pline gấp khúc.

  • 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

Đỗ Hà    0

Đỗ Hà
Đã đăng

tớ mới học cad. vẽ hình đơn giản thôi bạn nào chỉ giúp tớ chia một đoạn thẳng thành nhiều đoạn nhỏ hơn????

(kích thước các đoạn không bằng nhau)

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

HUNGMETRO    5

HUNGMETRO
Đã đăng

Xin mọi người trên diễn đàn giúp đỡ viết lisp:

Mình gặp một trường hợp trong file Cad có các đoạn thẳng có chiều dài =0. ((line (x1=x2, y1=y2) và polyline cũng có  (polyline (x1=x2, y1=y2))

mong các cao thủ trên diễn đàn viết giùm một file lisp tìm và lọc ra các đoạn thẳng đó

Đây là file Cad của mình, các lines và polylines mình đã đánh dấu trong vòng tròn màu tím, Xin cảm ơn diễn đà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

Bee    154

Bee
Đã đăng

Cần gì Lisp. Chọn Quick select / LINE or PLINE / LENGTH = 0 là chọn hết cái nào cần chọn mà. !

  • 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

tuvn254    3

tuvn254
Đã đăng
Vào lúc 7/5/2013 tại 14:30, KangKung đã nói:

Rắc rối là ở đây (vlax-curve-getPointAtDist obj (vla-get-length vlaobj)) có lúc đúng lúc sai do độ chính xác. Lisp mới dưới đây sẽ khắc phục lỗi đó. 


;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE
(defun C:CDT1(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (= n nil) (setq n1 1) (setq n1 n))
  (setq n (getint (strcat "\n So doan can chia: <" (rtos n1 2 0) "> ")))
  (if (= n nil) (setq n n1))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq d 0)
    (command "PLINE")
    (while (< d (vla-get-length vlaobj))
      (command (vlax-curve-getPointAtDist obj d))
      (setq d(+ d (/ (vla-get-length vlaobj) n))))
    (command (vlax-curve-getendpoint vlaobj) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG KHOANG CACH NHAP TU BAN PHIM
(defun C:CDT2(/ taphop i obj vlaobj d dt)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (setq lst(list))
  (setq i 1)
  (while (setq d(getreal (strcat "\n Nhap chieu dai doan thu " (itoa i) ": ")))
    (setq lst(append lst (list d)))
    (setq i(1+ i)))
  (setq i 0)
  (while (< i (sslength taphop))
    (setq obj(ssname taphop i))
    (setq vlaobj(vlax-ename->vla-object obj))
    (setq S 0)
    (command "PLINE" (vlax-curve-getPointAtDist obj 0))
    (foreach d lst
      (if (< (+ S d) (vla-get-length vlaobj))
	(progn
	  (setq S(+ S d))
	  (command (vlax-curve-getPointAtDist obj S)))))
    (command (vlax-curve-getendpoint vlaobj) "")
    (setq dt(vlax-ename->vla-object (entlast)))
    (vla-put-linetype dt (vla-get-linetype vlaobj))
    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))
    (vla-put-lineweight dt (vla-get-lineweight vlaobj))
    (vla-put-color dt (vla-get-color vlaobj))
    (vla-put-layer dt (vla-get-layer vlaobj))
    (vla-delete vlaobj)
    (setq i (1+ i))
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )

Rất cảm ơn bạn về lisp này, m mới down về và đang sử dụng.

Sau khi chia nhỏ đường pl, m phá khối để nó trở thành nhiều đường riêng rẽ để phục vụ công việc của mình, nhưng sau khi phá khối, các đoạn đó thành đường line. Có cách nào để nó vừa chia nhỏ, và sau khi phá khối, nó vẫn là đường polyline không (Lisp dùng được cho cả những đoạn cong bạn nh)

Cảm ơn bạn rất nhiều

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

TranAnhTuong    6

TranAnhTuong
Đã đăng
Vào lúc 6/5/2013 tại 21:59, KangKung đã nói:

Bạn dùng Lisp này xem đúng ý chưa. Lệnh CDT1 dùng để chia đường thẳng thành nhiều đoạn bằng nhau. Có thể quét chọn để chia hàng loạt đường thẳng cùng lúc. Lệnh CDT2 dùng để chia đường thẳng thành những đoạn có độ dài bằng khoảng cách nhập từ bàn phím. Khi kết thúc thì bấm Space hoặc Enter. 



;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG NHAU VA VE THANH POLYLINE

(defun C:CDT1(/ taphop n i obj vlaobj d dt os)

  (command "UNDO" "BE")

  (setq os(getvar "OSMODE"))

  (setvar "OSMODE" 0)

  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))

  (setq n(atoi(lisped "Nhap so doan can chia vao day")))

  (setq i 0)

  (while (< i (sslength taphop))

    (setq obj(ssname taphop i))

    (setq vlaobj(vlax-ename->vla-object obj))

    (setq d 0)

    (command "PLINE")

    (while (<= d (vla-get-length vlaobj))

      (command (vlax-curve-getPointAtDist obj d))

      (setq d(+ d (/ (vla-get-length vlaobj) n))))

    (command "")

    (setq dt(vlax-ename->vla-object (entlast)))

    (vla-put-linetype dt (vla-get-linetype vlaobj))

    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))

    (vla-put-lineweight dt (vla-get-lineweight vlaobj))

    (vla-put-color dt (vla-get-color vlaobj))

    (vla-put-layer dt (vla-get-layer vlaobj))

    (vla-delete vlaobj)

    (setq i (1+ i))

    )

  (setvar "OSMODE" os)

  (command "UNDO" "END")

  (princ)

  )

;LISP CHIA DUONG THANG THANH NHIEU DOAN BANG KHOANG CACH NHAP TU BAN PHIM

(defun C:CDT2(/ obj vlaobj dt i S d os)

  (command "UNDO" "BE")

  (setq os(getvar "OSMODE"))

  (setvar "OSMODE" 0)

  (while (setq obj(car (entsel "\n Chon doan thang can chia: ")))

    (setq i 1 S 0 vlaobj(vlax-ename->vla-object obj))

    (command "PLINE" (vlax-curve-getPointAtDist obj 0))

    (while (setq d(getreal (strcat "\n Nhap chieu dai doan thu " (itoa i) ": ")))

      (if (<= (+ S d) (vla-get-length (vlax-ename->vla-object obj)))

	(progn

	  (setq S(+ S d))

	  (command (vlax-curve-getPointAtDist obj S))

	  (setq i(1+ i))

	  )

	(alert "Tong chieu dai vuot qua chieu dai ban dau")

	)

      )

    (if (= d nil) (command (vlax-curve-getPointAtDist obj (vla-get-length (vlax-ename->vla-object obj)))))

    (command "")

    (setq dt(vlax-ename->vla-object (entlast)))

    (vla-put-linetype dt (vla-get-linetype vlaobj))

    (vla-put-LinetypeScale dt (vla-get-LinetypeScale vlaobj))

    (vla-put-lineweight dt (vla-get-lineweight vlaobj))

    (vla-put-color dt (vla-get-color vlaobj))

    (vla-put-layer dt (vla-get-layer vlaobj))

    (vla-delete vlaobj)

    )

  (setvar "OSMODE" os)

  (command "UNDO" "END")

  (princ)

  )

Em cũng đang cần 1 LISP tương tự nhưng có thêm phần nhập khoảng cách khe hở giữa các đoạn thẳng. nhờ Anh giúp đỡ ah!

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
Về Đầu Trang AutoLisp
×