Đến nội dung


Hình ảnh
- - - - -

[Nhờ viết lisp] offset tự động


  • Please log in to reply
26 replies to this topic

#1 prute

prute

    biết zoom

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

Đã gửi 21 June 2012 - 09:25 AM

Em có 1 bản vẽ gồm nhiều đối tượng kín (vd: hình tròn, elip, hình vuông ...), em muốn lisp tự động offset theo hướng vào bên trong đối tượng, khoảng cách offset là cố định trong lisp(không cần yêu cầu nhập khoảng cách) và xoá đối tượng cũ đi.
Tóm lại mình sẽ chỉ phải chọn đối tượng và lisp sẽ tự động offset, không hiện một yêu cầu nào cả.
Các anh giúp em vấn đề này nhé. Thanks trước.
  • 0

#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 21 June 2012 - 11:34 AM

Lisp offset tất cả các đối tượng kín được chọn vào phía bên trong đối tượng, với cùng 1 khoảng cách offset.

;Doan Van Ha - CADViet.com - Ngay 21/6/2012
;Muc dich: Offset tat ca doi tuong vao ben trong voi 1 khoang cach co dinh, va xoa tat ca doi tuong cu.
(defun C:HA ( / ss )
(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0)
(or *stp* (setq *stp* 10.0))
(setq stp (getint (strcat "\nKhoang cach Offset <" (rtos *stp* 2) ">: ")))
(if (not stp) (setq stp *stp*) (setq *stp* stp))
(princ "\nChon cac hinh kin can Offset...")
(setq ss (ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE"))))
(foreach obj (HA:ss->vla ss)
(command "offset" *stp* (vlax-vla-object->ename obj) (HA:CenCur obj) ""))
(command "erase" ss "")
(setvar "cmdecho" cmd) (setvar "osmode" osm) (command "undo" "end") (princ))
(defun HA:CenCur (obj / ttc)
(cond
((= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "REGION")
(setq ttc (vlax-get obj 'Centroid)))
((wcmatch (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")
(setq ttc (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj))) 'Centroid))
(entdel (entlast))))
ttc)
(defun HA:ss->vla (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)))))

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

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 June 2012 - 12:16 PM

@OP : Title topic sai quy định
@ Bác Hạ :
- *dynOff của bác chưa có ^^ (typo)
- Tâm có thể nằm ngoài đối tượng
- Đối tượng kín OP yêu cầu thì có Area
=>

(defun c:test ()
(cond ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or *dist (setq *dist 100))
(setq *dist (cond ((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">")))(*dist)))
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(mapcar 'vla-delete
(cdr
(vl-sort
(list (car(vlax-invoke obj 'Offset *dist)) obj (car (vlax-invoke obj 'Offset (- *dist))))
'(lambda(x y)(< (vlax-get x 'Area)(vlax-get y 'Area)))
)
)
)
)
)(T (princ "\nNo thing to do"))
)(princ)
)

  • 2

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


#4 prute

prute

    biết zoom

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

Đã gửi 21 June 2012 - 01:01 PM

cảm ơn 2 anh đã giúp đỡ. Đúng như yêu cầu của em luôn, hì.
  • 0

#5 prute

prute

    biết zoom

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

Đã gửi 22 June 2012 - 07:47 AM

Hôm qua em làm chỉ có các hình kín, hôm nay em muốn phát triển thêm là trong hình của em có thêm các khác không kín.
--Do hôm qua em nghĩ là nhờ các anh viết cho phần offset còn phần chọn đối tượng kín hay không kin thì em làm được nhưng mà về đọc lisp của anh ketxu thì những lệnh đó em chưa dùng lần nào nên không sửa được.
--Em tính làm theo cách quét tất cả các đối tượng và lưu thông tin vào 1 list sau đó duyệt từng đối tượng 1 để kiểm tra kín và offset nhưng phần chọn đối tượng (ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")) bình thường em thấy hay lưu vào một biến nào đó nhưng mà ở đây em không biết mình chọn đối tượng xong lưu ở đâu.
--Hôm nay nhờ mấy anh giúp em thêm trường hợp đối với nhiều đối tượng trong đó có kín và không kín, ta quét chọn tất cả bản vẽ và lisp sẽ offset những đối tượng kín.
Cảm ơn các anh
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 June 2012 - 09:28 AM

Dòng gán tập chọn chính là dòng này

(vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))

vlax-for obj: duyệt qua tập chọn (giống như foreach), mỗi đối tượng tạm đặt là Obj (đối tượng vla-object))
1. Circle : hiển nhiên kín
2. Ellipse : kín khi startAngle bằng 0
3. *Line : kiểm tra thuộc tính Closed hoặc kiểm tra đỉnh đầu trùng đỉnh cuối (tùy theo nhu cầu của bạn)

Nếu bạn biết chút ít về Vl thì có thể tự làm, nếu không thì bạn chờ các bác sửa hộ cho nhé ^^ Mình hơi bận :)
  • 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


#7 prute

prute

    biết zoom

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

Đã gửi 22 June 2012 - 06:06 PM

