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.
Đăng nhập để thực hiện theo  
hihi.hehe

[Yêu Cầu] Lisp Lọc Đường Thẳng Theo Độ Dốc!

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

hihi.hehe    3

Mình hiện tại đang có nhu cầu như thế này:

- Gõ lệnh, yêu cầu nhập giá trị cận dưới (a), giá trị cận trên (b ).

- Sau đó quét chọn tất cả các đối tượng (line) cần lọc.

- Đối tượng nào có giá trị độ dốc (Delta X / Delta Y) nằm trong khoảng a,b sẽ được chọn.

- Sau đó xử lý những đối tượng này như thế nào là do mình.

Mong các anh em trên diễn đàn giúp đỡ mình ạ!

  • Vote giảm 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
Doan Van Ha    2.676

Dùng cái này xem.

 

;Doan Van Ha - CADViet.com - Ngay 23/11/2015
;Muc dich: Chon cac doi tuong Line nam giua 2 gioi han ve Dy/Dx.
(defun C:HA( / duoi tren ss lst)
 (if
  (and
   (not (initget 1)) (setq duoi (getreal "\nNhap gioi han duoi: "))
   (not (initget 1)) (setq tren (getreal "\nNhap gioi han tren: "))
   (princ "\nChon cac doi tuong Line...")
   (setq ss (ssget '((0 . "Line"))) ss1 (ssadd)))
  (progn  
   (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq lst (entget ent))
    (if
     (>= tren (/ (- (caddr (assoc 10 lst)) (caddr (assoc 11 lst))) (- (cadr (assoc 10 lst)) (cadr (assoc 11 lst)))) duoi)
     (setq ss1 (ssadd ent ss1))))
   (sssetfirst nil ss1))))
  • Vote tăng 2

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
hihi.hehe    3

 

Dùng cái này xem.

hehe hay quá, đúng cái mình cần rồi. Với cả hiện tại mình có cái lisp này để ghi độ dốc cho polyline, nhưng chỉ chọn được một đối tượng polyline, các bạn có thể giúp mình chỉnh sửa chọn được nhiều polyline (nếu là nhiều line được thì càng tốt) không ạ.

(defun c:gd (/ entpl p1 cao_text sp ep ang dodoc thap_phan)
(vl-load-com)
(setq entpl (entsel "\n Hay chon polyline can ghi do doc")
      entob (vlax-ename->vla-object (car entpl))
)
(setq x (getreal "\n Hay nhap ty le theo truc x: ")
      y (getreal "\n Hay nhap ty le theo truc y: "))
(setq cao_text (getreal "\n Hay nhap chieu cao text: ")
      h (getreal "\n Hay nhap khoang cach tu text toi pline: ")
      i 0
      thap_phan 2
      p1 (cadr entpl)
      ent (car entpl)
      m (vlax-curve-getendparam ent))
(while (< i m)
(setq sp (vlax-curve-getPointatparam ent i)
      ep (vlax-curve-getPointatparam ent (1+ i))
      ang (angle sp ep)
      x1 (car sp)
      y1 (cadr sp)
      x2 (car ep)
      y2 (cadr ep)
      dodoc (* (abs (/ (/ (- y2 y1) y) (/ (- x2 x1) x 100))) )
      dodoc (strcat (rtos dodoc 2 thap_phan) ))
(if (< (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.1)))
    (command "_.text" (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) cao_text (/ (* ang 180) pi)(strcat dodoc))
    )
    (if (> (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.9)))
    (command "_.text" (list (+ (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) cao_text (+ 180 (/ (* ang 180) pi)) (strcat dodoc))
    )
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
    (command "_.text" (list (+ (car pt) h) (cadr pt)) cao_text 90 (strcat dodoc))
    )
    )
)
(setq i (1+ i))
  • Vote giảm 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

Mình muốn xin các bạn lisp như sau: trên 1 pline gồm nhiều đoạn nối với nhau (hoặc spline) tổng chiều dài 100m, điểm đầu là A và điểm cuối là B. Xác định điểm C ở giữa sao cho đoạn AC dài 49.98 m. Tức đoạn AB dài 100m sẽ chỉ còn đoạn AC dài 49.98 m. Cam ơn các bạ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
hihi.hehe    3

Mình muốn xin các bạn lisp như sau: trên 1 pline gồm nhiều đoạn nối với nhau (hoặc spline) tổng chiều dài 100m, điểm đầu là A và điểm cuối là B. Xác định điểm C ở giữa sao cho đoạn AC dài 49.98 m. Tức đoạn AB dài 100m sẽ chỉ còn đoạn AC dài 49.98 m. Cam ơn các bạn.

Bạn thử dùng lệnh:

- len.

- Select an object or [DElta/Percent/Total/DYnamic]: de

- Enter delta length or [Angle]: -50.02 (vì 100 - 50.02 = 49.98)

- Chọn đoạn gần điểm B.

Bạn thử xem, cần gì lisp cho lằng nhằng :D

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
pphung183    425

 

hehe hay quá, đúng cái mình cần rồi. Với cả hiện tại mình có cái lisp này để ghi độ dốc cho polyline, nhưng chỉ chọn được một đối tượng polyline, các bạn có thể giúp mình chỉnh sửa chọn được nhiều polyline (nếu là nhiều line được thì càng tốt) không ạ.

(defun c:gd (/ entpl p1 cao_text sp ep ang dodoc thap_phan)
(vl-load-com)
(setq entpl (entsel "\n Hay chon polyline can ghi do doc")
      entob (vlax-ename->vla-object (car entpl))
)
(setq x (getreal "\n Hay nhap ty le theo truc x: ")
      y (getreal "\n Hay nhap ty le theo truc y: "))
(setq cao_text (getreal "\n Hay nhap chieu cao text: ")
      h (getreal "\n Hay nhap khoang cach tu text toi pline: ")
      i 0
      thap_phan 2
      p1 (cadr entpl)
      ent (car entpl)
      m (vlax-curve-getendparam ent))
(while (< i m)
(setq sp (vlax-curve-getPointatparam ent i)
      ep (vlax-curve-getPointatparam ent (1+ i))
      ang (angle sp ep)
      x1 (car sp)
      y1 (cadr sp)
      x2 (car ep)
      y2 (cadr ep)
      dodoc (* (abs (/ (/ (- y2 y1) y) (/ (- x2 x1) x 100))) )
      dodoc (strcat (rtos dodoc 2 thap_phan) ))
(if (< (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.1)))
    (command "_.text" (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) cao_text (/ (* ang 180) pi)(strcat dodoc))
    )
    (if (> (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.9)))
    (command "_.text" (list (+ (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) cao_text (+ 180 (/ (* ang 180) pi)) (strcat dodoc))
    )
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
    (command "_.text" (list (+ (car pt) h) (cadr pt)) cao_text 90 (strcat dodoc))
    )
    )
)
(setq i (1+ i))

