Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
19 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 05 March 2015 - 06:00 PM

Đâ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


  • 0

#2 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 09 March 2015 - 02:36 PM

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


  • 0

#3 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 10 March 2015 - 08:21 AM

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


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#4 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 10 March 2015 - 03:53 PM

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


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

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 10 March 2015 - 09:16 PM

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

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

http://www.cadviet.c...hoat_nuoc_1.dwg


  • 0

#6 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 14 March 2015 - 04:43 PM

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

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

http://www.cadviet.c...hoat_nuoc_1.dwg

 

Bác tham khảo http://www.cadviet.c...o-duong-bat-ky/

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


  • 0

#7 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 18 March 2015 - 02:06 PM

 

Bác tham khảo http://www.cadviet.c...o-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ả. -_-


  • 0

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 22 March 2015 - 10:49 AM

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

  • 1

#9 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 29 March 2015 - 10:12 AM

 

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


  • 0

#10 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 29 March 2015 - 10:21 AM

 

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


  • 0

#11 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 29 March 2015 - 02:02 PM

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

  • 1

#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 29 March 2015 - 04:46 PM

 

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


  • 0

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 29 March 2015 - 05:30 PM

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.c...4/67029_abc.zip


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 29 March 2015 - 07:45 PM

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


  • 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 02 April 2015 - 12:03 PM

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


  • 0

#16 pphung183

pphung183

    biết dimstyle

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

Đã gửi 02 April 2015 - 07:49 PM

 

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


  • 0

#17 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 02 April 2015 - 08:59 PM

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

 ok, Cám ơn bạn


  • 0

#18 pphung183

pphung183

    biết dimstyle

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

Đã gửi 02 April 2015 - 09:31 PM

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


  • 0

#19 huunhantvxdts

huunhantvxdts

    biết dimbaseline

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

Đã gửi 02 April 2015 - 09:53 PM

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


  • 0

#20 pphung183

pphung183

    biết dimstyle

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

Đã gửi 02 April 2015 - 09:59 PM

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"


  • -1