Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
meohoang88

Xin lisp vẽ tâm đường tròn

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

Chào các bác. Em có một nhu cầu nhỏ như này mong được các bác giúp đỡ. (em tìm lisp trên diễn đàn rồi nhưng không phù hợp)

 

Em cần 1 lisp vẽ tâm đường tròn.

 

Mô tả yêu cầu của lisp:

- Quét qua được đồng thời nhiều đối tượng là hình tròn (circle)

- Đồng thời hiện tâm của các đường tròn, với điều kiện: chiều dài đường tâm gấp 1.5 lần đường kính.

Ví dụ; Đừờng tròn phi 10, thì chiều dài mỗi đường tâm là 15mm.

-Layer và thuộc tính của đường tâm: là của layer hiện hành.

 

Em xin hết ạ! Rất mong đc các bác chiếu cố! Em xin cảm ơ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
10 phút trước, meohoang88 đã nói:

Chào các bác. Em có một nhu cầu nhỏ như này mong được các bác giúp đỡ. (em tìm lisp trên diễn đàn rồi nhưng không phù hợp)

 

Em cần 1 lisp vẽ tâm đường tròn.

 

Mô tả yêu cầu của lisp:

- Quét qua được đồng thời nhiều đối tượng là hình tròn (circle)

- Đồng thời hiện tâm của các đường tròn, với điều kiện: chiều dài đường tâm gấp 1.5 lần đường kính.

Ví dụ; Đừờng tròn phi 10, thì chiều dài mỗi đường tâm là 15mm.

-Layer và thuộc tính của đường tâm: là của layer hiện hành.

 

Em xin hết ạ! Rất mong đc các bác chiếu cố! Em xin cảm ơn!

 

 

Code nhanh cho bạn:

(defun c:test (/ ent pt r)
  (foreach ent (acet-ss-to-list (ssget (list (cons 0 "CIRCLE"))))
    (command "LINE" "_NON" (polar (setq pt (cdr (assoc 10 (entget ent))))  pi (* 1.5 (setq r (cdr (assoc 40 (entget ent))))))
	     "_NON" (polar pt 0 (* 1.5 r)) "")
    (command "LINE" "_NON" (polar pt (* 0.5 pi) (* 1.5 r)) "_NON" (polar pt (* 1.5 pi) (* 1.5 r)) "")))

 

  • 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
21 giờ trước, Doan Nguyen Van đã nói:

Code nhanh cho bạn:


(defun c:test (/ ent pt r)
  (foreach ent (acet-ss-to-list (ssget (list (cons 0 "CIRCLE"))))
    (command "LINE" "_NON" (polar (setq pt (cdr (assoc 10 (entget ent))))  pi (* 1.5 (setq r (cdr (assoc 40 (entget ent))))))
	     "_NON" (polar pt 0 (* 1.5 r)) "")
    (command "LINE" "_NON" (polar pt (* 0.5 pi) (* 1.5 r)) "_NON" (polar pt (* 1.5 pi) (* 1.5 r)) "")))

 

Em rất cảm ơn bác. Code bác đã đúng ý em. Đã 1 like cho bác!

Tuy nhiên có 1 vấn đề em chưa lường trước. Có lẽ lại nhờ bác chỉnh thêm được ko ạ.

Layer đường tâm thì tất nhiên là em để nét đứt rồi, em đang để với tỉ lệ bản vẽ 1:1 thì linetype scale của đường tâm bằng 0.2.

Như vậy, với tỉ lệ 1:2 thì linetype scale = 0.4

với tỉ lệ 1:4 thì linetype scale = 0.8, .... tương ứng với các tỉ lệ khác, vì em dùng Annotative.

 

Em chỉ muốn bổ sung thêm 1 điều kiện cho lisp này thôi: hệ số linetype scale hiển thị = hệ số linetype scale cài đặt của layer hiện hành (với tỉ lệ 1:1) x giá trị hệ số Annotation Scale hiện hành.

Bác có thể chỉnh lại cho em thêm đúng 1 điều kiện phát sinh này nữa ko ạ? 

 

Em nghĩ lisp này rất nhiều người sẽ cần, đặc biệt cho bên cơ khí. Em xin cảm ơn bác!

 

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
Vào lúc 11/10/2019 tại 22:43, meohoang88 đã nói:

Em rất cảm ơn bác. Code bác đã đúng ý em. Đã 1 like cho bác!

Tuy nhiên có 1 vấn đề em chưa lường trước. Có lẽ lại nhờ bác chỉnh thêm được ko ạ.

Layer đường tâm thì tất nhiên là em để nét đứt rồi, em đang để với tỉ lệ bản vẽ 1:1 thì linetype scale của đường tâm bằng 0.2.

Như vậy, với tỉ lệ 1:2 thì linetype scale = 0.4

với tỉ lệ 1:4 thì linetype scale = 0.8, .... tương ứng với các tỉ lệ khác, vì em dùng Annotative.

 

Em chỉ muốn bổ sung thêm 1 điều kiện cho lisp này thôi: hệ số linetype scale hiển thị = hệ số linetype scale cài đặt của layer hiện hành (với tỉ lệ 1:1) x giá trị hệ số Annotation Scale hiện hành.

