Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp dim góc vát


  • Please log in to reply
23 replies to this topic

#1 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 09 July 2013 - 10:02 AM

Chào mọi người!

 

Mình có vấn đề này nhờ mọi người giúp đỡ. Hiện mình đang cần lisp có thể dim góc vát tại các ngã giao, mình search trên forum không có, mà viết thì mình chịu thua mấy cái dim này nên nhờ mọi người giúp.

Yêu cầu:

 - Dimalign góc vát với chân dim và đường line Dim trùng nhau tại vị trí đổi góc của góc vát (Hình vẽ).

 - Dim được các góc vát trên Polyline kín.

 

Thanks.

 

67034_dim_goc_vat.jpg

 


  • 0

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#2 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 09 July 2013 - 03:35 PM

Có lẽ đây là thứ bạn cần :
(Chịu kho pick điểm 1 tý cho lành. còn chọn hàng loạt pline rất không ổn vì hay phát sinh những điểm rất xa)
 
(defun c:dimvg (/ osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 goc1 goc2 canh1 canh2)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 1)
  (setq p1 (getpoint "\nPick diem 1 :") p2 (getpoint "\nPick diem 2 :") p3 (getpoint "\nPick diem 3 :") p4 (getpoint "\nPick diem 4 :"))
  (setq pt1 nil pt2 nil)
  (setvar "osmode" 0)
  (if (setq intp (inters p1 p2 p3 p4 nil))
    (progn
      (setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
      (setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
      (cond
        ((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
        ((and (and (equal ai1 a1 0.00001) (> di1 d1)) (/= ai2 a2)) (setq pt1 p2 pt2 p3))
        ((and (/= ai1 a1) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p1 pt2 p4))
        ((and (/= ai1 a1) (/= ai2 a2)) (setq pt1 p1 pt2 p3))
        (T (setq pt1 nil pt2 nil))
        );cond
      (if (and pt1 pt2)
        (progn
          (setq goc1 (angle pt1 intp) goc2 (angle pt2 intp) canh1 (distance pt1 intp) canh2 (distance pt2 intp))
          (command "donut" "0.0" 0.25 intp "") (command "donut" "0.0" 0.25 pt1 "") (command "donut" "0.0" 0.25 pt2 "")
          (entmod (entmake (list (cons 0 "LINE")  (cons 100 "AcDbLine") (list 10 (nth 0 pt1) (nth 1 pt1) (nth 2 pt1)) (list 11 (nth 0 intp) (nth 1 intp) (nth 2 intp)))))
          (entmod (entmake (list (cons 0 "LINE")  (cons 100 "AcDbLine") (list 10 (nth 0 intp) (nth 1 intp) (nth 2 intp)) (list 11 (nth 0 pt2) (nth 1 pt2) (nth 2 pt2)))))
          (if (or (<= (* (/ goc1 pi) 180) 90) (>= (* (/ goc1 pi) 180) 270))
            (command ".text" "M" (polar (polar pt1 goc1 (/ canh1 2.0)) (+ goc1 (/ Pi 2.0)) 1.0) 1.0 (* (/ goc1 pi) 180) (rtos canh1 2 2) "")
            (command ".text" "M" (polar (polar pt1 goc1 (/ canh1 2.0)) (- goc1 (/ Pi 2.0)) 1.0) 1.0 (- (* (/ goc1 pi) 180) 180) (rtos canh1 2 2) "")
            )
          (if (or (<= (* (/ goc2 pi) 180) 90) (>= (* (/ goc2 pi) 180) 270))
            (command ".text" "M" (polar (polar pt2 goc2 (/ canh2 2.0)) (+ goc2 (/ Pi 2.0)) 1.0) 1.0 (* (/ goc2 pi) 180) (rtos canh2 2 2) "")
            (command ".text" "M" (polar (polar pt2 goc2 (/ canh2 2.0)) (- goc2 (/ Pi 2.0)) 1.0) 1.0 (- (* (/ goc2 pi) 180) 180) (rtos canh2 2 2) "")
            )
          )
        (princ "\nGoc vat khong hop le !"))
      );prgn
    (princ "\nHai doan thang song song !"));if
  (setvar "osmode" osm))

  • 2

#3 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 12 July 2013 - 10:57 AM

Thanks a.

 

Mấy hôm nay bận quá nên không lên diễn đàn được. Cám ơn a về cái lisp, có điều lisp này không phù hợp với yêu cầu của e rồi ^^, e cần dimension luôn chứ không phải pline và text a ah.

 

Lisp mà e nhờ mọi người viết là tự dim góc vát chứ không phải là chọn điểm đâu a.


  • 0

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#4 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 12 July 2013 - 04:25 PM

Không biết đề bài ra khó hay thiếu dữ liệu mà thấy không có ai giúp mình cả...hix hix


  • -1

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#5 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 12 July 2013 - 04:36 PM

Chắc có lẽ là đề khó:

1). Giả dụ pline kín là 1 polygon thì góc vát là cái nào?

2). Giả dụ pline kín là 1 đa tuyến lõm thì góc vát là cái nào?

3). TextDim to nhỏ, dot dim nhỏ to?