Bạn copy Lisp này ở đâu mà thiếu của tác giả thế :wacko: ... Tuy nhiên Lisp trên còn thiếu trường hợp khi x1 = x2 sẽ dừng chạy chương trình :) . Thêm Line thì cũng tương tự thôi nhưng đơn giản hơ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
hihi.hehe    3

Bạn copy Lisp này ở đâu mà thiếu của tác giả thế :wacko: ... Tuy nhiên Lisp trên còn thiếu trường hợp khi x1 = x2 sẽ dừng chạy chương trình :) . Thêm Line thì cũng tương tự thôi nhưng đơn giản hơn.

 

 

Lisp này mình lấy trên diễn đàn của bác phamthanhbinh, chắc bác ý không để tên tác giả vào code thôi :D. Thế bạn có thể chỉnh sửa theo ý muốn của mình được không, có thể chọn một lúc được nhiều đối tượng line :D

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
pphung183    425

Lisp này mình lấy trên diễn đàn của bác phamthanhbinh, chắc bác ý không để tên tác giả vào code thôi :D. Thế bạn có thể chỉnh sửa theo ý muốn của mình được không, có thể chọn một lúc được nhiều đối tượng line :D

Trở lại Topic cũ tôi sửa cho... Nếu ko tìm được thì coi như ko may thui :D

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
hihi.hehe    3

Trở lại Topic cũ tôi sửa cho... Nếu ko tìm được thì coi như ko may thui :D

http://www.cadviet.com/forum/topic/13627-do-doc-cua-cac-doan-tren-duong-pl/

topic đấy tận năm 2009 lận, giờ đào mộ lên không biết có sao không nhỉ, với cả sao không sửa trực tiếp ở topic này, mình là thành viên mới, nên cũng không rõ lắ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
pphung183    425

Thử lòng bạn thôi :) ... Biết search tìm kiếm học hỏi là tốt rồi :D . Thế bạn có muốn nhập tỉ lệ theo x, y không? Hay là quét chọn các Line or Pline không Arc là tính luô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
hihi.hehe    3

Thử lòng bạn thôi :) ... Biết search tìm kiếm học hỏi là tốt rồi :D . Thế bạn có muốn nhập tỉ lệ theo x, y không? Hay là quét chọn các Line or Pline không Arc là tính luôn -_-

