[Nhờ sửa lisp] Đo đường polyline

Tháng 3 5, 2015

Đây là lisp mình lấy ở diễn đàn về có sửa 1 ít để đo đường polyline. Nhưng trình lisp còn non nên sửa chưa được hoàn toàn ưng ý. Mới chỉ đo được đường polyline theo chiều thuận (nói chung chỉ mình mới dùng được nhưng phải chỉnh sửa lại kết quả nhiều)

đây là đoạn lisp

(defun c:dopl(/ oldos e e1 e2 p1 p2 p3 p4 p5 p6 pa1 pa2 v1 v2 v3 a1 a2 a3 h len la)
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)
(setq la (getvar "clayer"))
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
          p1 (getpoint "\n Chon diem bat dau ")
          p2 (getpoint "\n Chon diem ket thuc ")
          pa1 (vlax-curve-getparamatpoint e p1)
          pa2 (vlax-curve-getparamatpoint e p2)
          v1 (vlax-curve-getfirstderiv e pa1)
		  v2 (vlax-curve-getfirstderiv e pa2)
          len (abs (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1)))
		  pt3 (getpoint "\n Chon diem dat ")
          pt1 (vlax-curve-getClosestPointTo e pt3)
		  h (distance pt3 pt1)
		  kt (sin (- (angle pt3 p1) (angle pt3 p2))))
(setq kt1 (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1)))
		  (if (< kt 0) 
		  (setq h1 h) 
		  (setq h1 (* -1 h)))
		  (setq a1 (atan (/ (cadr v1) (car v1)))
          a2 (atan (/ (cadr v2) (car v2)))
          p3 (polar p1 (+ a1 (/ pi 2)) h1)
          p4 (polar p2 (+ a2 (/ pi 2)) h1)
          p5 (polar p3 (+ a1 (/ pi 2)) (/ (* 0.5 h1) h))
          p6 (polar p4 (+ a2 (/ pi 2)) (/ (* 0.5 h1) h))
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast))
(if (> pa2 pa1)
    (progn 
         (command "break" e1 p4 (vlax-curve-getendpoint e1))
         (command "break" e1 p3 (vlax-curve-getstartpoint e1))
		 (command "change" e1 "" "p" "la" la "")
		 (command "line" "non" p1 "non" p5 "")
		 (command "line" "non" p2 "non" p6 "")
		 (command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "")
         (command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
         (setq p7 (vlax-curve-getpointatdist e1 (/ len 2)))
         (setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7)))
         (setq a3 (atan (/ (cadr v3) (car v3))))
		 (setq goc (+ a3 (/ pi 2)))
         (setq p8 (polar p7 goc 0.5))
    )
    (progn
         (command "break" e1 p3 (vlax-curve-getendpoint e1))
         (command "break" e1 p4 (vlax-curve-getstartpoint e1))
         (command "change" e1 "" "p" "la" la "")
         (command "line" "non" p1 "non" p6 "")
		 (command "line" "non" p2 "non" p5 "")
		 (command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 a2 0.75) "")
         (command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 (+ a1 pi) 0.75) "")
         (setq p7 (vlax-curve-getpointatdist e1 (/ len 2)))
         (setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7)))
         (setq a3 (atan (/ (cadr v3) (car v3))))
         (setq goc (+ a3 (/ pi 2)))
         (setq p8 (polar p7 goc 0.5))
    )
)
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos len 2 2))
(setq p1 p2)
(while p2
(setq p2 (getpoint "\n Chon diem ket thuc ")
          pa1 (vlax-curve-getparamatpoint e p1)
          pa2 (vlax-curve-getparamatpoint e p2)
          v1 (vlax-curve-getfirstderiv e pa1)
          v2 (vlax-curve-getfirstderiv e pa2)
          len (abs (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1)))
		  pt1 (vlax-curve-getClosestPointTo e pt3)
		  h (distance pt3 pt1)
		  kt (sin (- (angle pt3 p1) (angle pt3 p2))))
