Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1361 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 02 July 2010 - 03:05 PM

@romeo1982 : Bạn đã sử dụng chức năng Recreat Boundary trong lệnh Hatchedit (HE) chưa? Nó sẽ đáp ứng yêu cầu của bạn. Hình như CAD2008 trở đi mới có chức năng này.
Xin lỗi bạn, mình đã thấy chức năng đó rồi, nhưng mình muốn nói là trong bản vẽ của mình có hàng ngàn cái hatch mà ko có đường biên như vậy, nếu làm từ cái chắc là lâu lắm, mong bạn giúp đỡ thêm

chán bồ này quá!trên diễn đàn có đầy mà ko search!bạn xem bài số 11 và bài số 18 của bác HOÀNH nè!
http://www.cadviet.c...hp?showtopic=18
  • 0

#1362 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 02 July 2010 - 03:09 PM

@romeo1982 : Bạn đã sử dụng chức năng Recreat Boundary trong lệnh Hatchedit (HE) chưa? Nó sẽ đáp ứng yêu cầu của bạn. Hình như CAD2008 trở đi mới có chức năng này.
Xin lỗi bạn, mình đã thấy chức năng đó rồi, nhưng mình muốn nói là trong bản vẽ của mình có hàng ngàn cái hatch mà ko có đường biên như vậy, nếu làm từ cái chắc là lâu lắm, mong bạn giúp đỡ thêm

Bạn romeo thử cái này nhé :
(defun c:hbo(/ ss i)
(setvar "cmdecho" 0)
(if(setq ss (ssget '((0 . "HATCH"))))
(progn
(setq i 0)
(Repeat (sslength ss)
(vl-cmdf "hatchedit" (ssname ss i)
"B" "R" "Y")
(setq i (1+ i))
)
)
)
)

  • 1

#1363 tuananhmcn

tuananhmcn

    Chưa sử dụng CAD

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

Đã gửi 02 July 2010 - 03:21 PM

Dùng Hatchedit (HE) sau khi gõ HE gõ 'fi vào phần select filter chọn Hatch. Khi đó Cad cho phép bạn chọn chỉ riêng đường Hatch mà thôi. chúc thành công!
  • 1

#1364 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 02 July 2010 - 03:48 PM

Sẽ chắc chắn rằng điểm thứ 3 là P sẽ nằm đúng trên P1P2(xác suất 99.999%). Cơ mà bác PhamThanhBinh đã quên rằng CAD có lệnh UCS; chế độ Ortho và 1 sợi dây tóc chuột hay sao? :cheers:
Nếu P không nằm trên P1P2 thì kiểm tra và hiện lên thông báo

@truongthanh : Bạn hãy upload file cụ thể lên xem thế nào? Dạo này Tue_NV bận lắm, chắc là không giúp gì được, nhưng có các bác trên diễn đàn nếu rảnh sẽ giúp bạn mà

Hề hề hề,
Chào bác TueNV,
Cái này mình quên thật nên cũng muốn nhắc bạn Sony2007 cần lưu ý khi ra đề bài cho chặt chẽ, vì không phải lúc nào các chế độ như trên đều mặc định. Vả lại mình thấy các bác trên diễn đàn có phép chọn điểm trên đối tượng gần nhất với điểm chọn nên mình muốn hỏi lại bạn sony2007 cho chắc để có thể tạo lisp cho những trường hợp điểm pick không nằm trên đối tượng bác ạ. Nếu chấp nhận việc lấy điểm trên đối tượng gần nhất với điểm chọn thì có thể làm lisp cho trường hợp tổng quát mà không lệ thuộc vào việc chọn điểm có chính xác hay không bác ạ.
Rất cám ơn bác vì đã nhắc nhở mình mấy cách cài đặt các chế độ màn hình của CAD.
Chúc bác luôn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1365 romeo1982

romeo1982

    biết lệnh mirror

  • Members
  • PipPipPip
  • 152 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 02 July 2010 - 04:08 PM

Còn vấn đề này "các hình chữ nhật có thể bị nổ ra thành line và có thể bị hở nhỏ nữa" thì pótay !
Bạn thử LISP này :

(defun c:addLay (/ ent i j layname objci objpl pt_lst ss ssc)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)

(defun GetPtLst (obj / anginc arcparam blg delta eparam inc pt ptlst sparam)
(setq sparam (vlax-curve-getStartParam obj)
eparam (vlax-curve-getEndParam obj)
anginc (* pi (/ 6 180.0)))
(while (<= sparam eparam)
(setq pt (vlax-curve-getPointAtParam obj sparam))
(if (not (equal pt (car ptlst) 1e-12))
(setq ptlst (cons pt ptlst)))
(if (and (/= sparam eparam)
(setq blg (abs (vlax-invoke obj 'GetBulge sparam)))
(/= 0 blg))
(progn
(setq delta (* 4 (atan blg)) ;included angle
inc (/ 1.0 (1+ (fix (/ delta anginc))))
arcparam (+ sparam inc))
(while (< arcparam (1+ sparam))
(setq pt (vlax-curve-getPointAtParam obj arcparam)
ptlst (cons pt ptlst)
arcparam (+ inc arcparam)))) )
(setq sparam (1+ sparam)) )
ptlst)
;main
(princ "\nChon Pline : ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq objPL (vlax-ename->vla-object ent)
pt_lst (GetPtLst objPL)
ssC (ssget "_WP" pt_lst (list (cons 0 "CIRCLE"))) )
(if ssC
(progn
(setq num (sslength ssC))
(if (> num 255) (setq num (rem num 255)))
(setq layname (strcat "Layer_" (itoa num) "_Circle") j -1)
(or (tblsearch "Layer" layname) (vl-cmdf "-layer" "N" layname "c" num layname ""))
(vla-put-Layer objPL layname)
(while (setq ent (ssname ssC (setq j (1+ j))))
(setq objCi (vlax-ename->vla-object ent) )
(vla-put-Layer objCi layname) ) ) ))))
(princ))

líp rất hay bác gia_bach ah, bác có thể thêm vào 1 tí nữa ko, trong các đường polyline khép kín có thể ko có vòng tròn mà có text thì nó đưa text và đường polyline về layer có tên text đó luôn, mong tin bác
  • 0

#1366 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 02 July 2010 - 04:12 PM

líp rất hay bác gia_bach ah, bác có thể thêm vào 1 tí nữa ko, trong các đường polyline khép kín có thể ko có vòng tròn mà có text thì nó đưa text và đường polyline về layer có tên text đó luôn, mong tin bác

T/hợp có nhiều Text thì đưa vào Layer nào ?


sao ko ai giúp mình hết vậy?

To truongthanh
Đây là bài toán nguợc rất khó, cho đến bây giờ tui chưa tìm đuợc huớng đi cho đuờng Pline.

Một đề nghị :
- Bạn nên đặt biến DIMASSOC=2 trước khi gọi lệnh Dim, sau đó nếu không cần Associate nữa thì gọi lệnh DIMDISASSOCIATE để tắt Associate sẽ dễ hơn.
  • 2

#1367 romeo1982

romeo1982

    biết lệnh mirror

  • Members
  • PipPipPip
  • 152 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 02 July 2010 - 04:19 PM

T/hợp có nhiều Text thì đưa vào Layer nào ?

nếu nhiều text mà khác nhau thì loại bỏ bác ơi
  • 0

#1368 yes

yes

    biết pan

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

Đã gửi 02 July 2010 - 04:33 PM

Ủa, LISP này mình đã chỉnh sửa và bổ sung LISP và đã post lên trên rồi, mà sao các bác vẫn còn bàn luận thế, các bác xem thử cái mình gởi rồi cho ý kiến.

http://www.cadviet.c...ien_theomau.lsp

Trong quá trình sử dụng, mình xuất hiện một số lỗi sau. Bạn xem lại và khắc phục giúp mình nhé. Mong tin bạn

; warning: unwind skipped on exception
; error: Exception occurred: 0xC0000005 (Access Violation)
  • 0

#1369 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 02 July 2010 - 05:36 PM

T/hợp có nhiều Text thì đưa vào Layer nào ?
To truongthanh
Đây là bài toán nguợc rất khó, cho đến bây giờ tui chưa tìm đuợc huớng đi cho đuờng Pline.

Một đề nghị :
- Bạn nên đặt biến DIMASSOC=2 trước khi gọi lệnh Dim, sau đó nếu không cần Associate nữa thì gọi lệnh DIMDISASSOCIATE để tắt Associate sẽ dễ hơn.

hy vọng bac gia bach sẽ sớm có trả lời dùm mình!
  • 0

#1370 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 02 July 2010 - 05:37 PM

Trong quá trình sử dụng, mình xuất hiện một số lỗi sau. Bạn xem lại và khắc phục giúp mình nhé. Mong tin bạn

; warning: unwind skipped on exception
; error: Exception occurred: 0xC0000005 (Access Violation)


Cái này mình chưa gặp qua, đành nhờ các bác khác vậy, LSP này mình cũng bổ sung và sửa chửa theo nguyện vọng của bạn thôi,
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1371 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 02 July 2010 - 05:41 PM

Lại một lần nữa mong cac anh giúp đỡ cho mình ! mình đang rất cần .................
mình dùng lisp này để phóng điểm lên cad nhưng phóng điểm thì tốt nhưng mà điểm không có ghi tên điểm bro nào có thể giúp mình sau khi phóng điểm lên cad các điểm đó có thể là tên hoặc số thứ tự họăc độ cao không !!!!!!
đây la file lisp minh muon sua http://www.cadviet.c...importxyz_1.zip
vidu lisp mình đang dùng http://www.cadviet.c...2/chua_duoc.dwg
lisp mình muốn http://www.cadviet.c...hi_sua_lisp.dwg
cám ơn !!!!!!!


TienDaiCa up file số liệu lên xem thử để mọi người còn ngâm cú chứ.
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1372 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 02 July 2010 - 07:51 PM

Hề hề hề,
Chào bác TueNV,
Cái này mình quên thật nên cũng muốn nhắc bạn Sony2007 cần lưu ý khi ra đề bài cho chặt chẽ, vì không phải lúc nào các chế độ như trên đều mặc định. Vả lại mình thấy các bác trên diễn đàn có phép chọn điểm trên đối tượng gần nhất với điểm chọn nên mình muốn hỏi lại bạn sony2007 cho chắc để có thể tạo lisp cho những trường hợp điểm pick không nằm trên đối tượng bác ạ. Nếu chấp nhận việc lấy điểm trên đối tượng gần nhất với điểm chọn thì có thể làm lisp cho trường hợp tổng quát mà không lệ thuộc vào việc chọn điểm có chính xác hay không bác ạ.
Rất cám ơn bác vì đã nhắc nhở mình mấy cách cài đặt các chế độ màn hình của CAD.
Chúc bác luôn vui.


Nhờ bác giúp đỡ cho e với. Cám ơn bác nhiều
  • 0

#1373 tiendaica

tiendaica

    biết zoom

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

Đã gửi 02 July 2010 - 11:25 PM

Lại một lần nữa mong cac anh giúp đỡ cho mình ! mình đang rất cần .................
mình dùng lisp này để phóng điểm lên cad nhưng phóng điểm thì tốt nhưng mà điểm không có ghi tên điểm bro nào có thể giúp mình sau khi phóng điểm lên cad các điểm đó có thể là tên hoặc số thứ tự họăc độ cao không !!!!!!
đây la file lisp minh muon sua http://www.cadviet.c...importxyz_1.zip
vidu lisp mình đang dùng http://www.cadviet.c...2/chua_duoc.dwg
lisp mình muốn http://www.cadviet.c...hi_sua_lisp.dwg
cám ơn !!!!!!!
day la file so lieu http://www.cadviet.c...oa_do_docao.txt
  • 0

#1374 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 02 July 2010 - 11:40 PM

Lại một lần nữa mong cac anh giúp đỡ cho mình ! mình đang rất cần .................
mình dùng lisp này để phóng điểm lên cad nhưng phóng điểm thì tốt nhưng mà điểm không có ghi tên điểm bro nào có thể giúp mình sau khi phóng điểm lên cad các điểm đó có thể là tên hoặc số thứ tự họăc độ cao không !!!!!!
đây la file lisp minh muon sua http://www.cadviet.c...importxyz_1.zip
vidu lisp mình đang dùng http://www.cadviet.c...2/chua_duoc.dwg
lisp mình muốn http://www.cadviet.c...hi_sua_lisp.dwg
cám ơn !!!!!!!
day la file so lieu http://www.cadviet.c...oa_do_docao.txt


Cái này đã có trên diễn đàn rồi, nên bạn cần search trước, các bác khác chắc "giận" nên ko trả lời, lần sau bác cẩn thận nhé, Link cho bác tham khảo nè:
http://www.cadviet.c...showtopic=20044
  • 1
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1375 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 03 July 2010 - 08:50 AM

...bác có thể thêm vào 1 tí nữa ko, trong các đường polyline khép kín có thể ko có vòng tròn mà có text thì nó đưa text và đường polyline về layer có tên text đó luôn, mong tin bác

nếu nhiều text mà khác nhau thì loại bỏ bác ơi

Bạn thử LISP này :
(defun c:addLayT (/ char ent i j layname obj objpl pt_lst ss ssc str)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)

(defun GetPtLst (obj / anginc arcparam blg delta eparam inc pt ptlst sparam)
(setq sparam (vlax-curve-getStartParam obj)
eparam (vlax-curve-getEndParam obj)
anginc (* pi (/ 6 180.0)))
(while (<= sparam eparam)
(setq pt (vlax-curve-getPointAtParam obj sparam))
(if (not (equal pt (car ptlst) 1e-12))
(setq ptlst (cons pt ptlst)))
(if (and (/= sparam eparam)
(setq blg (abs (vlax-invoke obj 'GetBulge sparam)))
(/= 0 blg))
(progn
(setq delta (* 4 (atan blg)) ;included angle
inc (/ 1.0 (1+ (fix (/ delta anginc))))
arcparam (+ sparam inc))
(while (< arcparam (1+ sparam))
(setq pt (vlax-curve-getPointAtParam obj arcparam)
ptlst (cons pt ptlst)
arcparam (+ inc arcparam)))) )
(setq sparam (1+ sparam)) )
ptlst)
;main
(princ "\nChon Pline : ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq objPL (vlax-ename->vla-object ent)
pt_lst (GetPtLst objPL)
ssC (ssget "_WP" pt_lst (list (cons 0 "TEXT"))) )
(if (and ssC (= 1(sslength ssC)))
(progn
(setq obj (vlax-ename->vla-object (ssname ssC 0))
str (vla-get-TextString obj ))
(if (not (snvalid str))
(progn; xoa ki tu invalid
(setq layname "Layer_" j 0)
(repeat (strlen str)
(setq char (substr str (setq j (1+ j)) 1))
(if (snvalid char)
(setq layname (strcat layname char)))))
(setq layname str))
(or (tblsearch "Layer" layname) (vl-cmdf "-layer" "N" layname ""))
(vla-put-Layer obj layname)
(vla-put-Layer objPL layname) ) ))))
(princ))

  • 1

