Chuyển đến nội dung
Diễn đàn CADViet
Hữu Nhân

Nhờ viết lisp

Bởi Hữu Nhân , trong AutoLisp

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

Hữu Nhân    0

Hữu Nhân
Đã đăng

Chào các anh,

Em muốn nhờ các anh viết dùm lisp vẽ hình chữ nhật bao quanh đa giác.

Bắt đầu lệnh bằng cách click vào diện tích đa giác.

Sau đó vẽ và xuất  1 kích thước theo phương thẳng đứng Y như hình vẽ thôi.

Em mới tham gia diễn đàn à, có gì sai sót mong các anh góp ý. Xin cảm ơn ạ.

image.png.baa03247b3ad984251dbefa8d655bfbc.png

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
8 giờ trước, Hữu Nhân đã nói:

Chào các anh,

Em muốn nhờ các anh viết dùm lisp vẽ hình chữ nhật bao quanh đa giác.

Bắt đầu lệnh bằng cách click vào diện tích đa giác.

Sau đó vẽ và xuất  1 kích thước theo phương thẳng đứng Y như hình vẽ thôi.

Em mới tham gia diễn đàn à, có gì sai sót mong các anh góp ý. Xin cảm ơn ạ.

image.png.baa03247b3ad984251dbefa8d655bfbc.png

Cái này bạn xem có được không nhé!! 

(defun c:test ( / ent )
    (if (setq ent (car (entsel)))
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object ent)))
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)
;; Bounding Box  -  Lee Mac
;; Returns the point list describing the rectangular frame bounding the supplied object.
;; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

 

  • 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ữu Nhân    0

Hữu Nhân
Đã đăng
7 giờ trước, huunhantvxdts đã nói:

Cái này bạn xem có được không nhé!! 


(defun c:test ( / ent )
    (if (setq ent (car (entsel)))
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object ent)))
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)
;; Bounding Box  -  Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

 

Hi anh, anh có thể chỉnh lại cách thức input là getpoint trong diện tích của đa giác kín được không anh.

Cám ơn anh 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

huunhantvxdts    195

huunhantvxdts
Đã đăng
5 giờ trước, Hữu Nhân đã nói:

Hi anh, anh có thể chỉnh lại cách thức input là getpoint trong diện tích của đa giác kín được không anh.

Cám ơn anh rất nhiều.

Của bạn đây nhé: 

(defun c:test ( / point entold et entnew)
(setq point (getpoint "\nPick diem trong vung kin"))
(while point
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "_.-boundary" point "")
   (setq et (entlast))
   (setq entnew (cdr (assoc 5 (entget (entlast)))))
    (if (/= entold entnew) 
	(progn
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))
            )
        )
		(entdel et)
		(setq point (getpoint "\n Chon diem tiep theo: "))
	)
	(progn
	(princ "chon diem sai")
	(setq point (getpoint "\n Chon diem tiep theo: "))
	)
    )
)	
(princ)
)
(vl-load-com) (princ)
;; Bounding Box  -  Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

 

  • 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ữu Nhân    0

Hữu Nhân
Đã đăng
1 giờ trước, huunhantvxdts đã nói:

Của bạn đây nhé: 


(defun c:test ( / point entold et entnew)
(setq point (getpoint "\nPick diem trong vung kin"))
(while point
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "_.-boundary" point "")
   (setq et (entlast))
   (setq entnew (cdr (assoc 5 (entget (entlast)))))
    (if (/= entold entnew) 
	(progn
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))
            )
        )
		(entdel et)
		(setq point (getpoint "\n Chon diem tiep theo: "))
	)
	(progn
	(princ "chon diem sai")
	(setq point (getpoint "\n Chon diem tiep theo: "))
	)
    )
)	
(princ)
)
(vl-load-com) (princ)
;; Bounding Box  -  Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

 

Cám ơn anh nhiều ạ <3

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

quansla    259

quansla
Đã đăng

(setq point (getpoint "\nPick diem trong vung kin")) 

(setq point (getpoint "\nPick diem trong vung kin"))

Chủ thớt không thích "sờ" nên đành chuyển sang "nhấp nhấp píck píck" vùng kín

yêu thương ghê

  • Like 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

huunhantvxdts    195

huunhantvxdts
Đã đăng
55 phút trước, quansla đã nói:

(setq point (getpoint "\nPick diem trong vung kin"))

  • cadvietlisp.lsp
    lisp help
  •   

(setq point (getpoint "\nPick diem trong vung kin"))

Chủ thớt không thích "sờ" nên đành chuyển sang "nhấp nhấp píck píck" vùng kín

yêu thương ghê

Hướng dẫn cụ thể như vậy rồi nhưng nhiều lúc vẫn không làm được đấy bạn (do các đường đang hở) rồi lại bảo sao không vẽ được đường bao

  • 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

ngokiet    169

ngokiet
Đã đăng 
(defun c:test ( / point et)
  (setq point (getpoint "\nPick diem trong vung kin"))
  (while point
    (if (setq et (bpoly point))
      (progn
        (entmake
            (append
               '((000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1))
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))))
	(entdel et)))
    (setq point (getpoint "\n Chon diem tiep theo: ")))
  (princ))
(vl-load-com) 
;; Bounding Box  -  Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj - [vla] VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)
(princ)

Mình nghĩ nên làm thế này dễ hơn là sài Entlast và command vì lisp có lệnh bpoly.

Còn lệnh command boundary thì đôi khi nó có nhiều hơn 1 vùng kín phía trong nên có thể tạo ra nhiều hơn 1 pl. Và lệnh bpoly nó trả về được pl nó tạo ra luôn. Đồng thời thông báo nếu ko kín luôn.

 

  • Like 2
  • 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

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
×