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

[Yêu cầu] Lisp chọn đối tượng theo chiều dài (tương tự qselect)

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

gachick87    0

Chọn nhanh các đối tượng theo chiều dài của đối tượng:

Đầu vào: line, pline

Hỏi chọn: Phương pháp lựa chọn: Equal / Greater/ Less

Nhập thông số chiều dài L mong muốn chọn làm mốc vào

Kết quả chọn được đối tượng bằng / Lớn hơn / Nhỏ hơn chiều dài L đã nhập.

Minh họa: (mình tô màu cho đối tượng trong hình để phân biệt chứ không có mong muốn thay đổi j - chỉ cần chọn đối tượng thôi)

1-2.jpg

 

Các bác giúp em với, em thanks các bác nhiều 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
BOYMHANGHEO    0

anh em cho tôi hỏi, lệnh qselect không lọc được đối tượng theo chiều dài thì có cách nào thay thế hoặc khắc phục để lọc được các đối tượng theo chiều dài không

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
thanhduan2407    227

Bạn tham khảo code

;;;(Alert (strcat "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLN "
;;;	       "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i  b?ng v\U+1EDBi gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLTCD"
;;;	       "\n X\U+00F3a Line c\U+00F3 \U+0111\U+1EC9nh n?m tr\U+00EAn Polyline: XLTPL"
;;;	)
;;;)
;;;(Prompt (strcat "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLN "
;;;	       "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i  b?ng v\U+1EDBi gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLTCD"
;;;	       "\n X\U+00F3a Line c\U+00F3 \U+0111\U+1EC9nh n?m tr\U+00EAn Polyline: XLTPL"
;;;	)
;;;)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:XLN( / ss L e );;;Xoa line ngan
(or *KCNGAN* (setq *KCNGAN* 1.0))
(setq KCNGAN (getdist (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n s\U+1EBD b\U+1ECB x\U+00F3a:  <"
		  (rtos *KCNGAN* 2 2)
		 ">:  "
	  )
 )
)
(if (not KCNGAN) (setq KCNGAN *KCNGAN*) (setq *KCNGAN* KCNGAN))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(setq n 0)
(foreach e (LM:ss->ent ss)
    (if (< (length1 e) KCNGAN)
      	(progn
        	(setq n (+ n 1))
        	(entdel e)
	)
    )
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3: " (rtos n 2 0) " c\U+1EA1nh b\U+1ECB x\U+00F3a"))
(princ)
)

(defun C:XLD( / ss L e );;;Xoa line ngan
(or *KCDAI* (setq *KCDAI* 1.0))
(setq KCDAI (getdist (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i l\U+1EDBn h\U+01A1n s\U+1EBD b\U+1ECB x\U+00F3a:  <"
		  (rtos *KCDAI* 2 2)
		 ">:  "
	  )
 )
)
(if (not KCDAI) (setq KCDAI *KCDAI*) (setq *KCDAI* KCDAI))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(setq n 0)
(foreach e (LM:ss->ent ss)
    (if (> (length1 e) KCDAI)
      	(progn
        	(setq n (+ n 1))
        	(entdel e)
	)
    )
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3: " (rtos n 2 0) " c\U+1EA1nh b\U+1ECB x\U+00F3a"))
(princ)
)


(defun C:XLTCD( / ss L e);;;Xoa line theo chieu dai
(setq KC (getdist "\nNhap chieu dai LINE: "))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(foreach e (LM:ss->ent ss)
    (if (equal (length1 e) KC 0.01)
        (entdel e)
    )
)
(princ)
)



(defun c:XLTPL();;;xoa line tren Pline
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
(Alert "\nQuet chon Line")
(setq ss (ssget '((0 . "LINE"))))
(setq LtsEnameLine (LM:ss->ent ss))
(foreach EnameL LtsEnameLine
	(setq P1 (cdr (assoc 10 (entget EnameL))))
  	(setq P2 (cdr (assoc 11 (entget EnameL))))
	(setq PVG1 (vlax-curve-getClosestPointTo obj P1 T))
	(setq PVG2 (vlax-curve-getClosestPointTo obj P2 T))
  	(if (or  (equal P1 PVG1 0.0001)  (equal P2 PVG1 0.0001))
	    (entdel EnameL)
	)
)
(princ)
)



(defun C:CPL( / ss L e);;Chon Pline
(MakeLayer_ "PlVang" 2)
(or *KC* (setq *KC* 10.0))
(setq KC (getreal (strcat "\nNhap chieu dai: <"
			  (rtos *KC* 2 2)
			 "> :"
		  )
	 )
)
(if (not KC) (setq KC *KC*) (setq *KC* KC))

(setq
    ss (ssget  (list (cons 0 "*POLYLINE,LWPOLYLINE,LINE")(cons 62 2 )))
    L 0.0
)
(vl-load-com)
(foreach e (LM:ss->ent ss)
    (if (> (length1 e) KC)
        (PUTLAYER e "PlVang")
    )
)
(princ)
)

(defun MakeLayer_ ( name colour /)
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

(defun PUTLAYER (ent NameLayer / s)
   (setq s (vlax-ename->vla-object ent) )
   (vla-put-layer s NameLayer )
)

(defun LM:ss->ent ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (ssname ss (setq i (1- i))) l))
        )
    )
)
  • 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