(setq kt1 (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1)))
		  (if (< kt 0) 
		  (setq h1 h) 
		  (setq h1 (* -1 h)))
		  (setq a1 (atan (/ (cadr v1) (car v1)))
          a2 (atan (/ (cadr v2) (car v2)))
          p3 (polar p1 (+ a1 (/ pi 2)) h1)
          p4 (polar p2 (+ a2 (/ pi 2)) h1)
          p5 (polar p3 (+ a1 (/ pi 2)) (/ (* 0.5 h1) h))
          p6 (polar p4 (+ a2 (/ pi 2)) (/ (* 0.5 h1) h))
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast))
(if (> pa2 pa1)
    (progn 
         (command "break" e1 p4 (vlax-curve-getendpoint e1))
         (command "break" e1 p3 (vlax-curve-getstartpoint e1))
		 (command "change" e1 "" "p" "la" la "")
		 (command "line" "non" p1 "non" p5 "")
		 (command "line" "non" p2 "non" p6 "")
		 (command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "")
         (command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
         (setq p7 (vlax-curve-getpointatdist e1 (/ len 2)))
         (setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7)))
         (setq a3 (atan (/ (cadr v3) (car v3))))
         (setq goc (+ a3 (/ pi 2)))
         (setq p8 (polar p7 goc 0.5))
    )
    (progn
         (command "break" e1 p3 (vlax-curve-getendpoint e1))
         (command "break" e1 p4 (vlax-curve-getstartpoint e1))
         (command "change" e1 "" "p" "la" la "")
		 (command "line" "non" p1 "non" p6 "")
		 (command "line" "non" p2 "non" p5 "")
		 (command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 a2 0.75) "")
         (command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 (+ a1 pi) 0.75) "")
         (setq p7 (vlax-curve-getpointatdist e1 (/ len 2)))
         (setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7)))
         (setq a3 (atan (/ (cadr v3) (car v3))))
         (setq goc (+ a3 (/ pi 2)))
         (setq p8 (polar p7 goc 0.5))
    )
)
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos len 2 2))
(setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

Nhờ mọi người hoàn chỉnh lại giúp

Rất cám ơn

Tháng 3 9, 2015

Khó hay sao mà không thấy ai giúp đỡ hè!!!!!!!!!!

Tháng 3 10, 2015

- bạn cho nhoc 1 file mẫu minh họa bạn mún nó hoàn chỉnh thế nào đc ko, nhoc xem thử có sữa đc ko ^^, chứ chạy lsp cũng ko pit sữa thế nào ^^

Tháng 3 10, 2015

Khó hay sao mà không thấy ai giúp đỡ hè!!!!!!!!!!

Hề hề hề,

Khó thật vì chả hiểu ý chủ thớt muốn chỉnh cái gì???

Khổ quá, khó quá ......

Tháng 3 10, 2015

Tưởng mọi người hiểu nên không đưa file.

đây là file thực hiện:

http://www.cadviet.com/upfiles/4/66960_bdtd_thoat_nuoc_1.dwg

Tháng 3 14, 2015

Tưởng mọi người hiểu nên không đưa file.

đây là file thực hiện:

http://www.cadviet.com/upfiles/4/66960_bdtd_thoat_nuoc_1.dwg

Bác tham khảo http://www.cadviet.com/forum/topic/64855-yeu-cau-lisp-do-duong-bat-ky/

xem có manh mối nào chăng :(

Tháng 3 18, 2015

Bác tham khảo http://www.cadviet.com/forum/topic/64855-yeu-cau-lisp-do-duong-bat-ky/

xem có manh mối nào chăng :(

Ý tưởng là làm như vậy nhưng trình độ có hạn nên chưa làm được. Với lại ở đó toàn đưa video nên không mót được cái chi cả. -_-

Tháng 3 22, 2015

Sửa tạm cho bạn về việc thuận nghịch, còn những cái khác bạn bổ túc thêm.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)
(setq la (getvar "clayer"))
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
        p1 (getpoint "\n Chon diem bat dau ")
        p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2))
