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

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

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

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.com/upfiles/5/66960_thu.dwg

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
Tue_NV    3.841

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

 

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)

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
Tue_NV    3.841

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ử

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
Tue_NV    3.841
 

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
)
  • Vote tăng 2

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

 

 

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

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

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

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
phamthanhbinh    3.123

 

 

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

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

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

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
Tue_NV    3.841

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é!

  • 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
phamthanhbinh    3.123

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.

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
Tue_NV    3.841

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

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

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.com/upfiles/5/66960_66960_thu_1.dwg

 

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
snowman.hms    30

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

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
snowman.hms    30

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

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
pphung183    425

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.com/upfiles/5/127397_dopl111.dwg

  • Vote tăng 2

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
snowman.hms    30

(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! ***|;

  • Vote tăng 2

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


(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é

 

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
quocmanh04tt    385

Mạn phép bác Tue_NV sửa lại chút xíu (và thêm dim Radial). Phần đặt dim phía trên hay dưới (trái phải) chỉ cũng tương đối ... Có gì các bác bổ sung:

(defun c:dopl (/ acadobj ddat dis doc e i modelspace obj ang ang1 ang2 m etype LM:BulgeCenter)
(defun LM:BulgeCenter (p1 p2 B)
(polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan B)))) (/ (* (distance p1 p2) (1+ (* b B))) 4 B)))
(defun etype (e / x)
(or (setq x (entget e)) (and (setq x (entget (entdel e))) (entdel e)))
(cdr (assoc 0 x)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(setq i 0)
(if (setq e (car (entsel "\nChon Pline: ")))
(if (wcmatch (etype e) "*POLYLINE")
(if (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem):"))
(progn (setq ang1 (angle (vlax-curve-getstartpoint e) (vlax-curve-getpointatparam e (1+ i)))
ang2 (angle (vlax-curve-getstartpoint e) ddat)
ang (- ang2 ang1))
(cond ((= ang1 0)
(cond ((< ang2 (* pi 1.0)) (setq m -2.0))
(t (setq m +2.0))))
((= ang1 (* pi 0.5))
(cond ((< ang2 (* pi 0.5)) (setq m +2.0))
((> ang2 (* pi 1.5)) (setq m +2.0))
(t (setq m -2.0))))
((= ang1 (* pi 1.0))
(cond ((< ang2 (* pi 1.0)) (setq m +2.0))
((> ang2 (* pi 2.0)) (setq m -2.0))
(t (setq m -2.0))))
((= ang1 (* pi 1.5))
(cond ((< ang2 (* pi 0.5)) (setq m -2.0))
((< ang2 (* pi 1.5)) (setq m +2.0))
((> ang2 (* pi 1.5)) (setq m -2.0))
(t (setq m -2.0))))
(t
(cond ((< ang (* pi 0.0)) (setq m +2.0))
((< ang (* pi 1.0)) (setq m -2.0))
((< ang (* pi 2.0)) (setq m +2.0)))))
(setq obj (vlax-ename->vla-object e))
(setq dis (distance ddat (vlax-curve-getstartpoint e)))
(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 m))
dis)))
(progn (vla-adddimarc modelSpace
(vlax-3d-point (LM:BulgeCenter (vlax-curve-getpointatparam e i)
(vlax-curve-getpointatparam e (1+ i))
(vla-getbulge obj i)))
(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 m))
dis)))
(vla-adddimradial modelSpace
(vlax-3d-point (LM:BulgeCenter (vlax-curve-getpointatparam e i)
(vlax-curve-getpointatparam e (1+ i))
(vla-getbulge obj i)))
(vlax-3d-point (vlax-curve-getpointatparam e (+ i 0.5)))
0.))) ;if
(setq i (1+ i))) ;Repeat
) ;progn
) ;if
)) ;if
(princ))
  • Vote tăng 2
  • Vote giảm 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
Tue_NV    3.841

Mình cũng nghĩ hướng ghi dim cũng tuỳ thuộc váo ý chủ quan của người dùng nữa nên đã viết thêm vào Lisp

Nếu dim ghi không phù hợp thì sau khi ghi dim ra thì lsp hỏi có muốn đặt dim theo hướng ngược lại <Y/N>?

Nếu gõ Y thì Lsp sẽ tự đảo chiều ghi dim, còn nếu nhấn N hoặc enter thì lsp giữ nguyên chiều ghi dim đó

- Bổ sung thêm lsp ghi dim bán kính

 

(defun c:dopl(/ ghidim acadObj doc modelSpace e ddat)
(defun ghidim(e ddat i / dis lst-dim)
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat t)))
     (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)
                    )
      )
(progn
 (vla-adddimradial 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 0.5))) 0.0
 ) (setq lst-dim (append lst-dim (list (entlast))))
          (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 lst-dim (append lst-dim (list (entlast))))
    (setq i (1+ i))
    );Repeat
lst-dim
)
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
(setq lst-dim (ghidim e ddat 0))
(initget "Y N")
(if (= "Y" (getkword "\nBan muon ghi dim theo huong nguoc lai <Y/N>")) (progn
   (mapcar 'entdel lst-dim) (command "._pedit" e "R" "") (ghidim e ddat 0)
))
  );progn
 );if
(princ)
)
  • 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

 

Mình cũng nghĩ hướng ghi dim cũng tuỳ thuộc váo ý chủ quan của người dùng nữa nên đã viết thêm vào Lisp

Nếu dim ghi không phù hợp thì sau khi ghi dim ra thì lsp hỏi có muốn đặt dim theo hướng ngược lại <Y/N>?

Nếu gõ Y thì Lsp sẽ tự đảo chiều ghi dim, còn nếu nhấn N hoặc enter thì lsp giữ nguyên chiều ghi dim đó

- Bổ sung thêm lsp ghi dim bán kính

(defun c:dopl(/ ghidim acadObj doc modelSpace e ddat)
(defun ghidim(e ddat i / dis lst-dim)
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat t)))
     (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)
                    )
      )
(progn
 (vla-adddimradial 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 0.5))) 0.0
 ) (setq lst-dim (append lst-dim (list (entlast))))
          (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 lst-dim (append lst-dim (list (entlast))))
    (setq i (1+ i))
    );Repeat
lst-dim
)
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
(setq lst-dim (ghidim e ddat 0))
(initget "Y N")
(if (= "Y" (getkword "\nBan muon ghi dim theo huong nguoc lai <Y/N>")) (progn
   (mapcar 'entdel lst-dim) (command "._pedit" e "R" "") (ghidim e ddat 0)
))
  );progn
 );if
(princ)
)

Lỗi Bác Tue_NV ơi

Bấm N thì ok

Bấm Y lỗi không thấy Dim xuất hiện (Thấy PL được highlight)

lỗi như sau:

Ban muon ghi dim theo huong nguoc lai <Y/N>y
 
Invalid option keyword.
; error: Function cancelled
 
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype 
gen/Undo]: Osmode Reseted!

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
Tue_NV    3.841

 

Lỗi Bác Tue_NV ơi

Bấm N thì ok

Bấm Y lỗi không thấy Dim xuất hiện (Thấy PL được highlight)

lỗi như sau:

Ban muon ghi dim theo huong nguoc lai <Y/N>y
 
Invalid option keyword.
; error: Function cancelled
 
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype 
gen/Undo]: Osmode Reseted!

 

 

Đó là do mình viết quick code dùng hàm command ..^ _ ^ . Bạn dùng CAD2008 mới được 

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


×