có nhập tỷ lệ x, y, cao chữ với cả khoảng offset rồi chọn đối tượng :D

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
pphung183    425

Test thử cho ý kiến  :) :

(defun c:gd (/ wtxt ss x y ent obj ht h i m sp ep ang x1 y1 x2 y2 dodoc pt) 
(defun wtxt (txt p ang) (vl-load-com)
(entmakex (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 1 txt) (cons 10 p) 
(cons 11 p) (cons 72 1) (cons 73 2) (cons 40 ht) (cons 50 ang))) ) ;;;;;
(princ "\nChon cac doi tuong Line or Pline khong co Arc...")
(setq ss (ssget '((0 . "Line,lwpolyline"))))
(setq x (getreal "\n Nhap ty le theo truc x: ") y (getreal "\n Nhap ty le theo truc y: ")
ht (getreal "\n Hay nhap chieu cao text: ") 
h (getreal "\n Hay nhap khoang cach tu text toi pline: ") h (+ (/ ht 2) h))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object ent))
(cond ((eq (vla-get-ObjectName obj) "AcDbPolyline")
(setq i 0 m (vlax-curve-getendparam ent))
(while (< i m) (setq sp (vlax-curve-getPointatparam ent i)
ep (vlax-curve-getPointatparam ent (1+ i)) ang (angle sp ep) x1 (car sp) y1 (cadr sp)
x2 (car ep) y2 (cadr ep)) (if (/= (car sp) (car ep)) (setq dodoc (* (abs (/ (/ (- y2 y1) y) 
(/ (- x2 x1) x)))) dodoc (strcat (rtos dodoc 2 2))) (setq dodoc (rtos (/ pi 2) 2 2)) )
(cond ((< (car sp) (car ep)) (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
(wtxt dodoc (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) ang) ) 
((> (car sp) (car ep)) (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
(wtxt dodoc (list (+ (car pt) (* h (sin ang))) (- (cadr pt) (* h (cos ang)))) (+ pi ang)) )
((equal (car sp) (car ep) 1e-3) (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
(wtxt dodoc (list (+ (car pt) h) (cadr pt)) (/ pi 2)) ))
(setq i (1+ i)) ))
(T (setq sp (vlax-get obj 'StartPoint)
ep (vlax-get obj 'EndPoint) ang (angle sp ep) x1 (car sp) y1 (cadr sp)
x2 (car ep) y2 (cadr ep) pt (mapcar '(lambda (a b) (/ (+ a b) 2.)) sp ep)) 
(if (/= (car sp) (car ep)) (setq dodoc (* (abs (/ (/ (- y2 y1) y) 
(/ (- x2 x1) x)))) dodoc (strcat (rtos dodoc 2 2))) (setq dodoc (rtos (/ pi 2) 2 2)) )
(cond ((< (car sp) (car ep)) 
(wtxt dodoc (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) ang) )
((equal (car sp) (car ep) 1e-3) (wtxt dodoc (list (+ (car pt) h) (cadr pt)) (/ pi 2)) ) 
((wtxt dodoc (list (+ (car pt) (* h (sin ang))) (- (cadr pt) (* h (cos ang)))) (+ pi ang)) )))))
(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
hihi.hehe    3

 

Test thử cho ý kiến  :) :

hehe, chuẩn đúng ý muốn của mình rồi. Cám ơn bạn nhiều nhé. Thế nếu mình muốn số nó ra là %, với cả tăng số chữ số sau dấu phẩy, thì cần chỉnh sửa ntn.

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
pphung183    425

Thôi thì bạn tự mò chỗ này nha :D có số % hai số lẻ thập phân :

(if (/= (car sp) (car ep)) (setq dodoc (* (abs (/ (/ (- y2 y1) y)

(/ (- x2 x1) x 100)))) dodoc (strcat (rtos dodoc 2 2) (chr 37)))

(setq dodoc (strcat (rtos (/ pi 2 0.01) 2 2) (chr 37))) )

  • 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
hihi.hehe    3

Thôi thì bạn tự mò chỗ này nha :D có số % hai số lẻ thập phân :

(if (/= (car sp) (car ep)) (setq dodoc (* (abs (/ (/ (- y2 y1) y)

(/ (- x2 x1) x 100)))) dodoc (strcat (rtos dodoc 2 2) (chr 37)))

(setq dodoc (strcat (rtos (/ pi 2 0.01) 2 2) (chr 37))) )

cám ơn bạn nhé, bạn nhiệt tình quá  :wub:  :wub:

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

Đăng nhập để thực hiện theo  

×