(setq pa1 (vlax-curve-getparamatpoint e p1)
        pa2 (vlax-curve-getparamatpoint e p2)
        v1 (vlax-curve-getfirstderiv e pa1)
        v2 (vlax-curve-getfirstderiv e pa2)
        len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
 pt1 (vlax-curve-getClosestPointTo e pt3)
 h (distance pt3 pt1)
) 
  (setq a1 (atan (/ (cadr v1) (car v1)))
     a2 (atan (/ (cadr v2) (car v2)))
     p3 (polar p1 (+ a1 (/ pi 2)) h)
     p4 (polar p2 (+ a2 (/ pi 2)) h)
     p5 (polar p3 (+ a1 (/ pi 2))  (/ (* 0.5 h) h))
     p6 (polar p4 (+ a2 (/ pi 2))  (/ (* 0.5 h) h))
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
  (command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "") 
(command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
 
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
 goc (+ a3 (/ pi 2))
 p8 (polar p7 goc 0.5))
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos (abs len) 2 2))
)
)
)

Tháng 3 29, 2015

Thuận hay ngược thì đảo lại chiều Pline (tìm trên diễn đàn)

Thử dùng code này coi (dùng cho cả Arc và lwpoly with arc segments):

(defun c:dd (/ _dxf _mid _LWinfo lm:bulgeCentre	_dimarc	_dimaligned
	     *error* *AcDoc spc	s i p1 p2 pt cen r a1 a2 typ e l l1
	    )
  (defun _dxf (code e) (cdr (assoc code (entget e))))
  
  (defun _mid (p1 p2 /) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
  
  (defun _LWinfo (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 *AcDoc (vla-endundomark *AcDoc))
    (if	(and msg
	     (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
	)
      (princ (strcat "\nError: " msg))
    )
  )
  
  ;;===========================MAIN================================;;
  (vla-startundomark
    (setq *AcDoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (setq	spc (vlax-get *AcDoc
		      (if (eq (getvar 'CVPORT) 1)
			'Paperspace
			'Modelspace
		      )
	    )
  )
  (setq	s (ssget '((0 . "LINE,ARC,LWPOLYLINE")))
	i -1
  )
  (repeat (sslength s)
    (setq e   (ssname s (setq i (1+ i)))
	  typ (cdr (assoc 0 (entget e)))
    )
    (cond
      ((equal typ "LINE")
       (setq p1	(_dxf 10 e)
	     p2	(_dxf 11 e)
	     pt	(_mid p1 p2)
       )
       (_dimaligned spc p1 p2 pt)
      )
      ((equal typ "LWPOLYLINE")
       (setq l (_LWinfo 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 e)
	     r	 (_dxf 40 e)
	     a1	 (_dxf 50 e)
	     a2	 (_dxf 51 e)
	     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)
)

Cái này chẳng khác gì đo đường thẳng và đo cung tròn cả cái này thì cad đã hỗ trợ rồi. Còn lisp mình muốn là chọn pl xong thì chọn 2 điểm trên pl nó ghi kích thước luôn.

Chắc bạn chưa thử lisp mình đưa lên thì phải

Tháng 3 29, 2015

Sửa tạm cho bạn về việc thuận nghịch, còn những cái khác bạn bổ túc thêm.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)
(setq la (getvar "clayer"))
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
        p1 (getpoint "\n Chon diem bat dau ")
        p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
 
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2))
(setq pa1 (vlax-curve-getparamatpoint e p1)
        pa2 (vlax-curve-getparamatpoint e p2)
        v1 (vlax-curve-getfirstderiv e pa1)
        v2 (vlax-curve-getfirstderiv e pa2)
        len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
 pt1 (vlax-curve-getClosestPointTo e pt3)
 h (distance pt3 pt1)
) 
  (setq a1 (atan (/ (cadr v1) (car v1)))
     a2 (atan (/ (cadr v2) (car v2)))
     p3 (polar p1 (+ a1 (/ pi 2)) h)
     p4 (polar p2 (+ a2 (/ pi 2)) h)
     p5 (polar p3 (+ a1 (/ pi 2))  (/ (* 0.5 h) h))
     p6 (polar p4 (+ a2 (/ pi 2))  (/ (* 0.5 h) h))
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
  (command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "") 
(command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
 
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
 goc (+ a3 (/ pi 2))
 p8 (polar p7 goc 0.5))
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos (abs len) 2 2))
)
)
)

Đã text mấy hôm trước hôm ni mới rãnh để phản hồi

Do pl có chiều từ phải sang trái chọn điểm đặt bên trái pl đã ok

Do pl có chiều từ phải sang trái chọn điểm đặt bên phải pl nó chạy lung tung

Cám ơn Bạn ToT77 nhiều

Tháng 3 29, 2015

Cái này chắc khá hơn.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(defun angf(d1 d2 ang) 
  (angle d1 (inters d1 (polar d1 ang 1) d2 (polar d2 (+ ang (* pi 0.5)) 1) nil))
)
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2)
pa1 (vlax-curve-getparamatpoint e p1)
       pa2 (vlax-curve-getparamatpoint e p2)
       v1 (vlax-curve-getfirstderiv e pa1)
       v2 (vlax-curve-getfirstderiv e pa2)
       len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
 pt1 (vlax-curve-getClosestPointTo e pt3)
 h (distance pt3 pt1)
 
a1 (atan (/ (cadr v1) (car v1)))
     a2 (atan (/ (cadr v2) (car v2)))
     p3 (polar p1 (angf pt1 pt3 (+ a1 (/ pi 2))) h)
     p4 (polar p2 (angf pt1 pt3 (+ a2 (/ pi 2))) h)
     p5 (polar p3 (angle p1 p3) 0.5)
     p6 (polar p4 (angle p2 p4) 0.5)
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
(command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "") 
(command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
 
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
 goc (+ a3 (/ pi 2))
 p8 (polar p7 goc 0.5))
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos (abs len) 2 2))
)
)
)
;;;
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359) (setvar "cmdecho" 0)
(setq la (getvar "clayer"))
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
        p1 (getpoint "\n Chon diem bat dau ")
        p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos) (setvar "cmdecho" 1)