chắc phải đợi các anh giúp . ^^ .
  • 0

#8 prute

prute

    biết zoom

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

Đã gửi 22 June 2012 - 10:15 PM

Các anh giúp em nhé!!
- Bản vẽ có nhiều đối tượng ( kín và không kín )
- Em muốn mình chỉ quét chọn tất cả các đối tượng đó 1 lần
- Nếu đối tượng nào kín thì offset hình đó theo hướng bên trong đối tượng một khoảng cố định trong lisp
- Lisp không yêu cầu nhập gì cả
- xoá đối tượng cũ
Chỉ quét chọn đối tượng và nếu kín thì offset thôi
  • 0

#9 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 22 June 2012 - 10:20 PM

Nếu chưa có ai giúp thì ngày mai tôi sẽ cố giúp bạn.
  • 1

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


#10 prute

prute

    biết zoom

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

Đã gửi 22 June 2012 - 10:55 PM

Cảm ơn anh trước. hi
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 June 2012 - 11:36 PM

Quick code, bạn khử biến đi nhé. Đây chỉ là 1 ví dụ mình đưa ra thôi, vì khái niệm bên trong rất khó, nhất là trong các trường hợp đối tượng của bạn phức tạp, giao nhau, hoặc ngoằn nghèo
Ở đây mình chỉ lấy list 3 đối tượng gồm có : gốc, offset -dist, offset + dist, và xóa đi 2 thằng to hơn, giữ lại thằng nhỏ nhất (theo diện tích) - để phù hợp với nhu cầu offset vào "trong" của bạn. Trường hợp method offset sinh ra nhiều hơn 1 đối tượng thì không còn chuẩn nữa, nếu bạn là lispser thì hãy cố gắng xử lý vấn đề này xem sao :)

(defun c:test ()
(cond ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or *dist (setq *dist 100))
(setq *dist (cond ((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">")))(*dist))
isClosed (lambda(x)(cond ((and (= (vla-get-ObjectName x) "AcDbEllipse")(zerop (vla-get-StartAngle x))))
((and (wcmatch (vla-get-ObjectName x) "AcDb*line")
(equal (car (setq sth (acet-geom-vertex-list (vlax-vla-object->ename x))))
(last sth)
0.01
)
)
)
)
)
)
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (isclosed obj)
(mapcar 'vla-delete
(cdr
(vl-sort
(list (car(vlax-invoke obj 'Offset *dist)) obj (car (vlax-invoke obj 'Offset (- *dist))))
'(lambda(x y)(< (vlax-get x 'Area)(vlax-get y 'Area)))
)
)
)
)
))(T (princ "\nNo thing to do"))
)(princ)
)

  • 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


#12 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 June 2012 - 12:17 AM

Ối giời ơi! Cái offset tưởng đơn giản, hoá ra lắm chuyện.
Test trên lisp trước của ket thì nó sinh ra 1 object hở từ 1 object kín?
Test trên lisp sau thì lỗi.
Thằng Spline mà offset rắc rối thật.
  • 1

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


#13 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 June 2012 - 12:26 AM

- PLine và Spline khi Offset có thể sinh ra nhiều hơn 1 đối tượng
- 1 đối tượng kín vẫn có thể Offset ra 1 đối tượng hở ^^
- 1 đối tượng hở từ Spline, Pline vẫn có Area
=> lắm chuyện vui buồn lẫn lộn.
Vui như ở đây
Buồn như trong lisp đo đường bất kỳ hoặc lisp này bác ạ :D
  • 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


#14 prute

prute

    biết zoom

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

Đã gửi 23 June 2012 - 12:47 AM

các anh than làm em hơi choáng váng, hic
  • 0

#15 prute

prute

    biết zoom

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

Đã gửi 23 June 2012 - 12:48 AM

Quick code, bạn khử biến đi nhé. Đây chỉ là 1 ví dụ mình đưa ra thôi, vì khái niệm bên trong rất khó, nhất là trong các trường hợp đối tượng của bạn phức tạp, giao nhau, hoặc ngoằn nghèo
Ở đây mình chỉ lấy list 3 đối tượng gồm có : gốc, offset -dist, offset + dist, và xóa đi 2 thằng to hơn, giữ lại thằng nhỏ nhất (theo diện tích) - để phù hợp với nhu cầu offset vào "trong" của bạn. Trường hợp method offset sinh ra nhiều hơn 1 đối tượng thì không còn chuẩn nữa, nếu bạn là lispser thì hãy cố gắng xử lý vấn đề này xem sao :)


(defun c:test ()
(cond ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or *dist (setq *dist 100))
(setq *dist (cond ((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">")))(*dist))
isClosed (lambda(x)(cond ((and (= (vla-get-ObjectName x) "AcDbEllipse")(zerop (vla-get-StartAngle x))))
((and (wcmatch (vla-get-ObjectName x) "AcDb*line")
(equal (car (setq sth (acet-geom-vertex-list (vlax-vla-object->ename x))))
(last sth)
0.01
)
)
)
)
)
)
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (isclosed obj)
(mapcar 'vla-delete
(cdr
(vl-sort
(list (car(vlax-invoke obj 'Offset *dist)) obj (car (vlax-invoke obj 'Offset (- *dist))))
'(lambda(x y)(< (vlax-get x 'Area)(vlax-get y 'Area)))
)
)
)
)
))(T (princ "\nNo thing to do"))
)(princ)
)

