Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
matran

Chia cung tròn thành nhiều dây cung

Các bài được khuyến nghị

matran    3

Chào các bạn. Mình có một cung tròn, Mình muốn chia nhỏ cung tròn này thành nhiều dây cung (dạng line hay pline) liên tiếp. Các bạn có biết trên cad có lệnh nào chia cung tròn thành nhiều dây cung hay không hoặc các bạn có thể viết giúp mình một cái lisp để làm việc này hay kg. Có hai lựa chọn :

- Một là chia cung tròn thành n đoạn dây cung bằng nhau

- Hai là chia cung tròn thành nhiều dây cung có độ dài cho trước (dây cung cuối cùng có độ dài còn lại)

Mong đc các bác giúp đỡ. Xin cám ơn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
hanhgl    79

Bạn dùng lệnh DIVIDE để chia cung tròn , đoạn thẳng thành n phần bằng nhau.

Lệnh MASURE để chia thành các đoạn có chiều dài cho trứơc, sẽ có một đoạn lẻ.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Chào các bạn. Mình có một cung tròn, Mình muốn chia nhỏ cung tròn này thành nhiều dây cung (dạng line hay pline) liên tiếp. Các bạn có biết trên cad có lệnh nào chia cung tròn thành nhiều dây cung hay không hoặc các bạn có thể viết giúp mình một cái lisp để làm việc này hay kg. Có hai lựa chọn :

- Một là chia cung tròn thành n đoạn dây cung bằng nhau

- Hai là chia cung tròn thành nhiều dây cung có độ dài cho trước (dây cung cuối cùng có độ dài còn lại)

Mong đc các bác giúp đỡ. Xin cám ơn

 

Chuyển spline hoặc polyline MO KHONG GIAO NHAU thành polyline có các phân đoạn bằng nhau.

 

(defun C:CDT(/ dt)

(princ "\nChon Pline hoac SPline. ")

(setq dt (getreal "\nNhap chieu dai phan doan : "));CÓ THỂ THAY ĐỔI DÒNG NÀY thành (setq dt (getint "\nNhap so phan doan : "))

(chpl (car(entsel)) dt)

(princ)

)

 

;Các hàm phụ