(princ)
)

Tháng 3 29, 2015

Cái này chắc khá hơn.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(defun angf(d1 d2 ang) 
  (angle d1 (inters d1 (polar d1 ang 1) d2 (polar d2 (+ ang (* pi 0.5)) 1) nil))
)
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2)
pa1 (vlax-curve-getparamatpoint e p1)
       pa2 (vlax-curve-getparamatpoint e p2)
       v1 (vlax-curve-getfirstderiv e pa1)
       v2 (vlax-curve-getfirstderiv e pa2)
       len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
 pt1 (vlax-curve-getClosestPointTo e pt3)
 h (distance pt3 pt1)
 
a1 (atan (/ (cadr v1) (car v1)))
     a2 (atan (/ (cadr v2) (car v2)))
     p3 (polar p1 (angf pt1 pt3 (+ a1 (/ pi 2))) h)
     p4 (polar p2 (angf pt1 pt3 (+ a2 (/ pi 2))) h)
     p5 (polar p3 (angle p1 p3) 0.5)
     p6 (polar p4 (angle p2 p4) 0.5)
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
(command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "pline" "non" p3 "w" 0 0.25 "non" (polar p3 a1 0.75) "") 
(command "pline" "non" p4 "w" 0 0.25 "non" (polar p4 (+ a2 pi) 0.75) "")
 
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
 goc (+ a3 (/ pi 2))
 p8 (polar p7 goc 0.5))
(command "text" "non" "J" "C" p8 1 (* 180 (+ a3 (/ pi 2))) (rtos (abs len) 2 2))
)
)
)
;;;
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359) (setvar "cmdecho" 0)
(setq la (getvar "clayer"))
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
        p1 (getpoint "\n Chon diem bat dau ")
        p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos) (setvar "cmdecho" 1)
(princ)
)

Nhờ Bạn Tot77 xem lại đang bi lỗi ; error: syntax error

Tìm cả buổi mà không ra để sửa lại

Tháng 3 29, 2015

Khổ thân bạn! Tôi tải về load cũng lỗi. Mở bằng vlide mới phát hiện lỗi: nó thêm 1 loạt các ký tự "Â". 99% là do lỗi forum.

Sửa giùm bạn đây:

http://www.cadviet.com/upfiles/4/67029_abc.zip

Tháng 3 29, 2015

