Đến nội dung


Hình ảnh
- - - - -

[yêu cầu] Lisp đo khoảng cách các điểm trên polyline


  • Please log in to reply
32 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 18 June 2015 - 12:35 AM

Mình muốn làm tự động việc đo chiều dài chi tiết của các thanh thép. nhưng mày mò hoài vẫn chưa được nhờ mọi người giúp đỡ.

Thanh thép là đường polyline có các cung tròn (điểm uốn thép)

Đây là lisp mình lấy từ diễn đàn về có chỉnh sửa lại đôi chút nhưng vẫn đang làn thủ công:

1. Phải chọn điểm đặt cho từng DIM

2. Gặp phải đường cong tròn là phải chọn cung tròn và điểm đặt mới thực hiện được

Nhờ mọi người giúp đỡ để công việc đó được nhanh hơn, chỉ cần chọn polyline và nhập khoảng cách hoặc pick chuột 1 lần

(defun darl (/ e1 e2 ra an alen)
;;
(command "dimradius" pause "")
(setq e1 (entlast))
(command "dimangular" pause (getpoint "\n Chon diem dat "))
(setq e2 (entlast))
(setq Ra (cdr (assoc 42 (entget e1))))
(setq an (cdr (assoc 42 (setq el (entget e2)))))
(setq alen (* ra an))
(entmod (subst (cons 1 (rtos alen 2 2)) (assoc 1 el) el))
(command "erase" e1 "")
)
;;;;;;;;;;;;;;;;;;;
(defun c:dimpo (/ e verl els bulst k i p1 p2 )
(vl-load-com)
(setq e (car (entsel "\n Chon duong can do ")))
(setq verl (acet-geom-vertex-list e)
          els (entget e)
          bulst (list)
          k 0  )
(command "undo" "be")
(foreach en els
         (if (= (car en) 42)
             (setq bulst (append bulst (list (list (nth k verl) (cdr en))))  k (1+ k) )
         )         
)
(foreach bul bulst
      (setq i (vl-position bul bulst)
               p1 (nth i verl)
               p2 (nth (1+ i) verl))
                  
      (if (and p1 p2)
          (progn
                       (if (= (cadr bul) 0)  
                       (command "dimaligned" p1 p2 (getpoint "\n Chon diem dat "))
					   (progn
                       (command "_dimarc" pause (getpoint "\n Chon diem dat "))
					   (command "dimradius" pause "")
					   )
					   ;(darl)
                  )
          )
      )
             
)
(command "undo" "e")
)

Đây là file đính kèmhttp://www.cadviet.c...5/66960_thu.dwg


  • 0

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 June 2015 - 06:37 AM

Quick code:

(defun c:dopl()
  (setq i 0)
  
  (if (setq e (car(entsel "\n Chon Pline : ")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (if (= 0 (vla-GetBulge obj i)) 
  (command "._dimlinear" "_non" (vlax-curve-getstartpoint e) "_non" (vlax-curve-getpointatparam e (1+ i))
   "_non" pause)
  (command "._dimarc" (vlax-curve-getpointatparam e (+ i 0.5)) "_non" pause)
       )
       (setq i (1+ i) ddat (cdr(assoc 10 (entget (entlast)))) dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
       (Repeat (1- (fix (vlax-curve-getEndParam e)))
 (if (= 0 (vla-GetBulge obj i))
    (command "._dimlinear" "_non" (vlax-curve-getpointatparam e i) "_non" (vlax-curve-getpointatparam e (1+ i))
     "_non" (polar (vlax-curve-getpointatparam e (+ i 0.5)) (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis))
    (command "._dimarc" (vlax-curve-getpointatparam e (+ i 0.5))
     "_non" (polar (vlax-curve-getpointatparam e (+ i 0.5)) (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis))
          )
 (setq i (1+ i) ddat (cdr(assoc 10 (entget (entlast)))) )
       )
   )
   )
 )

  • 1

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 18 June 2015 - 08:07 AM

 

Quick code:

(defun c:dopl()
  (setq i 0)
  
  (if (setq e (car(entsel "\n Chon Pline : ")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (if (= 0 (vla-GetBulge obj i)) 
  (command "._dimlinear" "_non" (vlax-curve-getstartpoint e) "_non" (vlax-curve-getpointatparam e (1+ i))
   "_non" pause)
  (command "._dimarc" (vlax-curve-getpointatparam e (+ i 0.5)) "_non" pause)
       )
       (setq i (1+ i) ddat (cdr(assoc 10 (entget (entlast)))) dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
       (Repeat (1- (fix (vlax-curve-getEndParam e)))
 (if (= 0 (vla-GetBulge obj i))
    (command "._dimlinear" "_non" (vlax-curve-getpointatparam e i) "_non" (vlax-curve-getpointatparam e (1+ i))
     "_non" (polar (vlax-curve-getpointatparam e (+ i 0.5)) (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis))
    (command "._dimarc" (vlax-curve-getpointatparam e (+ i 0.5))
     "_non" (polar (vlax-curve-getpointatparam e (+ i 0.5)) (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis))
          )
 (setq i (1+ i) ddat (cdr(assoc 10 (entget (entlast)))) )
       )
   )
   )
 )

Các ơn Bác đã quan tâm đã text nhưng còn 1 vướng mắc có cái đo được có cái đo không được. Qua những lần text phát hiện điểm đặt của dim ở gần polyline thì được (điểm đặt này còn phụ thuộc vào chiều dài đoạn đo)


  • 0

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 June 2015 - 08:44 AM

Các ơn Bác đã quan tâm đã text nhưng còn 1 vướng mắc có cái đo được có cái đo không được. Qua những lần text phát hiện điểm đặt của dim ở gần polyline thì được (điểm đặt này còn phụ thuộc vào chiều dài đoạn đo)

 

Bạn gửi bản vẽ bạn test không được mình xem thử


  • 0

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 18 June 2015 - 09:07 AM

Bạn gửi bản vẽ bạn test không được mình xem thử

file Mình đã test 

http://www.cadviet.c...66960_thu_1.dwg


  • 0

#6 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 18 June 2015 - 04:21 PM

Bạn gửi bản vẽ bạn test không được mình xem thử

Bác Tue_NV xem lại cho em với


  • 0

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 June 2015 - 05:29 PM

 

Trường hợp này không dùng hàm command được.

Bạn test thử code nhé :

(defun c:dopl()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (setq i 0)
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
     (Repeat (fix (vlax-curve-getEndParam e))
       (if (= 0 (vla-GetBulge obj i))
      (vla-AddDimAligned modelSpace
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )

          (vla-AddDimArc modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5))))
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )
        );if
    (setq i (1+ i))
    );Repeat
  );progn
 );if
)

  • 2

#8 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 18 June 2015 - 05:45 PM

 

 

Trường hợp này không dùng hàm command được.

Bạn test thử code nhé :

(defun c:dopl()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (setq i 0)
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
     (Repeat (fix (vlax-curve-getEndParam e))
       (if (= 0 (vla-GetBulge obj i))
      (vla-AddDimAligned modelSpace
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )

          (vla-AddDimArc modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5))))
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )
        );if
    (setq i (1+ i))
    );Repeat
  );progn
 );if
)

Đã ok rồi

Cám ơn Bác


  • 0

#9 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 19 June 2015 - 07:54 AM

Các dim lúc nào cũng bên phải pline theo chiều từ điểm đầu đến cuối là không hợp lý: không phải lúc nào cũng dis  > 0

Test: mirror các pline rồi dùng lisp


  • 0

#10 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 19 June 2015 - 03:04 PM

 

 

Trường hợp này không dùng hàm command được.

Bạn test thử code nhé :

(defun c:dopl()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (setq i 0)
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
     (Repeat (fix (vlax-curve-getEndParam e))
       (if (= 0 (vla-GetBulge obj i))
      (vla-AddDimAligned modelSpace
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )

          (vla-AddDimArc modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5))))
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )
        );if
    (setq i (1+ i))
    );Repeat
  );progn
 );if
)

Hề hề hề,