lisp này em chạy thử thì thấy đường tròn không được
  • 0

#16 prute

prute

    biết zoom

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

Đã gửi 23 June 2012 - 12:57 AM

- PLine và Spline khi Offset có thể sinh ra nhiều hơn 1 đối tượng
- 1 đối tượng kín vẫn có thể Offset ra 1 đối tượng hở ^^
- 1 đối tượng hở từ Spline, Pline vẫn có Area
=> lắm chuyện vui buồn lẫn lộn.
Vui như ở đây
Buồn như trong lisp đo đường bất kỳ hoặc lisp này bác ạ :D

vừa xem xong cái mà anh ketxu bảo vui, xem xong không vui tí nào mà hoảng ^^, nghĩ lỡ như mà kết quả sau khi mình chạy cũng như vậy thì toi.
Đối với spline thì vẽ hình kin có lẽ đối với em là hiếm nên các anh có thể bỏ qua luôn cho thuận tiện.
Thanks 2 anh nhé, khuya quá mà vẫn còn giúp, hì.
  • 0

#17 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 June 2012 - 12:57 AM

Thử cái này, dựa vào lisp của anh Ketxu. Có vài khiếm khuyết nhé (như đã phân tích ở trên).

(defun c:test ()
(cond
((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or *dist (setq *dist 100))
(setq *dist
(cond
((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">: ")))
(*dist)))
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (HA:Closed (vlax-vla-object->ename obj))
(mapcar 'vla-delete
(cdr
(vl-sort
(list (car (vlax-invoke obj 'Offset *dist)) obj (car (vlax-invoke obj 'Offset (- *dist))))
'(lambda (x y) (< (vlax-get x 'Area) (vlax-get y 'Area)))))))))
(T (princ "\nNo thing to do")))
(princ))
(defun HA:Closed (ent / data lstP lstS)
(setq data (entget ent)
lstP (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
lstS (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 11)) (entget ent))))
(or
(= "CIRCLE" (cdr (assoc 0 data)))
(and (= "ELLIPSE" (cdr (assoc 0 data))) (= 0 (cdr (assoc 41 data))))
(and
(= (cdr (assoc 0 data)) "LWPOLYLINE")
(or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstP) (last lstP) 1E-8)))
(and
(= (cdr (assoc 0 data)) "SPLINE")
(or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstS) (last lstS) 1E-8)))))

  • 0

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


#18 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 641 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 June 2012 - 01:08 AM

@OP : Title topic sai quy định
@ Bác Hạ :
- *dynOff của bác chưa có ^^ (typo)
- Tâm có thể nằm ngoài đối tượng
- Đối tượng kín OP yêu cầu thì có Area

Em nhớ không nhầm thì có thể dùng hàm ExOffset trong menu Express để làm việc này với việc giữ phím Ctrl khi thực hiện việc nhấp chuột quy định phía offset đối tượng; khi đó nó sẽ del đối tượng cũ đi mà, hơn nữa cách dùng hoàn toàn như lệnh offset của Cad. cho phép lưu layer, thought của lần vẽ trước mà, không cần dùng list đâu ạh
  • 0

#19 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 641 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 June 2012 - 01:11 AM

Anh cho em hỏi em dùng code gì để Cad nhận là người dùng gõ vào Shift hay chuột phải, hay Ctral gì gì đó ạh?
  • 0

#20 prute

prute

    biết zoom

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

Đã gửi 23 June 2012 - 01:29 AM

Thử cái này, dựa vào lisp của anh Ketxu. Có vài khiếm khuyết nhé (như đã phân tích ở trên).


(defun c:test ()
(cond
((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or *dist (setq *dist 100))
(setq *dist
(cond
((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">: ")))
(*dist)))
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (HA:Closed (vlax-vla-object->ename obj))
(mapcar 'vla-delete
(cdr
(vl-sort
(list (car (vlax-invoke obj 'Offset *dist)) obj (car (vlax-invoke obj 'Offset (- *dist))))
'(lambda (x y) (< (vlax-get x 'Area) (vlax-get y 'Area)))))))))
(T (princ "\nNo thing to do")))
(princ))
(defun HA:Closed (ent / data lstP lstS)
(setq data (entget ent)
lstP (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
lstS (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 11)) (entget ent))))
(or
(= "CIRCLE" (cdr (assoc 0 data)))
(and (= "ELLIPSE" (cdr (assoc 0 data))) (= 0 (cdr (assoc 41 data))))
(and
(= (cdr (assoc 0 data)) "LWPOLYLINE")
(or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstP) (last lstP) 1E-8)))
(and
(= (cdr (assoc 0 data)) "SPLINE")
(or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstS) (last lstS) 1E-8)))))

được rồi anh ak. để em test thêm xem sao
  • 0