Đến nội dung


Hình ảnh
* * * * - 1 Bình chọn

Array đối tượng trong vùng


  • Please log in to reply
55 replies to this topic

#41 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 16 August 2010 - 02:18 PM

Bạn thử cái này xem :
Lisp AIC

Bác thật tuyệt vời.
Cảm ơn bác rất nhiều. Chính xác 100%. Cảm ơn bác.
Bác xem hộ em qua phần chọn đối tượng trong vùng như bác đã diễn đạt bác nhé.
Một lần nữa cảm ơn bác.
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#42 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 16 August 2010 - 05:57 PM

Bạn thử cái này xem :
Lisp AIC

Bác Tue_NV à!
Em có thể hỏi bác một chút được không?
Một số hàm vl-, vlax-.....em không biết tìm kiếm đâu để tra cứu.
Bác có thể send cho em cấu trúc các hàm đó và cách sử dụng được không?
Cụ thể một số hàm trong lisp bác viết như:
(setq ms (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))))
(setq pl (vlax-ename->vla-object (car(entsel "\n Chon Polyline kin :"))))

Ngoài ra còn hàm :

+ (setq minp (safearray-value minp))
+ (setq maxp (safearray-value maxp))
+ (setq line (vla-addline ms (vlax-3d-point minpp)
(vla-get-insertionpoint x)

+ (if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 0)
(vla-erase x)
Bác giải thích cho em các hàm trên bác nhé.
Mong rằng sau mỗi lần hiểu em sẽ vọc thêm được nhiều kiến thức hơn nữa. Cảm ơn bác


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#43 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 17 August 2010 - 10:53 AM

............
Sau khi thử nghiệm cả 3 chương trình (2 của bác Gia_Bach và 1 của bác Tue_NV) thì em đưa ra kết quả sau:
http://www.4shared.c...9/ARRAY_1_.html
Em không có ý so sánh để làm phật lòng bác, như bác nói Mời các bạn chạy thử và góp ý. Xin cảm ơn.
..........

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.
Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.


Bạn thử cái này xem :
Lisp AIC

Chào Tue_NV!
Lisp's level của Tue_NV cao quá trời.
Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :
Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)
Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool
VD :
Hình đã gửi

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)
1. kiểm tra CAD có cài đặt Express Tool.
(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :
(foreach x ssa
(setq line (vla-addline ms (vlax-3d-point minpp)
(vla-get-insertionpoint x) ) )
; ...
;update thanh trang thai
(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :
(if Express (setq ProgBar (acet-ui-progress)))


Update LISP : Copy Block trong đuờng bao Pline kín.
(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)

(defun *error* (msg)
(and Express ProgBar (acet-ui-progress))
(and ov (mapcar 'setvar vl ov))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))

(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))

(setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

(or *dis* (setq *dis* 10))
(initget 6)
(setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
(if dis (setq *dis* dis) (setq dis *dis*) )

(setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
(vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

(setq start (getvar "MILLISECS"))
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

(while (< (cadr pt) (cadr maxpt))
(while (< (car pt) (car maxpt))
(if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
(setq pt (polar pt 0 dis)))
(setq pt (polar minpt (/ pi 2.0) (* i (/ dis 2)))
i (1+ i) )
(if (= (rem i 2)0)
(setq pt (polar pt 0 (/ dis 2))))
(if Express (acet-ui-progress -1)) )
(if Express (setq ProgBar (acet-ui-progress)))

(setq time (/ (- (getvar "MILLISECS") start) 1000.0))
(princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
(mapcar 'setvar vl ov)
(princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
(setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
(if (equal ClosestPoint pt 1e-6)
(setq flag nil)
(progn
(setq flag (and (setq int (vlax-invoke
(setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
'IntersectWith Obj 0))
(= (rem (length int) 2) 1)) )
(vla-delete lin)) )
flag)

  • 1

#44 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 17 August 2010 - 11:26 AM

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.
Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.
Chào Tue_NV!
Lisp's level của Tue_NV cao quá trời.
Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :
Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)
Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool
VD :
Hình đã gửi

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)
1. kiểm tra CAD có cài đặt Express Tool.
(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :
(foreach x ssa
(setq line (vla-addline ms (vlax-3d-point minpp)
(vla-get-insertionpoint x) ) )
; ...
;update thanh trang thai
(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :
(if Express (setq ProgBar (acet-ui-progress)))
Update LISP : Copy Block trong đuờng bao Pline kín.

(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)

(defun *error* (msg)
(and Express ProgBar (acet-ui-progress))
(and ov (mapcar 'setvar vl ov))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))

(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))

(setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

(or *dis* (setq *dis* 10))
(initget 6)
(setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
(if dis (setq *dis* dis) (setq dis *dis*) )

(setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
(vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

(setq start (getvar "MILLISECS"))
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

(while (< (cadr pt) (cadr maxpt))
(while (< (car pt) (car maxpt))
(if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
(setq pt (polar pt 0 dis)))
(setq pt (polar minpt (/ pi 2.0) (* i (/ dis 2)))
i (1+ i) )
(if (= (rem i 2)0)
(setq pt (polar pt 0 (/ dis 2))))
(if Express (acet-ui-progress -1)) )
(if Express (setq ProgBar (acet-ui-progress)))

(setq time (/ (- (getvar "MILLISECS") start) 1000.0))
(princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
(mapcar 'setvar vl ov)
(princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
(setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
(if (equal ClosestPoint pt 1e-6)
(setq flag nil)
(progn
(setq flag (and (setq int (vlax-invoke
(setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
'IntersectWith Obj 0))
(= (rem (length int) 2) 1)) )
(vla-delete lin)) )
flag)

Cảm ơn bác Gia_Bach rất nhiều. Lisp của bác chạy rất ổn và thêm một phần trực quan khi chương trình đang chạy (tránh tình trạng nghĩ máy bị đơ).
Cám ơn bác nhiều.
Đến khi nào em mới được bằng các bác đây. Em sẽ cố gắng học hỏi, mong các bác giúp đỡ. Cảm ơn các bác rất nhiều
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#45 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 19 August 2010 - 03:36 PM

Bạn thử cái này xem :
Lisp AIC

Sau khi thành công trong việc array trong vùng kín của bác, em rất vui và càng cảm thấy hăng say tham gia vào diến đàn tìm kiếm cái mới. Mong bác Tue_NV lúc nào rảnh thì xem qua bài viết của em đã gửi cho bác vì em chờ đợi câu trả lời của bác từng ngày. Em nghĩ là bác bận nên chưa thể ghé qua thăm diễn đàn. Mong bác ghé thăm. Cảm ơn bác rất nhiều.
Vấn đề của em vẫn là chọn những đối tượng được lọc trước trong vùng kín mà bác đã từng nêu .
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#46 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 20 August 2010 - 12:29 PM

Mọi góp ý đều đuợc hoan nghênh. Cám ơn thanhduan2407 nhiều.
Do mới tập tành viết .NET, nên chỉ đúng cho truờng hợp đuờng bao là đa giác lồi.
Chào Tue_NV!
Lisp's level của Tue_NV cao quá trời.
Xin chúc mừng! :D

LISP AIC chạy rất tốt, chỉ xin bổ sung phần thông báo trực quan :
Trong truờng hợp 1 Lisp chạy quá lâu (VD: lớn hơn 10 giây) thông thuờng CAD cũng không có thông báo là Lisp đang chạy, nguời sử dụng đôi khi nghĩ rằng Cad bị treo (Not responding) và họ ra quyết định ... bấm phím ESC (tèn ten : công toi)
Để tạo 1 thông báo trực quan, chúng ta có thể sử dụng hàm acet-ui-progress của Express Tool
VD :
Hình đã gửi

Cách sử dụng : (minh họa với Lisp AIC của Tue_NV)
1. kiểm tra CAD có cài đặt Express Tool.
(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

2. Khởi động thanh trạng thái truớc khi gọi hàm sử lý xóa đối tuợng:
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang xoa doi tuong ..." (sslength ssa))))

3. Trong vòng lặp xóa đối tuợng, cập nhật thanh trạng thái :
(foreach x ssa
(setq line (vla-addline ms (vlax-3d-point minpp)
(vla-get-insertionpoint x) ) )
; ...
;update thanh trang thai
(if Express (acet-ui-progress -1)) )

4. Giải phóng thanh trạng thái khi kết thúc vòng lặp :
(if Express (setq ProgBar (acet-ui-progress)))
Update LISP : Copy Block trong đuờng bao Pline kín.

(defun c:CopyBlk (/ baseCur basePt blk blkObj cur curObj dis i maxpt minpt ov pt vl doc spc start time)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)

(defun *error* (msg)
(and Express ProgBar (acet-ui-progress))
(and ov (mapcar 'setvar vl ov))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))

(setq Express (and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down))))))))

(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE

(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))

(setq blk (car (entsel "\nChon Block :"))
blkObj (vlax-ename->vla-object blk)
basePt (cdr (assoc 10 (entget blk))))

(or *dis* (setq *dis* 10))
(initget 6)
(setq dis (getdist (strcat "\nKhoang cach <" (rtos *dis*) "> :")))
(if dis (setq *dis* dis) (setq dis *dis*) )

(setq cur (car (entsel "\nChon Pline :"))
curObj (vlax-ename->vla-object cur))
(vla-GetBoundingBox (vlax-ename->vla-object cur) 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
minpt (polar minpt (/ pi 4) (/ dis 4))
baseCur (polar minpt (/ pi 4) (/ dis -4))
pt minpt
i 1)

(setq start (getvar "MILLISECS"))
(if Express (setq ProgBar (acet-ui-progress "Vui long doi ! Dang tinh toan ..." (fix(/ (- (cadr maxpt) (cadr minpt))dis)))))

(while (< (cadr pt) (cadr maxpt))
(while (< (car pt) (car maxpt))
(if (insidep pt curObj baseCur)
(vla-move (vla-copy blkObj) (vlax-3D-point basePt) (vlax-3D-point pt)))
(setq pt (polar pt 0 dis)))
(setq pt (polar minpt (/ pi 2.0) (* i (/ dis 2)))
i (1+ i) )
(if (= (rem i 2)0)
(setq pt (polar pt 0 (/ dis 2))))
(if Express (acet-ui-progress -1)) )
(if Express (setq ProgBar (acet-ui-progress)))

(setq time (/ (- (getvar "MILLISECS") start) 1000.0))
(princ (strcat "Thoi gian thuc hien (giay) : " (rtos time)))
(mapcar 'setvar vl ov)
(princ))

(defun insidep (pt Obj basePt / flag int lin ClosestPoint)
(setq ClosestPoint (vlax-curve-getClosestPointTo obj pt))
(if (equal ClosestPoint pt 1e-6)
(setq flag nil)
(progn
(setq flag (and (setq int (vlax-invoke
(setq lin(vla-addLine spc (vlax-3D-point pt) (vlax-3D-point basePt)))
'IntersectWith Obj 0))
(= (rem (length int) 2) 1)) )
(vla-delete lin)) )
flag)

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!
  • 0

#47 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 20 August 2010 - 12:56 PM

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!

cám ơn thiep.

do yêu cầu của thanhduan2407, lisp chỉ quan tâm đến điểm chèn của Block (Insert Point), nên có hiện tuợng như thiep đã đề cập.
Đúng như đề nghị của thiep , để khắc phục cần cập nhật hàm insidep với đ/kiện là xét giao giữa đuờng bao của Block với Curve.

Chúc bác mạnh khỏe, và thuờng xuyên ghé Cadviêt giúp mọi nguời. :D
  • 0

#48 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 25 August 2010 - 04:34 PM

Chào bác giabach, lisp của bác thật tuyệt, nhưng vẫn có 1 lỗi nhỏ là nó không xóa sạch những block được tạo ra thêm ở ngoài đướng bao khi chạy lisp, ngoài ra nó còn xóa 1 vài block bên trong đường bao. Bác cứ thử lisp khi đường bao là 1 đa giác lõm và khoảng cách các block được tạo là tương đối nhỏ thì sẽ thấy. Có lẽ lỗi do cái hàm insidep thì phải. Lâu quá mới vào diễn đàn, lúc rày thiep bận việc quá. Chúc bác khỏe!

Kết quả sai trong trường hợp đường cong có arc cho dù đường cong lồi hay lõm.
Thực ra lỗi là ở hàm vla-GetBoundingBox
Nếu đường cong có arc thì (x, y,z) của minpt nhỏ hơn (x, y,z) tương ứng của BoundingBox chính xác 1.e8
tương tự (x, y,z) của maxpt lớn hơn (x, y,z) của BoundingBox chính xác 1.e8
từ đó suy ra hàm IntersectWith cũng sai vì thực sự trong không gian LINE có z=1e-8 sẽ không cắt đường cong.
Vì vậy ta bỏ thành phần z của minpt và maxpt là được.
Tìm đến dòng
	(setq minpt (vlax-safearray->list minpt) 
maxpt (vlax-safearray->list maxpt) maxpt
Sửa thành
	(setq minpt (vlax-safearray->list minpt) minpt (list (car minpt) (cadr minpt))
maxpt (vlax-safearray->list maxpt) maxpt (list (car maxpt) (cadr maxpt))

  • 0

#49 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 25 August 2010 - 06:08 PM

Bài toán : Chọn 1 loạt đối tượng : Đối tượng chọn có thể lọc bằng lệnh filter hay bằng các phương pháp chọn. Muốn chọn kiểu nào thì có ngay kiểu đó. Chương trinhtự động lọc ra đối tượng nằm trong hay trên hay ngoài 1đường bao kín. Đường bao kín là 1 Polyline kín hoặc là 1 Spline kín. Đối tượng nằm trên đường bao (là đối tượng mà đường bao cắt qua)
OK không? :D

Xin lỗi đã để thanhDuan phải đợi lâu.
Sau đây là lời giải cho bài toán này :


(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver)
(PROGN
(vl-load-com)
(defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
(defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
)
(defun checkClosed(/ OK)
(while (and (null OK) (setq pl (vlax-ename->vla-object
(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0))) )
(if (null (vlax-curve-isClosed pl) )
(progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
(setq OK T)
)
)
pl
)
(acet-undo-begin)

(setq oldos (getvar "osmode"))
(setq ms (vla-get-modelspace
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
)

(prompt "\n Chon cac doi tuong :")
(vla-SelectOnScreen ss)
(iF (> (vla-get-count ss) 0)
(proGN
(setq i 0)
(setq temperr *error*)
(setq *error* bloi)
(minmaxp (checkClosed) )
(setq minpp (mapcar '- (safearray-value minp)
(list (setq dist (distance (safearray-value maxp) (safearray-value minp)))
dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
(setvar "osmode" 0)
(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while (< i (vla-get-count ss))
(minmaxp (setq obj (vla-item ss i)))
(setq line (vla-addline ms minp maxp ))
(setq line2 (vla-addline ms
(vla-polarpoint util minp 0
(- (car (safearray-value maxp)) (car (safearray-value minp)) )
)
(vla-polarpoint util minp (/ pi 2)
(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
)
)
)
;
(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
)
(PROGN
(setq sslistints (cons obj sslistints))
)
(PROGN
(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
(setq sslistous (cons obj sslistous))
(setq sslistins (cons obj sslistins))
)
(vla-erase line3)
)
);if
(setq i (1+ i))
(vla-erase line)
(vla-erase line2)
(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
((= ans "TRONG") (setq sss (getss sslistins)))
((= ans "TREN") (setq sss (getss sslistints)))
((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)
(sssetfirst sss sss)
(setq *error* temperr)

);proGN
(alert "\n No Selected....")
);iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé :D

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi ạ.
Tue_NV đã bẩy được cái lỗi tắt chế độ bắt điểm nhưng chưa thành công trong việc trả về trạng thái "ban đầu" của ProgBar ạ. Nhờ anh gia_bach hướng dẫn giúp ạ.
Cảm ơn anh. :D
  • 1

#50 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 25 August 2010 - 09:33 PM

Xin lỗi đã để thanhDuan phải đợi lâu.
Sau đây là lời giải cho bài toán này :



(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver)
(PROGN
(vl-load-com)
(defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
(defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
)
(defun checkClosed(/ OK)
(while (and (null OK) (setq pl (vlax-ename->vla-object
(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0))) )
(if (null (vlax-curve-isClosed pl) )
(progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
(setq OK T)
)
)
pl
)
(acet-undo-begin)

(setq oldos (getvar "osmode"))
(setq ms (vla-get-modelspace
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
)

(prompt "\n Chon cac doi tuong :")
(vla-SelectOnScreen ss)
(iF (> (vla-get-count ss) 0)
(proGN
(setq i 0)
(setq temperr *error*)
(setq *error* bloi)
(minmaxp (checkClosed) )
(setq minpp (mapcar '- (safearray-value minp)
(list (setq dist (distance (safearray-value maxp) (safearray-value minp)))
dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
(setvar "osmode" 0)
(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while (< i (vla-get-count ss))
(minmaxp (setq obj (vla-item ss i)))
(setq line (vla-addline ms minp maxp ))
(setq line2 (vla-addline ms
(vla-polarpoint util minp 0
(- (car (safearray-value maxp)) (car (safearray-value minp)) )
)
(vla-polarpoint util minp (/ pi 2)
(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
)
)
)
;
(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
)
(PROGN
(setq sslistints (cons obj sslistints))
)
(PROGN
(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
(setq sslistous (cons obj sslistous))
(setq sslistins (cons obj sslistins))
)
(vla-erase line3)
)
);if
(setq i (1+ i))
(vla-erase line)
(vla-erase line2)
(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
((= ans "TRONG") (setq sss (getss sslistins)))
((= ans "TREN") (setq sss (getss sslistints)))
((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)
(sssetfirst sss sss)
(setq *error* temperr)

);proGN
(alert "\n No Selected....")
);iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)

@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé :D

@anh giabach : Lisp copyblk chưa phát huy được chức năng bẫy lỗi ạ.
Tue_NV đã bẩy được cái lỗi tắt chế độ bắt điểm nhưng chưa thành công trong việc trả về trạng thái "ban đầu" của ProgBar ạ. Nhờ anh gia_bach hướng dẫn giúp ạ.
Cảm ơn anh. :D

Cảm ơn bác Tue_NV rất nhiều. Em lúc nào cũng mong ngóng chờ đợi tin của bác. Hiện tại em đang dùng máy của bạn để xem mà không có cài Cad nên chưa thử nghiệm được. Em cảm ơn bác rất nhiều vì đã tâm huyết với đề tài này. Dạ vâng, 'fi (dùng dấu nháy đơn để chèn lệnh khác vào) cái đó em cũng đã tìm hiểu rồi bác à. Cảm ơn bác đã nhắc nhở. Em sẽ reply lại cho bác khi thử nghiệm chương trình. Chúc bác vui vẻ và có nhiều đóng góp cho diễn đàn. Trân trọng
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#51 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 26 August 2010 - 08:00 AM

Kết quả sai trong trường hợp đường cong có arc cho dù đường cong lồi hay lõm.
Thực ra lỗi là ở hàm vla-GetBoundingBox
Nếu đường cong có arc thì (x, y,z) của minpt nhỏ hơn (x, y,z) tương ứng của BoundingBox chính xác 1.e8
tương tự (x, y,z) của maxpt lớn hơn (x, y,z) của BoundingBox chính xác 1.e8
từ đó suy ra hàm IntersectWith cũng sai vì thực sự trong không gian LINE có z=1e-8 sẽ không cắt đường cong.
Vì vậy ta bỏ thành phần z của minpt và maxpt là được.
Tìm đến dòng

	(setq minpt (vlax-safearray->list minpt) 
maxpt (vlax-safearray->list maxpt) maxpt
Sửa thành
	(setq minpt (vlax-safearray->list minpt) minpt (list (car minpt) (cadr minpt))
maxpt (vlax-safearray->list maxpt) maxpt (list (car maxpt) (cadr maxpt))

Chào bác ndtnv,
Có lẽ bác đã tìm thêm 1 lỗi nữa lisp của Giabach, cũng như của Tuenv. Thiep đã chạy lisp của Giabach trên vùng kín là 1 đa giác lõm không có arc với khoảng cách rải block tương đối nhỏ thì phát hiện lỗi.
Theo Thiep, bài toán đặt ra là "Array đối tượng block trong vùng kín". Như vậy yêu cầu lisp phải giải quyết được:
- Vùng kín có thể là 1 curve bất kỳ: đa giác hay đường cong trơn kín, có thể là gồm các curve tạo thành vùng kín, và có thể có đảo nữa (cũng là 1 curve kín bất kỳ).
- Mạng lưới rải block có thể lựa chọn là mạng lưới hình vuông (như của Tue_nv), có thể xoay góc 45o (như của Giabach), hay hình tam giác đều (Thiep đề nghị thêm). Tóm lại mạng lưới rải có thể hình vuông hay hình tam giác đều và có thể xoay 1 góc nào đó, tuỳ chọn.
- Khoảng cách rải giữa block có thể thay đổi.
Thân ái chào bác.
  • 0

#52 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 26 August 2010 - 10:28 AM

Xin lỗi đã để thanhDuan phải đợi lâu.
@thanh duan : Ở dòng Select Object (để chọn đối tượng bạn nhấn 'fi -> lập tức hộp thoại Filter hiện ra cho bạn lọc đó nhé :D

Trình Lisp của bác cao quá, em không nghĩ khi chạy chương trình của bác bất ngờ đến vậy. Điều này em nghĩ nó phức tạp quá trời khi nghĩ đến thuật toán giải quyết vấn đề đó. Vl-, Vla-, Vlax- .... hỗ trợ cho cad rất nhiều các bài toán. Bác có thể bật mí về ý nghĩa các hàm Vl-, Vla-, Vlax- .... được không hả bác? Em có thể tìm thấy tài liệu đó từ đâu ạ?

Qua nhiều thử nghiệm, bài toán đã được giải quyết 90% . Còn 10% là do vấn đề liên quan giao cắt các đối tượng với vùng kín (em chỉ dùng polyline), một số đối tượng giao với vùng kín thì khi chọn bên TRONG hay Ngoai có đối tượng thì được chọn, có đối tượng thì không bị chọn mà chúng đều giao với vùng kín. Ý của em là đối với đối tượng dạng điểm (VD như Text ) thì xét điểm chèn, còn với đối tượng dạng đường thì xét sự giao cắt với vùng kín, cứ có sự giao cắt với vùng kín thì xác định là nó nằm trên vùng kín.
Bác xem ví dụ này nha: http://www.cadviet.c..._bac_tue_nv.dwg
Tuy nhiên em rất hài lòng với phần lập trình của bác đã đáp ứng tương đối hoàn chỉnh yêu cầu và không có lý do gì mà không tặng thang điểm 10 cho bác. :D :D
Em cũng nhân tiện hỏi bác phần lỗi mà em thử nghiệm 1 số máy thấy nó hỏi là ko load được (acet-undo-begin)? và lần trước em hỏi bác nhưng chắc bác bận chưa trả lời

Bác Tue_NV à!
Em có thể hỏi bác một chút được không?
Một số hàm vl-, vlax-.....em không biết tìm kiếm đâu để tra cứu.
Bác có thể send cho em cấu trúc các hàm đó và cách sử dụng được không?
Cụ thể một số hàm trong lisp bác viết như:
(setq ms (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))))
(setq pl (vlax-ename->vla-object (car(entsel "\n Chon Polyline kin :"))))

Ngoài ra còn hàm :

+ (setq minp (safearray-value minp))
+ (setq maxp (safearray-value maxp))
+ (setq line (vla-addline ms (vlax-3d-point minpp)
(vla-get-insertionpoint x)

+ (if (= (rem (length (vlax-invoke pl 'intersectwith line 0)) 2) 0)
(vla-erase x)
Bác giải thích cho em các hàm trên bác nhé.
Mong rằng sau mỗi lần hiểu em sẽ vọc thêm được nhiều kiến thức hơn nữa. Cảm ơn bác

Chân thành cảm ơn bác
Chúc bác luôn mạnh khoẻ và có nhiều niềm vui.
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#53 dacco007

dacco007

    biết zoom

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

Đã gửi 20 April 2011 - 06:50 PM

bác làm bên địa hình có file ký hiệu dùng trong đia hình không cho em một bản?
gmail: dactracdia@gmail.com
và cuốn ký hiệu bản đồ địa hình các tỷ lệ không?
  • 0

#54 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 05 August 2012 - 10:41 AM


(defun c:sic(/ oldos ms doc util i pl line line2 line3 obj progbar
sslistints sslistins sslistous dist ans OK)
;;;COPYRIGHT BY TUE_NV. Contact: tue_nvcc@yahoo.com
(IF (acet-util-ver)
(PROGN
(vl-load-com)
(defun minmaxp (ob) (vla-getboundingbox ob 'minp 'maxp))
(defun getss(ob) (acet-list-to-ss(mapcar 'vlax-vla-object->ename ob)))
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
(defun bloi(errmsg)
(setvar "osmode" oldos)
(and progbar (acet-ui-progress) )
)
(defun checkClosed(/ OK)
(while (and (null OK) (setq pl (vlax-ename->vla-object
(ssname (acet-ui-entsel (list "\n Chon duong bao kin :")) 0))) )
(if (null (vlax-curve-isClosed pl) )
(progn (princ "\n Chon lai duong bao kin :") (setq OK nil))
(setq OK T)
)
)
pl
)
(acet-undo-begin)
(setq oldos (getvar "osmode"))
(setq ms (vla-get-modelspace
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
util (vla-get-Utility doc)
ss (vla-get-pickfirstselectionset doc)
)
(prompt "\n Chon cac doi tuong :")
(vla-SelectOnScreen ss)
(iF (> (vla-get-count ss) 0)
(proGN
(setq i 0)
(setq temperr *error*)
(setq *error* bloi)
(minmaxp (checkClosed) )
(setq minpp (mapcar '- (safearray-value minp)
(list (setq dist (distance (safearray-value maxp) (safearray-value minp)))
dist 0.0)))
(initget "TRONG TREN NG")
(setq ans (getkword "\n Ban muon chon doi tuong nam TRONG/TREN/NGoai duong bao :"))
(setvar "osmode" 0)
(setq ProgBar (acet-ui-progress "Dang tinh toan...." (vla-get-count ss)))
(while (< i (vla-get-count ss))
(minmaxp (setq obj (vla-item ss i)))
(setq line (vla-addline ms minp maxp ))
(setq line2 (vla-addline ms
(vla-polarpoint util minp 0
(- (car (safearray-value maxp)) (car (safearray-value minp)) )
)
(vla-polarpoint util minp (/ pi 2)
(- (cadr (safearray-value maxp)) (cadr (safearray-value minp)) )
)
)
)
;
(if (and (/= (length (vlax-invoke pl 'intersectwith line 0)) 0)
(/= (length (vlax-invoke pl 'intersectwith line2 0)) 0)
)
(PROGN
(setq sslistints (cons obj sslistints))
)
(PROGN
(setq line3 (vla-addline ms (vlax-3d-point minpp) minp ))
(if (= (rem (length (vlax-invoke pl 'intersectwith line3 0)) 2) 0)
(setq sslistous (cons obj sslistous))
(setq sslistins (cons obj sslistins))
)
(vla-erase line3)
)
);if
(setq i (1+ i))
(vla-erase line)
(vla-erase line2)
(acet-ui-progress -1)
);while
(setq ProgBar (acet-ui-progress))
(COND
((= ans "TRONG") (setq sss (getss sslistins)))
((= ans "TREN") (setq sss (getss sslistints)))
((= ans "NG") (setq sss (getss sslistous)))
)
(acet-undo-end)
(sssetfirst sss sss)
(setq *error* temperr)

);proGN
(alert "\n No Selected....")
);iF
);PROGN
(alert "\n Chua cai Express")
);IF
(princ)
)
Nhờ các bác xem và chỉnh sửa lại dùm em lisp này của bác TUE_NV.
Sau khi em dùng lệnh ssx của cad để ngầm lựa chọn các đối tượng trong bản vẽ.
Sau khi dùng lệnh SIC của bác TUE_NV thì lisp sẽ chỉ chọn các đối tượng đã lựa chọn trước và nằm trong/trên/ngoài vùng khép kín.
Sau khi chọn được rồi ta có thể Copy, Move, Erase,....
Em cũng đã thử chỉnh sửa nhưng không được.
Các bác giúp em nhé. Em đang mò mẫm lại cho thỏa cái đam mê. :D
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#55 w1nDream

w1nDream

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 293 Bài viết
Điểm đánh giá: 73 (tàm tạm)

Đã gửi 28 November 2012 - 03:46 PM

Em thấy Lisp AIC hay copyblk đều rất hay.Tuy nhiên công việc của em lại chưa thể dùng được.Mong các anh có thể sửa giúp em để có kết quả Array theo hướng cho trước, cho lựa chọn khoảng cách hàng và cột (UCS Wolrd hoặc UCS bất kỳ) như hình vẽ sau:
Hình đã gửi

Ngoài ra với lisp SIC em có ý kiến thế này:
Anh có thể sửa và bổ sung thêm với TH nó chọn các Block.
Hiện tại thì lisp đang select tất cả các Block nằm trên đường bao nếu chỉ 1 phần của Block giao với bao.
Với TH của em và có lẽ nhiều TH khác thì Block làm việc theo điểm gốc Block nên em muốn nhờ anh bổ sung thêm giúp em phần lựa chọn để lisp select dựa vào gốc Block chứ không phải điểm bất kỳ thuộc Block
VD: chọn các Block phần ngoài đường bao nghĩa là select tất cả các Block có tim nằm ngoài vùng chọn
  • 0
__Tâm tựa lưu thủY__
Vi nhân nan

#56 w1nDream

w1nDream

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 293 Bài viết
Điểm đánh giá: 73 (tàm tạm)

Đã gửi 30 November 2012 - 02:44 PM

Help me!!!Có ai giúp em với không ạ!em đang cần tại làm thủ công nó lâu quá
  • 0
__Tâm tựa lưu thủY__
Vi nhân nan