Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
15 replies to this topic

#1 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 22 November 2015 - 10:50 PM

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 ạ!


  • -1

#2 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 23 November 2015 - 09:31 AM

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

  • 2

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


#3 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 10:14 AM

 

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

  • -1

#4 Hoang Linh08

Hoang Linh08

    Chưa sử dụng CAD

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

Đã gửi 23 November 2015 - 10:54 AM

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.


  • 0

#5 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 11:09 AM

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


  • 0

#6 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 03:18 PM

 

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.


  • 0

#7 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 03:51 PM

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


  • 0

#8 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 03:55 PM

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


  • 0

#9 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 04:10 PM

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.c...-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 :(


  • 0

#10 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 04:21 PM

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


  • 1

#11 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 04:25 PM

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


  • 0

#12 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 04:35 PM

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


  • 1

#13 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 04:48 PM

 

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.


  • 0

#14 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 04:58 PM

Cụ thể là sao? Ex : 52.22% ????


  • 0

#15 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 23 November 2015 - 05:08 PM

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


  • 1

#16 hihi.hehe

hihi.hehe

    biết zoom

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

Đã gửi 23 November 2015 - 10:20 PM

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:


  • 0