4). Thậm chí cũng không có file cad?

5). v.v và v.v...

Cố gắng ra đề để sao cho người khác hiểu hết, chứ đừng như đề thi hàng năm, lúc nào cũng có sai.


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


#6 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 12 July 2013 - 05:04 PM

Chắc có lẽ là đề khó:

1). Giả dụ pline kín là 1 polygon thì góc vát là cái nào?

2). Giả dụ pline kín là 1 đa tuyến lõm thì góc vát là cái nào?

3). TextDim to nhỏ, dot dim nhỏ to?

4). Thậm chí cũng không có file cad?

5). v.v và v.v...

Cố gắng ra đề để sao cho người khác hiểu hết, chứ đừng như đề thi hàng năm, lúc nào cũng có sai.

 

Thanks a

 

Vấn đề là vậy, nếu là polygon hoặc da tuyến lõm thì vát tại các vị trí thay đổi góc tuyến 2 lần.

Còn về phần Dim to nhỏ hay dot dim thì e nghĩ nó không quan trọng lắm vì cái đó tùy thuộc vào hiệu chỉnh Dimstyle nên cũng không gửi file cad lên.

Còn đây là file CAD, nhờ a xem thử giúp nhé.http://www.cadviet.c...034_cadviet.dwg


  • 0

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#7 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 13 July 2013 - 05:06 PM

Thanks a.
 
Mấy hôm nay bận quá nên không lên diễn đàn được. Cám ơn a về cái lisp, có điều lisp này không phù hợp với yêu cầu của e rồi ^^, e cần dimension luôn chứ không phải pline và text a ah.
 
Lisp mà e nhờ mọi người viết là tự dim góc vát chứ không phải là chọn điểm đâu a.

Thôi thì thế này nhé :