Khổ thân bạn! Tôi tải về load cũng lỗi. Mở bằng vlide mới phát hiện lỗi: nó thêm 1 loạt các ký tự "Â". 99% là do lỗi forum.

Sửa giùm bạn đây:

http://www.cadviet.com/upfiles/4/67029_abc.zip

Cám ơn bác Ha Nhiều. Sao bưa nay forum lỗi nhiều rứa, Bấm vào cộng điểm nó cũng báo lỗi.

Tháng 4 2, 2015

Nhờ mọi người giúp đỡ nên bây giờ chạy cũng tạm ổn

Đã chạy được theo Dim hiện hành.

đang ngâm cứu để update khi chỉnh sửa Dim.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(setvar "osmode" 0)
(defun angf(d1 d2 ang) 
 (angle d1 (inters d1 (polar d1 ang 1) d2 (polar d2 (+ ang (* pi 0.5)) 1) nil))
)
(setq tyle (getvar "Dimscale"))
(setq sole (getvar "Dimdec"))
(setq kctext (* (getvar "Dimgap") tyle))
(setq keodaiddong (* (getvar "Dimexe") tyle))
(setq hchu (* (getvar "Dimtxt") tyle))
(setq tyleghi (getvar "Dimlfac"))
(setq dolonmuiten (* (* (getvar "Dimasz") tyle) 2.5))
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setvar "osmode" 0)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2)
pa1 (vlax-curve-getparamatpoint e p1)
pa2 (vlax-curve-getparamatpoint e p2)
v1 (vlax-curve-getfirstderiv e pa1)
v2 (vlax-curve-getfirstderiv e pa2)
len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
pt1 (vlax-curve-getClosestPointTo e pt3)
h (distance pt3 pt1)
a1 (atan (/ (cadr v1) (car v1)))
a2 (atan (/ (cadr v2) (car v2)))
p3 (polar p1 (angf pt1 pt3 (+ a1 (/ pi 2))) h)
p4 (polar p2 (angf pt1 pt3 (+ a2 (/ pi 2))) h)
p5 (polar p3 (angle p1 p3) keodaiddong)
p6 (polar p4 (angle p2 p4) keodaiddong)
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
(command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "QLEADER" P3 (polar p3 a1 dolonmuiten) ^C)
(command "QLEADER" P4 (polar p4 (+ a2 pi) dolonmuiten) ^C)
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
goc (+ a3 (/ pi 2))
p8 (polar p7 goc kctext)
goc1 (- (/ (* 180 (angle p7 p8)) pi) 90)
)
(command "text" "non" "J" "C" p8 hchu goc1 (rtos (* (abs len) tyleghi) 2 sole))
(setvar "osmode" 15359) 
)
)
)
;;;
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359) 
(setvar "cmdecho" 0)
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
p1 (getpoint "\n Chon diem bat dau ")
p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos) 
(setvar "cmdecho" 1)
(princ)
)

Tháng 4 2, 2015

Nhờ mọi người giúp đỡ nên bây giờ chạy cũng tạm ổn

Đã chạy được theo Dim hiện hành.

đang ngâm cứu để update khi chỉnh sửa Dim.