BOYMHANGHEO    0

 

Bạn tham khảo code

;;;(Alert (strcat "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLN "
;;;	       "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i  b?ng v\U+1EDBi gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLTCD"
;;;	       "\n X\U+00F3a Line c\U+00F3 \U+0111\U+1EC9nh n?m tr\U+00EAn Polyline: XLTPL"
;;;	)
;;;)
;;;(Prompt (strcat "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLN "
;;;	       "\n X\U+00F3a Line c\U+00F3 chi\U+1EC1u d\U+00E0i  b?ng v\U+1EDBi gi\U+00E1 tr\U+1ECB nh\U+1EADp v\U+00E0o: XLTCD"
;;;	       "\n X\U+00F3a Line c\U+00F3 \U+0111\U+1EC9nh n?m tr\U+00EAn Polyline: XLTPL"
;;;	)
;;;)
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:XLN( / ss L e );;;Xoa line ngan
(or *KCNGAN* (setq *KCNGAN* 1.0))
(setq KCNGAN (getdist (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i nh\U+1ECF h\U+01A1n s\U+1EBD b\U+1ECB x\U+00F3a:  <"
		  (rtos *KCNGAN* 2 2)
		 ">:  "
	  )
 )
)
(if (not KCNGAN) (setq KCNGAN *KCNGAN*) (setq *KCNGAN* KCNGAN))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(setq n 0)
(foreach e (LM:ss->ent ss)
    (if (< (length1 e) KCNGAN)
      	(progn
        	(setq n (+ n 1))
        	(entdel e)
	)
    )
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3: " (rtos n 2 0) " c\U+1EA1nh b\U+1ECB x\U+00F3a"))
(princ)
)

(defun C:XLD( / ss L e );;;Xoa line ngan
(or *KCDAI* (setq *KCDAI* 1.0))
(setq KCDAI (getdist (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i l\U+1EDBn h\U+01A1n s\U+1EBD b\U+1ECB x\U+00F3a:  <"
		  (rtos *KCDAI* 2 2)
		 ">:  "
	  )
 )
)
(if (not KCDAI) (setq KCDAI *KCDAI*) (setq *KCDAI* KCDAI))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(setq n 0)
(foreach e (LM:ss->ent ss)
    (if (> (length1 e) KCDAI)
      	(progn
        	(setq n (+ n 1))
        	(entdel e)
	)
    )
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3: " (rtos n 2 0) " c\U+1EA1nh b\U+1ECB x\U+00F3a"))
(princ)
)


(defun C:XLTCD( / ss L e);;;Xoa line theo chieu dai
(setq KC (getdist "\nNhap chieu dai LINE: "))
(setq
    ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
    L 0.0
)
(vl-load-com)
(foreach e (LM:ss->ent ss)
    (if (equal (length1 e) KC 0.01)
        (entdel e)
    )
)
(princ)
)



(defun c:XLTPL();;;xoa line tren Pline
(setq obj (vlax-ename->vla-object (car (entsel "\nChon Line hoac Polyline:"))))
(Alert "\nQuet chon Line")
(setq ss (ssget '((0 . "LINE"))))
(setq LtsEnameLine (LM:ss->ent ss))
(foreach EnameL LtsEnameLine
	(setq P1 (cdr (assoc 10 (entget EnameL))))
  	(setq P2 (cdr (assoc 11 (entget EnameL))))
	(setq PVG1 (vlax-curve-getClosestPointTo obj P1 T))
	(setq PVG2 (vlax-curve-getClosestPointTo obj P2 T))
  	(if (or  (equal P1 PVG1 0.0001)  (equal P2 PVG1 0.0001))
	    (entdel EnameL)
	)
)
(princ)
)



(defun C:CPL( / ss L e);;Chon Pline
(MakeLayer_ "PlVang" 2)
(or *KC* (setq *KC* 10.0))
(setq KC (getreal (strcat "\nNhap chieu dai: <"
			  (rtos *KC* 2 2)
			 "> :"
		  )
	 )
)
(if (not KC) (setq KC *KC*) (setq *KC* KC))

(setq
    ss (ssget  (list (cons 0 "*POLYLINE,LWPOLYLINE,LINE")(cons 62 2 )))
    L 0.0
)
(vl-load-com)
(foreach e (LM:ss->ent ss)
    (if (> (length1 e) KC)
        (PUTLAYER e "PlVang")
    )
)
(princ)
)

(defun MakeLayer_ ( name colour /)
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

(defun PUTLAYER (ent NameLayer / s)
   (setq s (vlax-ename->vla-object ent) )
   (vla-put-layer s NameLayer )
)

(defun LM:ss->ent ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (ssname ss (setq i (1- i))) l))
      

bác có lip nào lọc được thanh theo chiều dài bằng 1 giá tri cụ thể không cho em xin với

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


×