(defun chpl (ent dt / name ptlst spt ept chkint elm)

(setvar "CMDECHO" 0)

(command "measure" ent dt) ;CÓ THỂ THAY ĐỔI DÒNG NÀY thành lệnh Divide với tham số dt là số phân đoạn//(command "Divide" ent dt)

(setq name (cdr(assoc 0 (entget(entlast))))) ;ten doi tuong cuoi tren ban ve

 

(while (and (/= name "SPLINE") (/= name "LWPOLYLINE") ;khi chua tim gap spline hoac pl

(/= name "VIEWPORT")

)

(setq ptlst (append (list (assoc 10 (entget(entlast)))) ptlst)) ;dua toa do point vao danh sach bao gom dxf 10

(entdel(entlast))

(setq name (cdr(assoc 0 (entget(entlast)))))

)

 

(setq name (cdr(assoc 0 (entget ent)))) ;ten doi tuong chon (sp hoac pl)

(if (= name "SPLINE")

(progn

(setq spt (car(spvexs ent))) ; toa do diem dau tien sp

(setq ept (last (spvexs ent))) ; toa do diem cuoi sp

)

(progn

(setq spt(car(plvexs ent 0))) ; toa do diem dau tien pl

(setq ept (last (plvexs ent 0))) ; toa do diem cuoi pl

)

)

(setq chkint (car(int spt (car ptlst) ept (last ptlst)))) ;dung ham int de tim giao diem

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Chào các bạn. Mình có một cung tròn, Mình muốn chia nhỏ cung tròn này thành nhiều dây cung (dạng line hay pline) liên tiếp. Các bạn có biết trên cad có lệnh nào chia cung tròn thành nhiều dây cung hay không hoặc các bạn có thể viết giúp mình một cái lisp để làm việc này hay kg. Có hai lựa chọn :

- Một là chia cung tròn thành n đoạn dây cung bằng nhau

- Hai là chia cung tròn thành nhiều dây cung có độ dài cho trước (dây cung cuối cùng có độ dài còn lại)

Mong đc các bác giúp đỡ. Xin cám ơn

 

;Chuyển spline hoặc polyline MO KHONG GIAO NHAU thành polyline có các phân đoạn bằng nhau

 

(defun C:CDT(/ dt)

(princ "\nChon Pline hoac SPline. ")

(setq dt (getreal "\nNhap chieu dai phan doan : ")) ;CÓ THỂ THAY ĐỔI DÒNG NÀY thành (setq dt (getint "\nNhap so phan doan : "))

(chpl (car(entsel)) dt)

(princ)

)

 

;Các hàm phụ

(defun chpl (ent dt / name ptlst spt ept chkint elm)

(setvar "CMDECHO" 0)

(command "measure" ent dt) ;CÓ THỂ THAY ĐỔI DÒNG NÀY thành Divide với tham số dt là số phân đoạn//(command "Divide" ent dt)

(setq name (cdr(assoc 0 (entget(entlast))))) ;ten doi tuong cuoi tren ban ve

 

(while (and (/= name "SPLINE") (/= name "LWPOLYLINE") ;khi chua tim gap spline hoac pl

(/= name "VIEWPORT")

)

(setq ptlst (append (list (assoc 10 (entget(entlast)))) ptlst)) ;dua toa do point vao danh sach bao gom dxf 10

(entdel(entlast))

(setq name (cdr(assoc 0 (entget(entlast)))))

)

 

(setq name (cdr(assoc 0 (entget ent)))) ;ten doi tuong chon (sp hoac pl)

(if (= name "SPLINE")

(progn

(setq spt (car(spvexs ent))) ; toa do diem dau tien sp

(setq ept (last (spvexs ent))) ; toa do diem cuoi sp

)

(progn

(setq spt(car(plvexs ent 0))) ; toa do diem dau tien pl

(setq ept (last (plvexs ent 0))) ; toa do diem cuoi pl

)

)

(setq chkint (car(int spt (car ptlst) ept (last ptlst)))) ;dung ham int de tim giao diem

;2 : Hai doan thang ko // nhung ko cat nhau

(if (or (= chkint 2)(= chkint 4)(= chkint 5)) ;4 : Hai doan thang nam tren 1 dthang nhung ko chong

;5 : Hai doan thang song song

(setq ptlst (append (list(cons 10 spt)) ptlst (list(cons 10 ept)))) ;tao danh sach dinh

(setq ptlst (append (list(cons 10 ept)) ptlst (list(cons 10 spt))))

)

(entmake (list '(0 . "POLYLINE") (assoc 8 (entget ent)))) ;tao doi tuong chinh

(foreach elm ptlst

(entmake (list '(0 . "VERTEX") elm)) ; tao field dinh

)

(entmake '((0 . "SEQEND"))) ;tao field ket thuc

(entdel ent)

(command "convert" "P" "S" (entlast)"")

(princ)

)

 

(defun spvexs ( ent / lst ptlst newlst len i)

(setq lst (member (assoc 11 (entget ent)) (entget ent))) ;Danh sach toa do diem bao gom header 11 moi danh sach con

(setq num (length lst)) ; So ptu trong danh sach

(setq i 0)

(repeat num

(setq ptlst (nth i lst)) ; lay ptu thu i trong danh sach.

(setq ptlst (cdr ptlst)) ; loai bo header cua danh sach diem.

(setq newlst (append newlst (list ptlst))) ;Tao ds moi ko co header.

(setq i (+ i 1))

)

newlst

)

 

(defun plvexs (ent full / lst elm vexlst)

(setq lst (member (assoc 10 (entget ent)) (entget ent))) ;Danh sach toa do co header 10 tro ve sau

(setq lst (rmv_e (assoc 210 lst) lst)) ;Loai bo ma dxf 210

(foreach elm lst

(if (= (car elm) 10)

(setq elm (cdr elm) vexlst (append vexlst (list elm)))

)

)

(if (= full 0) vexlst lst)

)

 

(defun int (A B C D / INTER xA yA xB yB i j i1 temp)

(if (equal (car C)(car D) 0.00005)

(progn

(setq temp A A C C temp)

(setq temp B B D D temp)

)

)

(setq xA (car A) yA (cadr A) xB (car B) yB (cadr B) xC (car C) yC (cadr C) xD (car D) yD (cadr D) )

;Pt tham so AB x = xA + (xB-xA)i

;Diem giao 2 duong thang thoa man he pt sau

; xA + (xB-xA)i = xC + (xD-xC)j va yA + (yB-yA)i = yC + (yD-yC)j

; Khu j duoc : bthuc Q*i=(xC-xA)*(yD-yC)-(yC-yA)*(xD-xC)

;voi Q = (xB-xA)*(yD-yC)-(yB-yA)*(xD-xC)

(setq Q (-(*(- xB xA)(- yD yC))(*(- yB yA)(- xD xC))))

(if (not(equal Q 0.0 0.00001)) ; hai duong thang cat nhau

(progn

(setq i (/ (-(*(- xC xA)(- yD yC))(*(- yC yA)(- xD xC))) Q)) ;tinh tham so i tai diem giao

(setq j (/ (+(- xA xC)(*(- xB xA) i)) (- xD xC))) ;tinh tham so j tai diem giao

(setq INTER (list (+ xA (* (- xB xA) i)) (+ yA (* (- yB yA) i)))); Diem giao

(if (and (>= i -0.00001) (<= i 1.00001) (>= j -0.00001) (<= j 1.00001)) ; Neu diem giao thuoc 2 DOAN thang

(progn (list 1 INTER)) ; tra ve diem giao

(progn (list 2 INTER))

)

)

(progn ; Q = 0 : hai duong thang song song hoac trung nhau

;Pt tong quat cua duong thang AB la : (yB-yA)*(x-xA) - (xB-xA)*(y-yA) = 0

(setq bt (-(*(- yB yA)(- xC xA))(*(- xB xA)(- yC yA))))

(if (equal bt 0.0 0.00001) ; 2 duong thang trung hoac chong nhau

(progn

(setq i (/ (- xC xA) (- xB xA))) ; Tinh tham so i tai diem C tren dt AB

(setq i1 (/ (- xD xA) (- xB xA))) ; Tinh tham so i1 tai diem D tren dt AB

(if (or (and (>= i 0.0) (<= i 1.0)) (and (>= i1 0.0) (<= i1 1.0)) (< (* i i1) 0.0)) ; neu 2 doan chong nhau

(progn (list 3 nil))

(progn (list 4 nil)) ;trung nhung ko chong

)

)

(progn (list 5 nil)) ; Hai duong thang song song tra ve nil

)

) ;dong progn else

)

)

 

(defun rmv_e (e lst )

(if (member e lst)

(progn

(cdr(member e lst));danh sach phia sau

(reverse(cdr(member e (reverse lst))))

(append (reverse(cdr(member e (reverse lst)))) (cdr(member e lst)))

)

nil

)

)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
gia_bach    1.442
Chào các bạn. Mình có một cung tròn, Mình muốn chia nhỏ cung tròn này thành nhiều dây cung (dạng line hay pline) liên tiếp. Các bạn có biết trên cad có lệnh nào chia cung tròn thành nhiều dây cung hay không hoặc các bạn có thể viết giúp mình một cái lisp để làm việc này hay kg. Có hai lựa chọn :

- Một là chia cung tròn thành n đoạn dây cung bằng nhau

- Hai là chia cung tròn thành nhiều dây cung có độ dài cho trước (dây cung cuối cùng có độ dài còn lại)

Mong đc các bác giúp đỡ. Xin cám ơn

Bạn chạy thử lisp chia Curve (LINE,ARC, PLINE và SPLINE hở)

link download

(defun c:DC(/ vl ov Ent isClosed lst_pt dis dis0 bit khcach sodoan p pt ); DC -> Divide Curve
 (vl-load-com)
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
   (not (setq isClosed (vlax-curve-isClosed ent)))
   )
   (progn
     (command "undo" "be")
     (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))           ; Get Old values
     (mapcar 'setvar vl '(0 0 0))
     (or *sodoan* (setq *sodoan* 10))
     (or *khcach* (setq *khcach* 250))
     (setq lst_Pt nil
    dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))  )
     (initget "K D")
     (setq bit (getkword "\nChia theo Khoang cach hay chia deu theo so Doan : " ) )
     (if (= bit "K")
(progn
  (setq khcach (getreal (strcat"\nNhap khoang cach <" (rtos *khcach*) ">:")) )
  (if khcach (setq *khcach* khcach) (setq khcach *khcach*))
  (initget "G B")
  (setq bit (getkword "\nCan Giua hay can tu Bien : " ) )
  (if (= bit "G")
    (progn
      (setvar "osmode" 513)
      (setq p (getpoint (vlax-curve-getPointAtDist Ent (/ dis0 2))"\nDiem bat dau:"))
      (if (< (distance p (vlax-curve-getStartPoint ent))(distance p (vlax-curve-getEndPoint ent)))
	(setq dis 0)
	(setq dis (rem dis0 khcach)) )
      )
    (setq dis (/(rem dis0 khcach)2))
    )	  
  )
(progn
  (setq sodoan (getint (strcat"\nNhap so doan <" (itoa *sodoan*) ">:")) )
  (if sodoan (setq *sodoan* sodoan) (setq sodoan *sodoan*))
  (setq dis 0
	khcach (/ dis0 sodoan) )
  )
)
     (while (< dis dis0)
(setq pt (vlax-curve-getPointAtDist Ent dis)
      dis (+ dis khcach)
      lst_Pt (append lst_Pt (list pt)) )
)
     (if lst_Pt
(foreach pt (reverse lst_Pt)
  (command "._break" ent "_non" (trans pt 0 1) "_non" (trans pt 0 1)) ))
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (if isClosed
     (alert "List khong chay duoc tren doi tuong kin ")
     (alert "Khong chon duoc doi tuong !")))
 (princ))

  • Vote tăng 4

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
xuandao0708    8

Bác giabach ơi, nhờ Bác coi lại dùm em 1 chút lệnh DC khi chạy trên cad 2007 tren máy em thì nó báo như sau:

Command: dc

Chon doi tuong can chia :; error: too many arguments

Không biết là do máy em hay bị lỗi, nhờ Bác coi lại 1 chút dùm em :bigsmile:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
gia_bach    1.442
Bác giabach ơi, nhờ Bác coi lại dùm em 1 chút lệnh DC khi chạy trên cad 2007 tren máy em thì nó báo như sau:

Command: dc

Chon doi tuong can chia :; error: too many arguments

Không biết là do máy em hay bị lỗi, nhờ Bác coi lại 1 chút dùm em :bigsmile:

Có lỗi trong mục Insert codeBox, bạn click vô link download để lấy file.

Chúc thành công

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ndn386    17
Có lỗi trong mục Insert codeBox, bạn click vô link download để lấy file.

Chúc thành công

Chào bác, em thấy Lisp này thật tuyệt, nhưng em chạy không đc bác ạ, em đã làm theo lời bác là down lại link về load nhưng vẫn không được. Bác giúp em với nhé, cảm ơn bác nhiều

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Phiphi-    175
Bạn chạy thử lisp chia Curve (LINE,ARC, PLINE và SPLINE hở)

link download

PP thấy Lisp này nên insert thêm các Point tại các giao điểm với tên layer "Point" riêng nhằm để dể dàng thấy rõ từng đoạn thì better. Thanks.

 

Ref: http://www.cadviet.com/forum/index.php?sho...st=0#entry49554

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×