(defun c:dopl(/ E LA OLDOS P1 P2 PT3)
(setvar "osmode" 0)
(defun angf(d1 d2 ang) 
 (angle d1 (inters d1 (polar d1 ang 1) d2 (polar d2 (+ ang (* pi 0.5)) 1) nil))
)
(setq tyle (getvar "Dimscale"))
(setq sole (getvar "Dimdec"))
(setq kctext (* (getvar "Dimgap") tyle))
(setq keodaiddong (* (getvar "Dimexe") tyle))
(setq hchu (* (getvar "Dimtxt") tyle))
(setq tyleghi (getvar "Dimlfac"))
(setq dolonmuiten (* (* (getvar "Dimasz") tyle) 2.5))
(defun tiep (e p1 p2 pt3 / A1 A2 A3 E1 GOC H LA LEN P3 P4 P5 P6 P7 P8 PA1 PA2 PT1 V1 V2 V3)
(setvar "osmode" 0)
(setq p1 (vlax-curve-getclosestpointto e p1)
p2 (vlax-curve-getclosestpointto e p2)
pa1 (vlax-curve-getparamatpoint e p1)
pa2 (vlax-curve-getparamatpoint e p2)
v1 (vlax-curve-getfirstderiv e pa1)
v2 (vlax-curve-getfirstderiv e pa2)
len (- (vlax-curve-getdistatpoint e p2) (vlax-curve-getdistatpoint e p1))
pt1 (vlax-curve-getClosestPointTo e pt3)
h (distance pt3 pt1)
a1 (atan (/ (cadr v1) (car v1)))
a2 (atan (/ (cadr v2) (car v2)))
p3 (polar p1 (angf pt1 pt3 (+ a1 (/ pi 2))) h)
p4 (polar p2 (angf pt1 pt3 (+ a2 (/ pi 2))) h)
p5 (polar p3 (angle p1 p3) keodaiddong)
p6 (polar p4 (angle p2 p4) keodaiddong)
) 
(command "offset" h e "non" pt3 "")
(setq e1 (entlast)) 
(command "break" e1 (if (> len 0) p4 p3) (vlax-curve-getendpoint e1))
(command "break" e1 (if (> len 0) p3 p4) (vlax-curve-getstartpoint e1))
(command "change" e1 "" "p" "la" la "")
(command "line" "non" p1 "non" p5 "")
(command "line" "non" p2 "non" p6 "")
(command "QLEADER" P3 (polar p3 a1 dolonmuiten) ^C)
(command "QLEADER" P4 (polar p4 (+ a2 pi) dolonmuiten) ^C)
(if (setq p7 (vlax-curve-getpointatdist e1 (/ (abs len) 2)))
(progn
(setq v3 (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p7))
a3 (atan (/ (cadr v3) (car v3)))
goc (+ a3 (/ pi 2))
p8 (polar p7 goc kctext)
goc1 (- (/ (* 180 (angle p7 p8)) pi) 90)
)
(command "text" "non" "J" "C" p8 hchu goc1 (rtos (* (abs len) tyleghi) 2 sole))
(setvar "osmode" 15359) 
)
)
)
;;;
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359) 
(setvar "cmdecho" 0)
(command "undo" "be")
(setq e (car (entsel "\n Chon polyline can do "))
p1 (getpoint "\n Chon diem bat dau ")
p2 (getpoint "\n Chon diem ket thuc ")
pt3 (getpoint "\n Chon diem dat ")
)
(tiep e p1 p2 pt3) (setq p1 p2)
(while (setq p2 (getpoint "\n Chon diem ket thuc ")) 
(tiep e p1 p2 pt3) (setq p1 p2)
)
(command "undo" "e")
(setvar "osmode" oldos) 
(setvar "cmdecho" 1)
(princ)
)

Bạn phải chú ý khi dimscale = 0 nữa, nếu không sẽ lỗi :)

Tháng 4 2, 2015

Bạn phải chú ý khi dimscale = 0 nữa, nếu không sẽ lỗi :)

ok, Cám ơn bạn

Tháng 4 2, 2015

Nếu muốn hoành tráng hơn thì chơi thêm dimpost , lúc đó xử lý nó bằng 1 hàm tách chuỗi :)

Tháng 4 2, 2015

Bạn cho mình hỏi dimpost là cái gì thế???, và hàm tách chuổi để làm gi????

Bạn có thể sửa để hoàn thiện hơn lisp trên không?

Chứ mình lisp còn non lắm chưa thể hoàn thiện hơn được

Tháng 4 2, 2015

Bạn cho mình hỏi dimpost là cái gì thế???, và hàm tách chuổi để làm gi????

Bạn có thể sửa để hoàn thiện hơn lisp trên không?

Chứ mình lisp còn non lắm chưa thể hoàn thiện hơn được

Nó là Prefix và Suffix của dim, bạn thử gõ vào L= và m thì (getvar 'dimpost) = "L= <> m"

Đăng nhập

[Nhờ sửa lisp] Đo đường polyline

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

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

nhoclangbat 392

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

phamhuy1 8

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

Tot77 508

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

Tot77 508

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

Doan Van Ha 3.192

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

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

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

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

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

pphung183 428