Bác Tue_NV xem xét giùm vì sao khi tải lisp trên về thì không thể load lisp được. Nhưng khi mình copy code và đổi tên file cho nó thì lại load bình thường.

Khi load được lisp và xài thử thì lại bị thông báo rằng không có lệnh (vla-adddimarc ......... ) bác ạ.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#11 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 19 June 2015 - 03:53 PM

Các dim lúc nào cũng bên phải pline theo chiều từ điểm đầu đến cuối là không hợp lý: không phải lúc nào cũng dis  > 0

Test: mirror các pline rồi dùng lisp

 Cái này phục vụ cho công việc của e đã ok rồi.

Bác có thể viết cho em thêm đo bán kính nữa thì quá tuyệt


  • 0

#12 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 June 2015 - 04:12 PM

Hề hề hề,

Bác Tue_NV xem xét giùm vì sao khi tải lisp trên về thì không thể load lisp được. Nhưng khi mình copy code và đổi tên file cho nó thì lại load bình thường.

Khi load được lisp và xài thử thì lại bị thông báo rằng không có lệnh (vla-adddimarc ......... ) bác ạ.

 

Có thể Bác Bình sài CAD2004 thì không có hàm này!

 

@huunhan: Có Trường hợp thì Pline bị đảo chiều có thể không như ý muốn.

Có lẽ mình sẽ viết lại theo kiểu chọn hướng ghi Dim sẽ ok hơn

- Bạn muốn viết thêm TH đo Bán kính: Trường hợp khi gặp cung thì vừa đo chiều dài cung , vừa đo bán kính hay sao? Bạn vui lòng upload file nhé!


  • 1

#13 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 19 June 2015 - 04:25 PM

Có thể Bác Bình sài CAD2004 thì không có hàm này!

 

@huunhan: Có Trường hợp thì Pline bị đảo chiều có thể không như ý muốn.

Có lẽ mình sẽ viết lại theo kiểu chọn hướng ghi Dim sẽ ok hơn

- Bạn muốn viết thêm TH đo Bán kính: Trường hợp khi gặp cung thì vừa đo chiều dài cung , vừa đo bán kính hay sao? Bạn vui lòng upload file nhé!

Hề hề hề, 

Thank bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì tốt hơn nhiều.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#14 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 June 2015 - 04:33 PM

Hề hề hề, 

Thank bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì tốt hơn nhiều.

 

Theo em biết thì hình như lệnh dimarc có từ CAD2007 nên hàm (vla-adddimarc ......... ) có từ CAD2007

Em không dùng CAD2004 nên không biết có hàm nào thay thế hết bác ạ

Bác nên dùng CAD2008 sẽ bổ sung nhiều hàm vla-... sẽ thuận tiện sử dụng hơn


  • 0

#15 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 19 June 2015 - 04:53 PM

Có thể Bác Bình sài CAD2004 thì không có hàm này!

 

@huunhan: Có Trường hợp thì Pline bị đảo chiều có thể không như ý muốn.

Có lẽ mình sẽ viết lại theo kiểu chọn hướng ghi Dim sẽ ok hơn

- Bạn muốn viết thêm TH đo Bán kính: Trường hợp khi gặp cung thì vừa đo chiều dài cung , vừa đo bán kính hay sao? Bạn vui lòng upload file nhé!

Tr­ường hợp gặp cung thì vừa đo cung vừa đo bán kính luôn 

gửi bác file

http://www.cadviet.c...66960_thu_1.dwg

 


  • 0

#16 snowman.hms

snowman.hms

    biết vẽ ellipse

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

Đã gửi 19 June 2015 - 05:40 PM

Hề hề hề, 

Thank bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì tốt hơn nhiều.

Có thể dùng VLA-AddDimAngular và vla-put-TextOverride property


  • 0

#17 snowman.hms

snowman.hms

    biết vẽ ellipse

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

Đã gửi 19 June 2015 - 05:45 PM

Các dim lúc nào cũng bên phải pline theo chiều từ điểm đầu đến cuối là không hợp lý: không phải lúc nào cũng dis  > 0