(defun vatgoc_tinhtoan (a b c d / osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
(setq pt1 nil pt2 nil p1 a p2 b p3 c p4 d)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(if (setq intp (inters p1 p2 p3 p4 nil))
(progn
(setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
(setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
(cond
((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
(T (setq pt1 nil pt2 nil))
);cond
);prgn
);if
(setvar "osmode" osm)
(if (and pt1 pt2) (setq kqua (list pt1 pt2 intp))))
;-------------------------
(defun c:vatgoc_dimaligned (/ i Egss k cl lstpt vg lst_vg t1 p1 diem n )
(setq i 0)
(setq Egss (entget (car (entsel "\nChon pline :" ))))
(setq k (cdr (assoc 90 Egss)) cl (cdr (assoc 70 Egss)))
(setq lstpt '() vg '() lst_vg '())
(setq i 1)
(while (<= i k)
(progn
(setq t1 (member (assoc 10 Egss) Egss))
(setq p1 (car t1))
(setq Egss (cdr t1))
(setq diem (cdr p1))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq k (length lstpt))
(if (< k 4) (exit))
(if (= cl 1) (setq lstpt (append lstpt (list (nth 0 lstpt)(nth 1 lstpt) (nth 2 lstpt)))))
(if (and (= cl 0) (equal (nth 0 lstpt) (nth (- k 1) lstpt)))
(setq lstpt (append lstpt (list (nth 1 lstpt) (nth 2 lstpt)))))
(setq k (length lstpt))
(setq n 0)
(while (< n (- k 3))
(repeat 4 (setq vg (append vg (list (nth n lstpt)))) (setq n (1+ n)))
(setq lst_vg (append lst_vg (list vg)) vg '())
(setq n (- n 3))
)
(setq k (length lst_vg) n 0)
(repeat k
(if (setq vgtt (vatgoc_tinhtoan (nth 0 (nth n lst_vg)) (nth 1 (nth n lst_vg)) (nth 3 (nth n lst_vg)) (nth 2 (nth n lst_vg))))
(progn (command "dimaligned" (nth 0 vgtt) (nth 2 vgtt)(nth 2 vgtt))
(command "dimaligned" (nth 1 vgtt) (nth 2 vgtt)(nth 2 vgtt)))
)
(setq n (1+ n))
)
)

PS: Dimstyle bạn tự khai báo phù hợp là đc[/lisp]
  • 1

#8 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 16 July 2013 - 08:12 AM

Thôi thì thế này nhé :


(defun vatgoc_tinhtoan (a b c d / osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
(setq pt1 nil pt2 nil p1 a p2 b p3 c p4 d)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(if (setq intp (inters p1 p2 p3 p4 nil))
(progn
(setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
(setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
(cond
((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
(T (setq pt1 nil pt2 nil))
);cond
);prgn
);if
(setvar "osmode" osm)
(if (and pt1 pt2) (setq kqua (list pt1 pt2 intp))))
;-------------------------
(defun c:vatgoc_dimaligned (/ i Egss k cl lstpt vg lst_vg t1 p1 diem n )
(setq i 0)
(setq Egss (entget (car (entsel "\nChon pline :" ))))
(setq k (cdr (assoc 90 Egss)) cl (cdr (assoc 70 Egss)))
(setq lstpt '() vg '() lst_vg '())
(setq i 1)
(while (<= i k)
(progn
(setq t1 (member (assoc 10 Egss) Egss))
(setq p1 (car t1))
(setq Egss (cdr t1))
(setq diem (cdr p1))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq k (length lstpt))
(if (< k 4) (exit))
(if (= cl 1) (setq lstpt (append lstpt (list (nth 0 lstpt)(nth 1 lstpt) (nth 2 lstpt)))))
(if (and (= cl 0) (equal (nth 0 lstpt) (nth (- k 1) lstpt)))
(setq lstpt (append lstpt (list (nth 1 lstpt) (nth 2 lstpt)))))
(setq k (length lstpt))
(setq n 0)
(while (< n (- k 3))
(repeat 4 (setq vg (append vg (list (nth n lstpt)))) (setq n (1+ n)))
(setq lst_vg (append lst_vg (list vg)) vg '())
(setq n (- n 3))
)
(setq k (length lst_vg) n 0)
(repeat k
(if (setq vgtt (vatgoc_tinhtoan (nth 0 (nth n lst_vg)) (nth 1 (nth n lst_vg)) (nth 3 (nth n lst_vg)) (nth 2 (nth n lst_vg))))
(progn (command "dimaligned" (nth 0 vgtt) (nth 2 vgtt)(nth 2 vgtt))
(command "dimaligned" (nth 1 vgtt) (nth 2 vgtt)(nth 2 vgtt)))
)
(setq n (1+ n))
)
)

PS: Dimstyle bạn tự khai báo phù hợp là đc[/lisp]

 

Thanks a nhiều

Đúng là nó chạy tùm lum thiệt,hi. Dù sao xóa cũng nhanh hơn là phải canh dim a ah....hi


  • 0

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#9 quochuyksxd

quochuyksxd

    biết lệnh fillet

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

Đã gửi 24 July 2013 - 08:16 AM

Sao mi

 

Thôi thì thế này nhé :


(defun vatgoc_tinhtoan (a b c d / osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
(setq pt1 nil pt2 nil p1 a p2 b p3 c p4 d)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(if (setq intp (inters p1 p2 p3 p4 nil))
(progn
(setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
(setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
(cond
((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
(T (setq pt1 nil pt2 nil))
);cond
);prgn
);if
(setvar "osmode" osm)
(if (and pt1 pt2) (setq kqua (list pt1 pt2 intp))))
;-------------------------
(defun c:vatgoc_dimaligned (/ i Egss k cl lstpt vg lst_vg t1 p1 diem n )
(setq i 0)
(setq Egss (entget (car (entsel "\nChon pline :" ))))
(setq k (cdr (assoc 90 Egss)) cl (cdr (assoc 70 Egss)))
(setq lstpt '() vg '() lst_vg '())
(setq i 1)
(while (<= i k)
(progn
(setq t1 (member (assoc 10 Egss) Egss))
(setq p1 (car t1))
(setq Egss (cdr t1))
(setq diem (cdr p1))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq k (length lstpt))
(if (< k 4) (exit))
(if (= cl 1) (setq lstpt (append lstpt (list (nth 0 lstpt)(nth 1 lstpt) (nth 2 lstpt)))))
(if (and (= cl 0) (equal (nth 0 lstpt) (nth (- k 1) lstpt)))
(setq lstpt (append lstpt (list (nth 1 lstpt) (nth 2 lstpt)))))
(setq k (length lstpt))
(setq n 0)
(while (< n (- k 3))
(repeat 4 (setq vg (append vg (list (nth n lstpt)))) (setq n (1+ n)))
(setq lst_vg (append lst_vg (list vg)) vg '())
(setq n (- n 3))
)
(setq k (length lst_vg) n 0)
(repeat k
(if (setq vgtt (vatgoc_tinhtoan (nth 0 (nth n lst_vg)) (nth 1 (nth n lst_vg)) (nth 3 (nth n lst_vg)) (nth 2 (nth n lst_vg))))
(progn (command "dimaligned" (nth 0 vgtt) (nth 2 vgtt)(nth 2 vgtt))
(command "dimaligned" (nth 1 vgtt) (nth 2 vgtt)(nth 2 vgtt)))
)
(setq n (1+ n))
)
)

PS: Dimstyle bạn tự khai báo phù hợp là đc[/lisp]

Sao khi sử dụng với pline kín thì không được bác ah. bác có thể khắc phục được không?


  • 0

#10 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 24 July 2013 - 08:32 AM

Sao mi
 
Sao khi sử dụng với pline kín thì không được bác ah. bác có thể khắc phục được không?

Mình vừa kiểm tra trên máy thì thấy chạy đc pline kín mà. Bạn lưu ý Polyline và Region.Chương trình không chạy đc cho Region đâu !
Có gì post file của bạn lên mình xem thử nhé
  • 0

#11 quochuyksxd

quochuyksxd

    biết lệnh fillet

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

Đã gửi 24 July 2013 - 08:43 AM

Đây bạn ơi. nhờ bạn kiểm tra dùm cáihttp://www.cadviet.c...3/100618_vd.dwg


  • 0

#12 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 24 July 2013 - 11:08 AM

Đây bạn ơi. nhờ bạn kiểm tra dùm cáihttp://www.cadviet.c...3/100618_vd.dwg

Đó là region mà bạn. Pline kín có 2 dạng :
hoặc đó là closing polyline
hoặc là Polyline mà có diểm cuối trùng với điểm đầu :)
(Nghĩa là mình dùng lệnh pline nối trở về điểm khởi đầu mà không dùng "c" để đóng pline)
  • 0

#13 quochuyksxd

quochuyksxd

    biết lệnh fillet

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

Đã gửi 24 July 2013 - 02:47 PM

Đó là region mà bạn. Pline kín có 2 dạng :
hoặc đó là closing polyline
hoặc là Polyline mà có diểm cuối trùng với điểm đầu :)
(Nghĩa là mình dùng lệnh pline nối trở về điểm khởi đầu mà không dùng "c" để đóng pline)

Thanhk bạn nhé. mình hiểu rồi. ứng dụng lisp rất hữu ích khi làm quy hoạch chia lô


  • 0

#14 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 25 July 2013 - 02:25 PM

Xem chủ đề thấy hay hay nên test thử thì thấy code của bạn TaiNguyen79 có lỗi sau:
- Mã dxf 70 của pline là  (bit-coded) nên nếu = 0, 128 open; = 1, 129 closed
- osmode phải để ở hàm chính (có lẽ lúc đầu bạn vẽ dim trong hàm con)
- Ngoài ra code có nhiều đoạn không cần thiết như:
  + Khi gọi hàm vatgoc_tinhtoan các biến trung gian a b c d thừa
  + Tạo list lst_vg chiếm bộ nhớ gần 4 lần lstpt, khi dùng lại phải truy xuất qua 2 cấp.
Dù sao thì lisp này cũng có thuật toán hay như thuật toán lính canh để xử lý closed pline
Sau đây là lisp tôi sửa, cải tiến lại.

(defun vatgoc_tinhtoan (p1 p2 p3 p4 / intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
    (if (setq intp (inters p1 p2 p3 p4 nil))
    (progn
        (setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
        (setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
        (if (and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2)))
            (setq kqua intp))))
    kqua
)
;-------------------------
(defun c:vd ( / Egss k cl lstpt t1 p1 diem n osm vgtt); c:vatgoc_dimaligned
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (setq Egss (entget (car (entsel "\nChon pline :" ))))
    (setq k (cdr (assoc 90 Egss)) cl (rem (cdr (assoc 70 Egss)) 2))
    (repeat k
        (progn
            (setq t1 (member (assoc 10 Egss) Egss))
            (setq p1 (car t1))
            (setq Egss (cdr t1))
            (setq diem (cdr p1))
            (setq lstpt (append lstpt (list diem)))
            ));while
    (if (< (setq k (length lstpt)) 4) (exit))
    (if (= cl 1) (setq lstpt (append lstpt (list (nth 0 lstpt)(nth 1 lstpt) (nth 2 lstpt))))
        (if (equal (nth 0 lstpt) (nth (- k 1) lstpt))
                (setq lstpt (append lstpt (list (nth 1 lstpt) (nth 2 lstpt)))))        )
    
    (setq n 0 k (- (length lstpt) 3))
    (repeat k
    (if (setq vgtt (vatgoc_tinhtoan (nth n lstpt) (nth (+ n 1) lstpt) (nth (+ n 3) lstpt) (nth (+ n 2) lstpt)))
        (progn (command "dimaligned" (nth (+ n 1) lstpt) vgtt vgtt)
            (command "dimaligned" (nth (+ n 2) lstpt) vgtt vgtt))
    )
    (setq n (1+ n))
    )
    (setvar "osmode" osm)
)

  • 1

#15 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 25 July 2013 - 03:55 PM

1). Hàm con vatgoc_tinhtoan còn thừa những 4 hàm nữa cơ!

2). Bạn có thể chỉ cho mình biết khi nào thì pline có thêm 128 nhé?


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


#16 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 25 July 2013 - 03:58 PM

Xem chủ đề thấy hay hay nên test thử thì thấy code của bạn TaiNguyen79 có lỗi sau:
- Mã dxf 70 của pline là  (bit-coded) nên nếu = 0, 128 open; = 1, 129 closed
- osmode phải để ở hàm chính (có lẽ lúc đầu bạn vẽ dim trong hàm con)
- Ngoài ra code có nhiều đoạn không cần thiết như:
  + Khi gọi hàm vatgoc_tinhtoan các biến trung gian a b c d thừa
  + Tạo list lst_vg chiếm bộ nhớ gần 4 lần lstpt, khi dùng lại phải truy xuất qua 2 cấp.
Dù sao thì lisp này cũng có thuật toán hay như thuật toán lính canh để xử lý closed pline
Sau đây là lisp tôi sửa, cải tiến lại.

Cảm ơn bạn TNV đã sửa code.
  • 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 25 July 2013 - 04:09 PM

Hàm con này bỏ bớt đi 4 hàm, chắc sẽ chạy nhanh hơn?

(defun vatgoc_tinhtoan (p1 p2 p3 p4 / intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
 (if (setq intp (inters p1 p2 p3 p4 nil))
  (and
   (setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
   (setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
   (equal ai1 a1 0.00001)
   (> di1 d1)
   (equal ai2 a2 0.00001)
   (> di2 d2)
   (setq kqua intp)))
 kqua)
 

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

ndtnv

    biết lệnh minsert

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

Đã gửi 25 July 2013 - 04:12 PM

1). Hàm con vatgoc_tinhtoan còn thừa những 4 hàm nữa cơ!

2). Bạn có thể chỉ cho mình biết khi nào thì pline có thêm 128 nhé?

 

1. Đương nhiên là còn nhiều chổ khác có thể rút gọn, nhưng tốn thời gian

2. Bạn tham khảo bản vẽ sau

http://www.cadviet.c...19626_dxf70.dwg


  • 1

#19 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 25 July 2013 - 04:13 PM

Hàm con này bỏ bớt đi 4 hàm, chắc sẽ chạy nhanh hơn?

(defun vatgoc_tinhtoan (p1 p2 p3 p4 / intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
 (if (setq intp (inters p1 p2 p3 p4 nil))
  (and
   (setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
   (setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
   (equal ai1 a1 0.00001)
   (> di1 d1)
   (equal ai2 a2 0.00001)
   (> di2 d2)
   (setq kqua intp)))
 kqua)
 


Vầy hả : :)

(defun vatgoc_tinhtoan (p1 p2 p3 p4 / intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
(if (setq intp (inters p1 p2 p3 p4 nil))
(if (and (and (equal (angle p1 intp) (angle p1 p2) 0.00001)(> (distance p1 intp) (distance p1 p2)))
(and (equal (angle p3 intp) (angle p3 p4) 0.00001)(> (distance p3 intp) (distance p3 p4))))
(setq kqua intp))) kqua)

Cũng vậy thôi !
  • 0

#20 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 25 July 2013 - 04:16 PM


Cũng vậy thôi !

Bạn tham khảo code mà tôi vừa post ở trên.


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