Lisp dim khoảng cách liên tiếp trên Polyline - Pline

Tháng 6 17, 2015

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

Tháng 6 17, 2015

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

Tháng 6 18, 2015

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)

Tháng 6 18, 2015

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ử

Tháng 6 18, 2015

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

file Mình đã test

http://www.cadviet.com/upfiles/5/66960_thu_1.dwg

Tháng 6 18, 2015

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

Tháng 6 18, 2015

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
)

Tháng 6 18, 2015

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

Tháng 6 19, 2015

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áng 6 19, 2015

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ề,

Bác Tue_NV xem xét giùm vì sao khi tải lisp trên về thì không thể load lisp được. Nhưng khi mình copy code và đổi tên file cho nó thì lại load bình thường.

Khi load được lisp và xài thử thì lại bị thông báo rằng không có lệnh (vla-adddimarc ......... ) bác ạ.

Tháng 6 19, 2015

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

Tháng 6 19, 2015

Hề hề hề,

Bác Tue_NV xem xét giùm vì sao khi tải lisp trên về thì không thể load lisp được. Nhưng khi mình copy code và đổi tên file cho nó thì lại load bình thường.

Khi load được lisp và xài thử thì lại bị thông báo rằng không có lệnh (vla-adddimarc ......... ) bác ạ.

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

Tháng 6 19, 2015

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 bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì tốt hơn nhiều.

Tháng 6 19, 2015

Hề hề hề,

Thank bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì 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

Tháng 6 19, 2015

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

Tháng 6 19, 2015

Hề hề hề,

Thank bác Tue_NV vì đúng là mình vẫn xài CAD2004. Như vậy hàm này có bắt đầu từ CAD bao nhiêu bác nhỉ??? Và nếu là CAD2004 có thể tìm hàm nào đaể thay thề???

Lúc trước mình có viết một lisp để làm việc này nhưng không thuận tiện lắm. Nếu có hàm sẵn thì tốt hơn nhiều.

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

Tháng 6 19, 2015

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

Tháng 6 19, 2015

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

Tháng 6 19, 2015



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

Tháng 6 19, 2015



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

Tháng 6 19, 2015

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

Tháng 6 19, 2015

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

Tháng 6 19, 2015

Cám ơn mọi người đã nhiệt tình giúp đỡ. Quá tuyệt vời khi dùng!!!!

Tháng 6 19, 2015

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!

Tháng 6 19, 2015

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

Đăng nhập

Lisp dim khoảng cách liên tiếp trên Polyline - Pline

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

huunhantvxdts 195

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

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

huunhantvxdts 195

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

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

huunhantvxdts 195

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

huunhantvxdts 195

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

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

huunhantvxdts 195

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 481

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

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

huunhantvxdts 195

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

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

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

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

huunhantvxdts 195

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 59

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 59

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 428

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 59

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

huunhantvxdts 195