Đến nội dung


Hình ảnh
- - - - -

[Yêu Cầu]Lisp thay thế donut


  • Please log in to reply
3 replies to this topic

#1 quan08

quan08

    biết vẽ pline

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

Đã gửi 19 August 2011 - 08:08 PM

Trên bản vẽ mình có 2 loại donut,loại 1 có đường kính 100,loại 2 đường kính 50,mỗi loại có số lượng rất nhiều.Nhờ các bác viết giùm lisp,khi đánh lệnh sẽ kêu chọn donut chuẩn sau đó chọn donut cần thay thế,khi chọn xong thì tất cả các donut cần thay thế sẽ bị xoá đi và thay vào đó là donut chuẩn và vẫn giữ nguyên tâm của của donut đã bị thay thế.Thanks.
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 19 August 2011 - 08:46 PM

Đây bạn.Mình ngại Entmod hoặc entmake, tốt nhất là copy.
(defun c:test (/ lstVar lstVal dump)
(setq lstVar '("osmode" "cmdecho")
lstVal (mapcar 'getvar lstVar)
dump (mapcar 'setvar lstVar '(0 0))
)
(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons e l))
)
)
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
((lambda (ename ss / basePnt )
(setq basePnt (ST:Geom-Center ename))
(foreach en (ST:Ss->ListEnt ss)
(command ".copy" ename "" basePnt (ST:Geom-Center en))
(entdel en)
)
)
(car(entsel "\nDonut mau :"))(ssget))
(mapcar 'setvar lstVar lstVal)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 quan08

quan08

    biết vẽ pline

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

Đã gửi 19 August 2011 - 08:53 PM

Mình ngại Entmod hoặc entmake, tốt nhất là copy.

Ý này là gì vậy bạn?
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 19 August 2011 - 09:00 PM

Câu đấy để bạn hiểu nguyên lý làm việc của lisp là copy donut mẫu vào vị trí các donut chọn, rồi xóa donut chọn, chứ không phải là tạo 1 donut mới tại vị trí các donut chọn, hoặc sửa lại bán kính ở các donut chọn :lol:
P/s : quên mất vừa nãy không lọc đối tượng cho bạn. Vì donut là 1 PLine đặc biệt nên có khi hơi hài hước nhỉ ^^
(defun c:test (/ lstVar lstVal dump)
(setq lstVar '("osmode" "cmdecho")
lstVal (mapcar 'getvar lstVar)
dump (mapcar 'setvar lstVar '(0 0))
)
(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons e l))
)
)
(defun ST:Geom-Center (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(mapcar '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
)
((lambda (ename ss / basePnt )
(setq basePnt (ST:Geom-Center ename))
(foreach en (ST:Ss->ListEnt ss)
(command ".copy" ename "" basePnt (ST:Geom-Center en))
(entdel en)
)
)
(car(entsel "\nDonut mau :"))(ssget (list (cons 0 "LWPOLYLINE")(cons 90 2)(cons 70 1))))
(mapcar 'setvar lstVar lstVal)
)

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC