Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp cắt đường thẳng giao với 1 đường thẳng


  • Please log in to reply
6 replies to this topic

#1 VThanhgtvt

VThanhgtvt

    biết vẽ circle

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

Đã gửi 24 July 2012 - 01:54 PM

Chẳng là e có hai đường thẳng giao nhau (thể hiện 2 cost khác nhau: Một đường cost 1100, một đường cost 2500) nhưng do là bản vẽ 2D nên muốn thể hiện đường có cost 2500 ở trên, che lấp đi đường có cost 1100 thì em chỉ biết cắt (Break) đường có cost 1100. Vấn đề của e là ở chỗ này:
Nhờ các bác có thể viết cho em xin một lisp mà khi khi mình muốn cắt 2 đường thẳng giao nhau, ta chỉ cần quét 2 đường thẳng đó (trong ví dụ là đường 1 & 2), sau đó muốn đường nào bị cắt (trong ví dụ là đường 2) thì mình sẽ click vào đường 2, sao đó nhập khoảng cách mình muốn cách ra từ đường 1 (ở đây khoảng cách này tính là khoảng cách/2)
Kết quả của lisp có thể hiểu như sau ah:

Hình đã gửi
Thanks các bác nhiều!!!


  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 July 2012 - 02:28 PM

Quick code :