#1376 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 03 July 2010 - 08:54 AM

Chào bác PhamThanhBinh và bạn Sony :
Bạn hãy thử đoạn Code này :
Đoạn code này kiểm tra điểm P có nằm trên P1P2 hay không. Vấn đề nội suy còn lại -> hy vọng Sony tự giải quyết được

(defun c:ktra(/ p p1 p2 dis)
(command "ucs" "")
(setq p1 (getpoint "\n Nhap diem P1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(command "ucs" "z" p1 p2)
(setvar "orthomode" 1)
(setq p1 (trans p1 0 1) p2 (trans p2 0 1)
dis (distance p1 p2)
)
(While (setq p (getpoint p1 "\n Nhap diem P :"))
(if (or (= (+ (distance p1 p) (distance p p2)) dis)
(= (+ (distance p p1) dis) (distance p p2))
(= (+ (distance p2 p) dis) (distance p p1))
)
(alert "\n P nam tren P1 P2")
(alert "\n P khong nam tren P1 P2")
)
)
(command "ucs" "P")
(command "ucs" "P")
(princ)
)


Hề hề hề,
Chào bác TueNV,
Cái này mình quên thật nên cũng muốn nhắc bạn Sony2007 cần lưu ý khi ra đề bài cho chặt chẽ, vì không phải lúc nào các chế độ như trên đều mặc định. Vả lại mình thấy các bác trên diễn đàn có phép chọn điểm trên đối tượng gần nhất với điểm chọn nên mình muốn hỏi lại bạn sony2007 cho chắc để có thể tạo lisp cho những trường hợp điểm pick không nằm trên đối tượng bác ạ. Nếu chấp nhận việc lấy điểm trên đối tượng gần nhất với điểm chọn thì có thể làm lisp cho trường hợp tổng quát mà không lệ thuộc vào việc chọn điểm có chính xác hay không bác ạ.
Rất cám ơn bác vì đã nhắc nhở mình mấy cách cài đặt các chế độ màn hình của CAD.
Chúc bác luôn vui.

@Bác PhamThanhBinh :
Chế độ ortho, osmode nếu không ở chế độ mặc định thì ta làm cho nó theo ý của mình. Có thể là trong quá trình viết Lisp, hoặc là trong quá trình chạy Lisp, user cũng có thể thiết lập nó. Code trên là 1 ví dụ
Chúc bác luôn vui, khoẻ nữa. :cheers:
  • 3

#1377 romeo1982

romeo1982

    biết lệnh mirror

  • Members
  • PipPipPip
  • 152 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 03 July 2010 - 06:17 PM

Xin hỏi các cao thủ có cách nào nối 2 cung tròn thành đường tròn ko, ý mình muốn nói là nối 1 lượt vài ngàn cái cung tròn .Mong các cao thủ giúp đỡ
  • 0

#1378 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 03 July 2010 - 06:27 PM

Xin hỏi các cao thủ có cách nào nối 2 cung tròn thành đường tròn ko, ý mình muốn nói là nối 1 lượt vài ngàn cái cung tròn .Mong các cao thủ giúp đỡ

2 cung tròn này có góc ở tâm bằng 180 độ phải không romeo? và "dính" với nhau tạo thành 1 đường tròn phải không?
Nếu không phải thì bạn upload file .dwg và nói rõ nhé
  • 1

#1379 romeo1982

romeo1982

    biết lệnh mirror

  • Members
  • PipPipPip
  • 152 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 03 July 2010 - 07:42 PM

2 cung tròn này có góc ở tâm bằng 180 độ phải không romeo? và "dính" với nhau tạo thành 1 đường tròn phải không?
Nếu không phải thì bạn upload file .dwg và nói rõ nhé

đúng bác ah,cám ơn bác đã quan tâm
  • 0

#1380 thaycung

thaycung

    biết pan

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

Đã gửi 04 July 2010 - 01:03 AM

Nhờ mọi người giúp cho một LISP vẽ các đường thẳng song song nhưng khoảng cách giữa các đường đó tăng dần hoặc giảm dần (ví dụ như các đường chải mái dốc). Xin được cảm ơn trước!
  • 0