Bác có thể chỉnh lại cho em thêm đúng 1 điều kiện phát sinh này nữa ko ạ? 

 

Em nghĩ lisp này rất nhiều người sẽ cần, đặc biệt cho bên cơ khí. Em xin cảm ơn bác!

 

Bạn test xem được chưa, do mình ít dùng ANOTATION

(defun c:test (/ ent pt r lt ca ano)
  (setq lt (getvar 'celtype))
  (command "_-LINETYPE" "S" "CENTER" "")
  (setq ca (Getvar 'CANNOSCALE)
	ano (* (getvar 'CELTSCALE) (/ (atoi (substr ca (+ (vl-string-search ":" ca) 2))) (atoi (substr ca 1 (vl-string-search ":" ca))))))	   
  (foreach ent (acet-ss-to-list (ssget (list (cons 0 "CIRCLE"))))
    (command "LINE" "_NON" (polar (setq pt (cdr (assoc 10 (entget ent))))  pi (* 1.5 (setq r (cdr (assoc 40 (entget ent))))))
	     "_NON" (polar pt 0 (* 1.5 r)) "")
    (vla-put-linetypescale (vlax-ename->vla-object (entlast)) ano )
    (command "LINE" "_NON" (polar pt (* 0.5 pi) (* 1.5 r)) "_NON" (polar pt (* 1.5 pi) (* 1.5 r)) "")
    (vla-put-linetypescale (vlax-ename->vla-object (entlast)) ano))
  (command "_-LINETYPE" "S" lt ""))

 

  • 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
Vào lúc 14/10/2019 tại 09:07, Doan Nguyen Van đã nói:

Bạn test xem được chưa, do mình ít dùng ANOTATION


(defun c:test (/ ent pt r lt ca ano)
  (setq lt (getvar 'celtype))
  (command "_-LINETYPE" "S" "CENTER" "")
  (setq ca (Getvar 'CANNOSCALE)
	ano (* (getvar 'CELTSCALE) (/ (atoi (substr ca (+ (vl-string-search ":" ca) 2))) (atoi (substr ca 1 (vl-string-search ":" ca))))))	   
  (foreach ent (acet-ss-to-list (ssget (list (cons 0 "CIRCLE"))))
    (command "LINE" "_NON" (polar (setq pt (cdr (assoc 10 (entget ent))))  pi (* 1.5 (setq r (cdr (assoc 40 (entget ent))))))
	     "_NON" (polar pt 0 (* 1.5 r)) "")
    (vla-put-linetypescale (vlax-ename->vla-object (entlast)) ano )
    (command "LINE" "_NON" (polar pt (* 0.5 pi) (* 1.5 r)) "_NON" (polar pt (* 1.5 pi) (* 1.5 r)) "")
    (vla-put-linetypescale (vlax-ename->vla-object (entlast)) ano))
  (command "_-LINETYPE" "S" lt ""))

 

Em đã test. Với các bản vẽ bắt đầu vẽ mới thì rất OK bác ạ. Tuyệt vời!

 

Nhưng mà còn với các bản vẽ mà dữ liệu cũ (bản vẽ do em làm từ trước đó) thì đường tâm nó nhảy sai vị trí bác ạ. Nó lại nhảy đi ra chỗ khác, ko biết tại sao. Bác thử test lại hộ em trên máy bác xem có bị giống em ko?

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

Bạn thử cái thuần lisp này xem sao!

(defun c:tt  (/ c e l r s)
  (if (setq s (ssget '((0 . "CIRCLE"))))
    (while (and (setq e (ssname s 0)) (ssdel e s))
      (setq c (trans (cdr (assoc 10 (setq l (entget e)))) 0 1)
            r (cdr (assoc 40 l)))
      (foreach a  '(0 0.5)
        (entmake (list (cons 0 "LINE")
                       (cons 8 (getvar 'clayer))
                       (cons 10 (trans (polar c (* a pi) (* 1.5 r)) 1 0))
                       (cons 11 (trans (polar c (+ pi (* a pi)) (* 1.5 r)) 1 0))
                       (cons 48 (* 0.2 (/ 1 (getvar 'cannoscalevalue)))))))))
  (princ))

  • 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
15 giờ trước, quocmanh04tt đã nói:

Bạn thử cái thuần lisp này xem sao!

(defun c:tt  (/ c e l r s)
  (if (setq s (ssget '((0 . "CIRCLE"))))
    (while (and (setq e (ssname s 0)) (ssdel e s))
      (setq c (trans (cdr (assoc 10 (setq l (entget e)))) 0 1)
            r (cdr (assoc 40 l)))
      (foreach a  '(0 0.5)
        (entmake (list (cons 0 "LINE")
                       (cons 8 (getvar 'clayer))
                       (cons 10 (trans (polar c (* a pi) (* 1.5 r)) 1 0))
                       (cons 11 (trans (polar c (+ pi (* a pi)) (* 1.5 r)) 1 0))
                       (cons 48 (* 0.2 (/ 1 (getvar 'cannoscalevalue)))))))))
  (princ))

Em xin ĐA TẠ bác!

Tuyệt vời bác ạ!

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  

×