(defun c:cat(/ ent p)
(setq ent (car (entsel "\nChon doi tuong bi cat :")) p (getpoint "\nDiem giao :"))
(or d (setq d 1))
(setq d (cond ((getdist (strcat "\nKhoang cach <" (rtos d) "> :"))) (d)))
(command ".break" (list ent (polar p (angle p (cdr (assoc 10 (entget ent)))) (* 0.5 d)))(polar p (angle p (cdr (assoc 11 (entget ent)))) (* 0.5 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


#3 VThanhgtvt

VThanhgtvt

    biết vẽ circle

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

Đã gửi 27 July 2012 - 08:49 AM

Quick code :

Cám ơn bác thật nhiều ah.....
  • 0

#4 VThanhgtvt

VThanhgtvt

    biết vẽ circle

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

Đã gửi 27 July 2012 - 09:25 AM

Ah, tiện thể bác kietxu có thể chế thêm cho em lisp này:
  • Chỉnh để chỗ nhập khoảng cách vào ấy ah, không nhập khoảng cách/2 nữa mà khoảng cách nhập vào sẽ là khoảng cách bị cắt sang hai bên luôn thì ntn bác nhỉ?
  • Em muốn lấy đường 1 làm chuẩn, em muốn cắt nhiều đường như đường 2 thì làm ntn bác nhỉ?
  • Về lệnh Break của cad ấy, vấn đề là điểm chọn đầu tiên của lệnh mình không chọn chính xác được điểm giao nhau giữa 2 đường thẳng. Bác có thể viết giúp em cái lisp giống lệnh này mà điểm chọn đầu được chuyển giống như điểm cuối được không ah.

  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 27 July 2012 - 09:53 AM

1. Bạn thay (* 0.5 d) thành d
2. Toàn Line :

(defun c:bf2(/ fl ob1 dxf cat sscat dump) ;Ketxu
(vl-load-com)
(command "undo" "be")
(or *d (setq *d 1))
(cond ( (setq fl (list (cons 0 "LINE"))
ob1 (ssname (ssget ":S" fl) 0)
dump (not (command "zoom" "OB" ob1 ""))
dxf (lambda(id e)(cdr (assoc id (entget e))))
cat (lambda(e p d)(command ".break" (list e (polar p (angle p (dxf 10 e)) d)) "_non" (polar p (angle p (dxf 11 e)) d)))
ssCat (vl-remove ob1 (acet-ss-to-list (ssget "f" (list (dxf 10 ob1)(dxf 11 ob1))fl)))
*d (cond ((getdist (strcat "\nKhoang cach <" (rtos *d) "> :"))) (*d))
dump (eval 'acet-geom-intersectwith)
)
(foreach obCat ssCat
(cat obCat (car (acet-geom-intersectwith ob1 obCat 0)) *d)
)) (T "\nKhong co Express - Hoac loi xay ra")
)
(command "undo" "en")
(princ)
)
3. Bạn tìm Google với từ khóa (defun c:bf cadviet. Lisp này trên diễn đàn có mấy cái rồi.K nhầm thì mới mấy hôm trước mình viết 1 cái kiểu thế theo yêu cầu haanh.
Thực chất là thực hiện lệnh Break sau đó ấn F để cho phép chọn lại điểm đầu, sau đó điểm thứ 2 lấy trùng điểm đầu
  • 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


#6 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 27 July 2012 - 11:26 AM

Ah, tiện thể bác kietxu có thể chế thêm cho em lisp này:

  • Chỉnh để chỗ nhập khoảng cách vào ấy ah, không nhập khoảng cách/2 nữa mà khoảng cách nhập vào sẽ là khoảng cách bị cắt sang hai bên luôn thì ntn bác nhỉ?
  • Em muốn lấy đường 1 làm chuẩn, em muốn cắt nhiều đường như đường 2 thì làm ntn bác nhỉ?
  • ...................


(1 +2 )

(defun C:brk2(/ d ent ipts ss)
(defun ssget->ss-list (ss / i obj allobj)
(setq i -1)
(while (setq obj (ssname ss (setq i (1+ i))) )
(setq allobj (cons obj allobj)) )
allobj )
(defun break_obj (ent pt dis / brkpte brkpts len)
(setq brkptS pt brkptE pt)
(if (> dis 0)
(progn
(setq len (vlax-curve-getDistAtPoint ent pt))
(if (> len dis)
(setq brkptS (vlax-curve-getPointAtDist ent (- len dis))))
(if (> (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (+ len dis))
(setq brkptE (vlax-curve-getPointAtDist ent (+ len dis)) )) ))
(command "._break" ent "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1)) )

(defun Select1obj(objName msg)
(while (not (and(setq ent (car (entsel msg)))
(if ent (wcmatch (cdr (assoc 0 (entget ent))) objName) ) ) )
(princ "\nSelect Again: ") )
ent )
; main
(vl-load-com)
(command "undo" "be")
(setq ent (Select1obj "LINE,ARC,RAY,XLINE" "Duong chuan : ")
ent (vlax-ename->vla-object ent))
(princ "\nVat bi cat...")
(if(setq ss (ssget "_:L" (list (cons 0 "LINE,ARC"))))
(progn
(or d (setq d 1))
(initget 4)
(setq d (cond ((getdist (strcat "\nKhoang cach <" (rtos d) "> :"))) (d)))
(foreach e (ssget->ss-list ss)
(if (setq iPts (vlax-Invoke ent "IntersectWith" (vlax-ename->vla-object e) 0))
(break_obj e ipts d)) )))
(command "undo" "e")(princ) )

PS : Bổ sung hàm con.

Bài viết đã được chỉnh sửa nội dung bởi gia_bach: 27 July 2012 - 12:13 PM

  • 1

#7 VThanhgtvt

VThanhgtvt

    biết vẽ circle

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

Đã gửi 27 July 2012 - 01:04 PM

Sao em không thay được thế bác nhỉ?
Của bác có phải là: (*-cách-0.5-cách-d), giờ có phải em cần sửa lại thành: (d) đúng không ah? Nhưng tới phần nhập khoảng cách thì nó báo lỗi như vầy ah:

.break Select object: ; error: bad function: 100.0

Ở đây em nhập 100. Nếu không thì phiền bác edit lại luôn giúp em với ah
Còn ý 2, bác hiểu nhầm ý của em rùi thì phải. Quét tất cả các line rồi nó zoom ngay đến 1 điểm nào đó để mình cắt. Ý em là như vầy bác nè:
Hình đã gửi
Lisp bác nói có phải bên này không ah?
http://www.cadviet.c...showtopic=34335
  • 0