Test: mirror các pline rồi dùng lisp

Thế nào cho "hợp lý" hả ndtnv? đặc biệt là với những pline "oằn tà là vằn" :D


  • 0

#18 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 19 June 2015 - 08:24 PM

Lisp của bạn Tue_NV chỉ áp dụng cho bản vẽ của huunhantvxdts . Trường hợp với Hình vẽ mirror như ndtnv nói và khi convert vị trí điểm đầu và cuối của Pline thì lisp chạy không còn như ý muốn nữa :)

http://www.cadviet.c...397_dopl111.dwg


  • 2

#19 snowman.hms

snowman.hms

    biết vẽ ellipse

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

Đã gửi 19 June 2015 - 09:35 PM

(defun c:ad (/ _dxf _mid _Lw->lst LM:BulgeCentre _DimArc _DimAligned
	     *error* doc spc s i e el typ p1 p2 pt cen r a1 a2 l)

  (defun _dxf (code el) (cdr (assoc code el)))
  
  (defun _mid (p1 p2 /) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
  
  (defun _Lw->lst (e / o p1 p2 mid b pr lst)
    (setq o  (vlax-ename->vla-object e)
	  pr -1
    )
    (repeat (fix (vlax-curve-getEndParam o))
      (setq
	p1  (vlax-curve-getpointatparam o (setq pr (1+ pr)))
	p2  (vlax-curve-getpointatparam o (1+ pr))
	mid (vlax-curve-getpointatparam o (+ pr 0.5))
	b   (vla-getbulge o pr)
	lst (cons (list p1 p2 mid b) lst)
      )
    )
    (reverse lst)
  )
  
  ;; Bulge Centre  -  Lee Mac 2012
  ;; p1 - start vertex
  ;; p2 - end vertex
  ;; b  - bulge
  ;; Returns the centre of the arc described by the given bulge and
  ;; vertices

  (defun LM:BulgeCentre	(p1 p2 b)
    (polar p1
	   (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
	   (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
    )
  )
  
  (defun _DimArc (spc cen p1 p2 parc)
    (vlax-invoke  spc 'addDimArc cen p1 p2 parc)
  )
  
  (defun _DimAligned (spc p1 p2 pt)
    (vlax-invoke spc 'adddimaligned p1 p2 pt)
  )
  
  (defun *error* (msg)
    
    (and doc (vla-endundomark doc))
    (if	(and msg
	     (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
	)
      (princ (strcat "\nError: " msg))
    )
  )
  
  ;;===========================MAIN================================;;

  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        spc (vlax-get doc
		      (if (eq (getvar 'CVPORT) 1)
			'Paperspace
			'Modelspace
		      )
	    )
  )
  (if  (setq	i -1
		s (ssget '((0 . "LINE,ARC,LWPOLYLINE")))
       )
    (progn (vla-startundomark doc)
      (repeat (sslength s)
	(setq e	  (ssname s (setq i (1+ i)))
	      el (entget e)
	      typ (cdr (assoc 0 (entget e)))
	)
	(cond
	  ((equal typ "LINE")
	   (setq p1 (_dxf 10 el)
		 p2 (_dxf 11 el)
		 pt (_mid p1 p2)
	   )
	   (_DimAligned spc p1 p2 pt)
	  )
	  ((equal typ "LWPOLYLINE")
	   (setq l (_Lw->lst e))
	   (foreach l1 l
	     (if (/= (cadddr l1) 0.0)
	       (_DimArc	spc
			(LM:BulgeCentre
			  (car l1)
			  (cadr l1)
			  (cadddr l1)
			)
			(car l1) (cadr l1) (caddr l1)
	       )
	       (_DimAligned spc (car l1) (cadr l1) (caddr l1))
	     )
	   )
	  )
	  ((equal typ "ARC")
	   (setq cen (_dxf 10 el)
		 r   (_dxf 40 el)
		 a1  (_dxf 50 el)
		 a2  (_dxf 51 el)
		 p1  (polar cen a1 r)
		 p2  (polar cen a2 r)
		 pt  (polar cen (/ (- a2 a1) 2) r)
	   )
	   (_DimArc spc cen p1 p2 pt)
	  )
	)
      )
    )
  )
  (*error* nil)
  (princ)
)
(vl-load-com)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;


  • 2

#20 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 19 June 2015 - 09:56 PM

(defun c:ad (/ _dxf _mid _Lw->lst LM:BulgeCentre _DimArc _DimAligned
	     *error* doc spc s i e el typ p1 p2 pt cen r a1 a2 l)

  (defun _dxf (code el) (cdr (assoc code el)))
  
  (defun _mid (p1 p2 /) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
  
  (defun _Lw->lst (e / o p1 p2 mid b pr lst)
    (setq o  (vlax-ename->vla-object e)
	  pr -1
    )
    (repeat (fix (vlax-curve-getEndParam o))
      (setq
	p1  (vlax-curve-getpointatparam o (setq pr (1+ pr)))
	p2  (vlax-curve-getpointatparam o (1+ pr))
	mid (vlax-curve-getpointatparam o (+ pr 0.5))
	b   (vla-getbulge o pr)
	lst (cons (list p1 p2 mid b) lst)
      )
    )
    (reverse lst)
  )
  
  ;; Bulge Centre  -  Lee Mac 2012
  ;; p1 - start vertex
  ;; p2 - end vertex
  ;; b  - bulge
  ;; Returns the centre of the arc described by the given bulge and
  ;; vertices

  (defun LM:BulgeCentre	(p1 p2 b)
    (polar p1
	   (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
	   (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
    )
  )
  
  (defun _DimArc (spc cen p1 p2 parc)
    (vlax-invoke  spc 'addDimArc cen p1 p2 parc)
  )
  
  (defun _DimAligned (spc p1 p2 pt)
    (vlax-invoke spc 'adddimaligned p1 p2 pt)
  )
  
  (defun *error* (msg)
    
    (and doc (vla-endundomark doc))
    (if	(and msg
	     (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
	)
      (princ (strcat "\nError: " msg))
    )
  )
  
  ;;===========================MAIN================================;;

  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        spc (vlax-get doc
		      (if (eq (getvar 'CVPORT) 1)
			'Paperspace
			'Modelspace
		      )
	    )
  )
  (if  (setq	i -1
		s (ssget '((0 . "LINE,ARC,LWPOLYLINE")))
       )
    (progn (vla-startundomark doc)
      (repeat (sslength s)
	(setq e	  (ssname s (setq i (1+ i)))
	      el (entget e)
	      typ (cdr (assoc 0 (entget e)))
	)
	(cond
	  ((equal typ "LINE")
	   (setq p1 (_dxf 10 el)
		 p2 (_dxf 11 el)
		 pt (_mid p1 p2)
	   )
	   (_DimAligned spc p1 p2 pt)
	  )
	  ((equal typ "LWPOLYLINE")
	   (setq l (_Lw->lst e))
	   (foreach l1 l
	     (if (/= (cadddr l1) 0.0)
	       (_DimArc	spc
			(LM:BulgeCentre
			  (car l1)
			  (cadr l1)
			  (cadddr l1)
			)
			(car l1) (cadr l1) (caddr l1)
	       )
	       (_DimAligned spc (car l1) (cadr l1) (caddr l1))
	     )
	   )
	  )
	  ((equal typ "ARC")
	   (setq cen (_dxf 10 el)
		 r   (_dxf 40 el)
		 a1  (_dxf 50 el)
		 a2  (_dxf 51 el)
		 p1  (polar cen a1 r)
		 p2  (polar cen a2 r)
		 pt  (polar cen (/ (- a2 a1) 2) r)
	   )
	   (_DimArc spc cen p1 p2 pt)
	  )
	)
      )
    )
  )
  (*error* nil)
  (princ)
)
(vl-load-com)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;

Đã đo được PL không phụ thuộc vào điểm đầu và điểm cuối

Bạn bổ sung thêm điểm đặt nữa chứ còn đo trên đường pl thì không hợp lý tí nào

Bạn có thể làm đo thêm bán kính cung tròn luôn nhé


  • 0