[Giúp đỡ] Lisp đo bán kính sau khi Fillet

Tháng 5 13, 2019

Đoan lisp này mình viết để bo cong các polyline.

(defun C:VBK(/ )
(command "undo" "be")
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while ;(setq dtuong1 (car (entsel "\nChon doi tuong 1")))
(or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
(setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
;(setq dtuong2 (car (entsel "\nChon doi tuong 2")))
(command "FILLET" "R" bkinh)
(command "FILLET" pause pause)
;(dobk (entlast))
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(command "undo" "end")
(princ)
)
;(command

Bây giờ mình muốn sau khi bo xong nó điền luôn bán kính vào luôn.

Mong mọi người giúp đỡ.

Thân!!!

Tháng 5 13, 2019

Bác viết hàm giống lệnh fillet luôn rồi thì cần gì biến bkinh nữa. Nó có biến filletrad rồi mà

Nếu bác muốn đọc bkinh thì (getvar 'filletrad) là được.

Còn bác muốn điền bán kính bằng text hay dim thì bạn thêm lệnh command đó vào vì dù sao cũng cần có vị trí đặt text.

Ví dụ như chèn text. Mình tao text ở vị trí '(0 0 0) rồi move lên

(defun c:vbk(/ ent)
  (command "fillet" "r" pause)
  (While (/= (getvar 'cmdactive) 0) (command pause))
  (command "fillet" pause pause)
  (command "text" '(0 0 0) "" "" (rtos (getvar 'filletrad) 2 2) "")
  (command "move" (entlast) "" '(0 0 0) pause))

Tháng 5 13, 2019

10 phút trước, ngokiet đã nói:
Bác viết hàm giống lệnh fillet luôn rồi thì cần gì biến bkinh nữa. Nó có biến filletrad rồi mà

Nếu bác muốn đọc bkinh thì (getvar 'filletrad) là được.

Còn bác muốn điền bán kính bằng text hay dim thì bạn thêm lệnh command đó vào vì dù sao cũng cần có vị trí đặt text.

Ví dụ như chèn text. Mình tao text ở vị trí '(0 0 0) rồi move lên
vbk.lsp

[✎]
(defun c:vbk(/ ent)
  (command "fillet" "r" pause)
  (While (/= (getvar 'cmdactive) 0) (command pause))
  (command "fillet" pause pause)
  (command "text" '(0 0 0) "" "" (rtos (getvar 'filletrad) 2 2) "")
  (command "move" (entlast) "" '(0 0 0) pause))

Ý là muốn đo bán kính của cung tròn đó chứ ko phải text.

Sau khi filett xong không phải chọn lại đối tượng mà nó đo luôn.

Chứ bạn tạo text rồi pick điểm đến thì dùng lệnh đo bán kính rồi pick chọn cung nó đẹp hơn

Ở đây ý mình là filett xong không chọn chi hết nó đo luôn bán kính

Cám ơn bạn nhiều

Tháng 5 13, 2019

28 phút trước, huunhantvxdts đã nói:

Ý là muốn đo bán kính của cung tròn đó chứ ko phải text.

Sau khi filett xong không phải chọn lại đối tượng mà nó đo luôn.

Chứ bạn tạo text rồi pick điểm đến thì dùng lệnh đo bán kính rồi pick chọn cung nó đẹp hơn

Ở đây ý mình là filett xong không chọn chi hết nó đo luôn bán kính

Cám ơn bạn nhiều

Nếu bạn muốn như vậy thì khi dim radius Thì dù sao cũng phải có thông tin về vị trí ghi kích thước.

Bạn biết lisp nên mình cũng chỉ nói ý tưởng vì viết cũng khá rắc rối.

- Lệnh Fillet 2 polyline thì nó sẽ tạo ra 1 polyline có ename là ename của polyline đầu.

- Vì vậy bạn nên lấy dữ liệu polyline đầu. Sau lệnh fillet thì kiểm tra thay đổi để xác định đoạn cung tròn để ghi kích thước.

VD:

(setq en1 (entsel)

old (entget(car(entsel))))

(command "fillet" en1 pause)

(setq new(entget(car(entsel))))

(.... So sánh old vs new xác định arc để ghi dim cung tròn...)

(có thể Dùng các Hàm như vlax-curve-getClosestPointTo, vlax-curve-getParamAtPoint để xác định đoạn nào cùa polyline trước sau fillet để định vị cung tròn)

Tháng 5 13, 2019

57 phút trước, huunhantvxdts đã nói:

Ý là muốn đo bán kính của cung tròn đó chứ ko phải text.

Sau khi filett xong không phải chọn lại đối tượng mà nó đo luôn.

Chứ bạn tạo text rồi pick điểm đến thì dùng lệnh đo bán kính rồi pick chọn cung nó đẹp hơn

Ở đây ý mình là filett xong không chọn chi hết nó đo luôn bán kính

Cám ơn bạn nhiều

+ Bạn có thể tham khảo code của nợ này : ))))

https://www.cadtutor.net/forum/topic/30482-dim-radius/

Riêng code tự động đo góc thì không được hoàn thiện ( do chưa hiểu thông số tọa độ của nó ).

+ Code sai vòng lặp while.




	(defun C:VBK( / DTUONG1 DTUONG2 )

	(command "undo" "be")

	    (or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))

	    (setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))

	      (while

	      (and

	      (setq dtuong1 (car (entsel "\nChon doi tuong 1")))

	      (setq dtuong2 (car (entsel "\nChon doi tuong 2")))

	      ); end and

	    (command "FILLET" dtuong1 dtuong2)

	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")

	    )

	(command "undo" "end")

	(princ)

	)

Tháng 5 13, 2019

16 phút trước, Danh Cong đã nói:

+ Bạn có thể tham khảo code của nợ này : ))))

https://www.cadtutor.net/forum/topic/30482-dim-radius/

Riêng code tự động đo góc thì không được hoàn thiện ( do chưa hiểu thông số tọa độ của nó ).

+ Code sai vòng lặp while.

vbk.lsp
[✎]





	(defun C:VBK( / DTUONG1 DTUONG2 )
	(command "undo" "be")
	    (or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
	    (setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
	      (while
	      (and
	      (setq dtuong1 (car (entsel "\nChon doi tuong 1")))
	      (setq dtuong2 (car (entsel "\nChon doi tuong 2")))
	      ); end and
	    (command "FILLET" dtuong1 dtuong2)
	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")
	    )
	(command "undo" "end")
	(princ)
	)

Hình như bác không xem kỹ. nếu 2 line hay 2 arc thì mới có entlast đễ ghi kích thước thì dễ rồi. 2 polyline thì khó.

Tháng 5 13, 2019

25 phút trước, Danh Cong đã nói:

+ Bạn có thể tham khảo code của nợ này : ))))

https://www.cadtutor.net/forum/topic/30482-dim-radius/

Riêng code tự động đo góc thì không được hoàn thiện ( do chưa hiểu thông số tọa độ của nó ).

+ Code sai vòng lặp while.

vbk.lsp
[✎]





	(defun C:VBK( / DTUONG1 DTUONG2 )
	(command "undo" "be")
	    (or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
	    (setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
	      (while
	      (and
	      (setq dtuong1 (car (entsel "\nChon doi tuong 1")))
	      (setq dtuong2 (car (entsel "\nChon doi tuong 2")))
	      ); end and
	    (command "FILLET" dtuong1 dtuong2)
	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")
	    )
	(command "undo" "end")
	(princ)
	)

Thiếu

(command "FILLET" "R" bkinh)

nhưng 2 đường line thì nó chạy còn 2 polyline thì nó đứng yên

cám ơn bạn đã quan tâm

Tháng 5 13, 2019

13 phút trước, ngokiet đã nói:

Hình như bác không xem kỹ. nếu 2 line hay 2 arc thì mới có entlast đễ ghi kích thước thì dễ rồi. 2 polyline thì khó.

Vấn đề của mình là ở chỗ này.

Sau khi filett xong nó trở thành 1 đối tượng làm sao để chọn đối tượng đó (mình có lisp đo đường polyline rồi)

Lisp đo đường polyline có đường cong:

(defun c:DSE (/ h lt acadobj ddat e s dis doc 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)
(setq h (getvar "Dimtxt"))
(setq lt (getvar "Dimscale"))
 (if  (setq	j -1
		s (ssget '((0 . "*POLYLINE")))
       )
(repeat (sslength s)
	(setq e	  (ssname s (setq j (1+ j))))
(setq i 0)
(if (wcmatch (etype e) "*POLYLINE")

(if (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nPhia dat Dim (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)))
(setq dis (* (* h lt) 2.5))
(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.5))) ;if

(setq i (1+ i))) ;Repeat

) ;progn

) ;if
)
); repeat
) ;if

(princ))

Tháng 5 13, 2019

Nếu Fillet Pline thì bài toán rất rắc rối vì phải xác định Arc sinh ra do Fillet (thậm chí Pline trước đó đã có Arc nữa).

Tháng 5 13, 2019

3 phút trước, Doan Van Ha đã nói:

Nếu Fillet Pline thì bài toán rất rắc rối vì phải xác định Arc sinh ra do Fillet (thậm chí Pline trước đó đã có Arc nữa).

Rắc rối phết nhỉ, Mà ở đây Pline trước đó không có Arc.

Bác Hạ nói thế chắc là phê lắm đấy, Thôi chắc phải thêm 1 bước nữa là chọn cung để Dim bán kính cho khỏi đâu đầu

Cám ơn Bác nhiều

Tháng 5 13, 2019

Fillet và Chamfer của autocad hơi khó chịu. Fillet đôi khi xảy ra lỗi khi fillet các cung tròn. Chamfer thì Arc không hỗ trợ. Chamfer polyline có Arc là sai vì nó tính arc như đường thẳng. Mình cũng tính viết lại 2 lệnh này nhưng chắc cũng không free được đâu.

Tháng 5 13, 2019

11 phút trước, ngokiet đã nói:

Fillet và Chamfer của autocad hơi khó chịu. Fillet đôi khi xảy ra lỗi khi fillet các cung tròn. Chamfer thì Arc không hỗ trợ. Chamfer polyline có Arc là sai vì nó tính arc như đường thẳng. Mình cũng tính viết lại 2 lệnh này nhưng chắc cũng không free được đâu.

Cám ơn bạn nhiều

Thủ công thêm 1 tí cũng được, Thêm 1 bước chọn cung vừa tạo là ok

Tháng 5 13, 2019

Ý tưởng : Có khi nào mình xác định arc mới thông qua "Param" của nó phát sinh ra không nhỉ. ^^. Em chưa kiểm tra điều này bao giờ, ko biết đúng sai ra sao :)))

Tháng 5 13, 2019

4 giờ trước, huunhantvxdts đã nói:

Vấn đề của mình là ở chỗ này.

Sau khi filett xong nó trở thành 1 đối tượng làm sao để chọn đối tượng đó (mình có lisp đo đường polyline rồi)

Lisp đo đường polyline có đường cong:

dse.lsp
[✎]


(defun c:DSE (/ h lt acadobj ddat e s dis doc 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)
(setq h (getvar "Dimtxt"))
(setq lt (getvar "Dimscale"))
 (if  (setq	j -1
		s (ssget '((0 . "*POLYLINE")))
       )
(repeat (sslength s)
	(setq e	  (ssname s (setq j (1+ j))))
(setq i 0)
(if (wcmatch (etype e) "*POLYLINE")

(if (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nPhia dat Dim (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)))
(setq dis (* (* h lt) 2.5))
(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.5))) ;if

(setq i (1+ i))) ;Repeat

) ;progn

) ;if
)
); repeat
) ;if

(princ))

Đối tượng PLine 1 có Ename + số đỉnh

Đối tượng Pline 2 cũng có Ename và số đỉnh.

Sau khi Fillet xong thì nếu thành công thì đối tượng tạo thành sẽ có Ename là 1 trong 2 thằng đó (Ktra xem đối tượng nào còn TỒN TẠI) -> Bắt đối tượng đó thông qua Ename bên trên, dựa vào số đỉnh ta lại suy ra được vị trí của cái cung tròn đó.

Tại hạ có hạ kiến như thế, các hạ vui lòng thử

Tháng 5 13, 2019

1 giờ trước, CadExTools đã nói:

Đối tượng PLine 1 có Ename + số đỉnh

Đối tượng Pline 2 cũng có Ename và số đỉnh.

Sau khi Fillet xong thì nếu thành công thì đối tượng tạo thành sẽ có Ename là 1 trong 2 thằng đó (Ktra xem đối tượng nào còn TỒN TẠI) -> Bắt đối tượng đó thông qua Ename bên trên, dựa vào số đỉnh ta lại suy ra được vị trí của cái cung tròn đó.

Tại hạ có hạ kiến như thế, các hạ vui lòng thử

Lisp ở trên nó cho phép đo đường cong rồi nên không cần kiểm tra chỉ cần bắt được đối tượng polyline đưa vào thôi.

đây là lisp mình viết có thêm 1 bước là chọn đối tượng sau khi filett

(defun C:VBK(/ )
(command "undo" "be")
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while ;(setq dtuong1 (car (entsel "\nChon doi tuong 1")))
(or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
(setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
(command "FILLET" "R" bkinh)
(command "FILLET" pause pause)
(dobk)
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun dobk (/ acadobj doc i modelspace obj 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)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(setq i 0)
(setq e (car (entsel "\nChon cung dien ban kinh")))
(setq obj (vlax-ename->vla-object e))
(repeat (fix (vlax-curve-getendparam e))
(if (/= 0 (vla-getbulge obj i))
(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.5)
)
(setq i (1+ i))
)
(princ)
)

Tháng 5 13, 2019

4 phút trước, huunhantvxdts đã nói:

Lisp ở trên nó cho phép đo đường cong rồi nên không cần kiểm tra chỉ cần bắt được đối tượng polyline đưa vào thôi.

đây là lisp mình viết có thêm 1 bước là chọn đối tượng sau khi filett

vbk.lsp
[✎]


(defun C:VBK(/ )
(command "undo" "be")
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while ;(setq dtuong1 (car (entsel "\nChon doi tuong 1")))
(or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
(setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
(command "FILLET" "R" bkinh)
(command "FILLET" pause pause)
(dobk)
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun dobk (/ acadobj doc i modelspace obj 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)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(setq i 0)
(setq e (car (entsel "\nChon cung dien ban kinh")))
(setq obj (vlax-ename->vla-object e))
(repeat (fix (vlax-curve-getendparam e))
(if (/= 0 (vla-getbulge obj i))
(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.5)
)
(setq i (1+ i))
)
(princ)
)

Thì chính là bắt đối tượng thông qua Ename của đối tượng đó bạn

Tháng 5 13, 2019

21 phút trước, CadExTools đã nói:

Thì chính là bắt đối tượng thông qua Ename của đối tượng đó bạn

Đoạn này mình chưa làm được bạn có thể chỉnh lisp trên bỏ thao tác bắt đối tượng sau khi fillett cho mình với

Cám ơn bạn

Tháng 5 13, 2019

47 phút trước, huunhantvxdts đã nói:

Lisp ở trên nó cho phép đo đường cong rồi nên không cần kiểm tra chỉ cần bắt được đối tượng polyline đưa vào thôi.

đây là lisp mình viết có thêm 1 bước là chọn đối tượng sau khi filett

vbk.lsp
[✎]


(defun C:VBK(/ )
(command "undo" "be")
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while ;(setq dtuong1 (car (entsel "\nChon doi tuong 1")))
(or (and bkinh (or (= (type bkinh) 'int) (= (type bkinh) 'real))) (setq bkinh 5.00))
(setq bkinh (cond ((getreal (strcat "\nNhap ban kinh cong (m) <" (rtos bkinh 2 2) ">: "))) (bkinh)))
(command "FILLET" "R" bkinh)
(command "FILLET" pause pause)
(dobk)
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun dobk (/ acadobj doc i modelspace obj 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)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(setq i 0)
(setq e (car (entsel "\nChon cung dien ban kinh")))
(setq obj (vlax-ename->vla-object e))
(repeat (fix (vlax-curve-getendparam e))
(if (/= 0 (vla-getbulge obj i))
(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.5)
)
(setq i (1+ i))
)
(princ)
)

Sao bạn làm rắc rối vậy.

Bác chỉ cần thêm dòng này thay cho gọi hàm dobk là được rồi.

(command "dimradius" "mid" pause "")

Với lại vòng lặp while của bạn không có kết thúc trừ nhấn Esc nên các biến bạn lưu lại nó không trả về.

Còn mình chỉ cần viết vậy là đủ

(defun c:vbk(/ bkinh)
  (If (setq bkinh (getreal (strcat "\nNhap ban kinh cong (m) <" (rtos (getvar 'filletrad) 2 2) ">: "))
     (setvar 'filletrad bkinh))
  (command "fillet" pause pause)
  (command "dimradius" pause ""))

Còn hàm dobk của bạn hình như là ghi kích thước tất cả các arc có trong polyline nên dễ bị trùng dim nếu polyline có arc trước khi fillet.

Còn nếu bạn muốn bỏ chọn như bạn nói thì có mấy trường hợp

- 2 line or 2 arc thì nó là (entlast)

- nếu đối tượng 1 là polyline thì nó là đối tượng 1 còn ko thì đối tượng 2.

Vì vậy nếu bạn chắc chắn dt1 là polyline thì bạn muốn lấy đối tượng đó thì bạn đổi dòng

(command "FILLET" pause pause)

Thành

(if (setq dt1 (entsel "Nhap doi tuong 1")) (command "fillet" dt1 pause))

Tháng 5 14, 2019

16 giờ trước, huunhantvxdts đã nói:

Đoạn này mình chưa làm được bạn có thể chỉnh lisp trên bỏ thao tác bắt đối tượng sau khi fillett cho mình với

Cám ơn bạn

17 giờ trước, CadExTools đã nói:

Thì chính là bắt đối tượng thông qua Ename của đối tượng đó bạn

20 giờ trước, Danh Cong đã nói:

Ý tưởng : Có khi nào mình xác định arc mới thông qua "Param" của nó phát sinh ra không nhỉ. ^^. Em chưa kiểm tra điều này bao giờ, ko biết đúng sai ra sao :)))

18 giờ trước, CadExTools đã nói:

Đối tượng PLine 1 có Ename + số đỉnh

Đối tượng Pline 2 cũng có Ename và số đỉnh.

Sau khi Fillet xong thì nếu thành công thì đối tượng tạo thành sẽ có Ename là 1 trong 2 thằng đó (Ktra xem đối tượng nào còn TỒN TẠI) -> Bắt đối tượng đó thông qua Ename bên trên, dựa vào số đỉnh ta lại suy ra được vị trí của cái cung tròn đó.

Tại hạ có hạ kiến như thế, các hạ vui lòng thử

Gộp ý tưởng của các bác + google tý viết được Lisp như thế này

Các bác test xem.

Mình đã test trường hợp 2 pline, 1 pline và 1 line, 1 line và 1 arc đều sử dụng được, k biết còn trường hợp nào không ?

(defun C:VBK( / DTUONG1 DTUONG2 dtuong11 dtuong22 end )
(if (and
	      (setq dtuong1  (entsel "\nChon doi tuong 1"))
	      (setq dtuong2 (entsel "\nChon doi tuong 2"))
	      ) (progn
  		(setq dtuong11 (car dtuong1))
	      (setq dtuong22 (car dtuong2))
(if (= (Cdr (assoc 0 (entget dtuong11))) "LWPOLYLINE") (PROGN
  (setq end  (vlax-curve-getendparam dtuong11))
  (Polyline dtuong11 )
) (if (= (Cdr (assoc 0 (entget dtuong22))) "LWPOLYLINE") (progn
	(setq end  (vlax-curve-getendparam dtuong22))
  (Polyline dtuong22)
	) (progn
	    (command "fillet" "r" pause "")
		(command "FILLET" dtuong11 dtuong22)
	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")
	    )))))
	(princ)
	)
(defun Polyline( dtuong / p11 cen lst ent )
  (command "fillet" "r" pause "")
  (command "_.FILLET" (osnap (cadr dtuong1) "_nea") (osnap (cadr dtuong2) "_nea"))
  (setq p11 (vlax-curve-getpointatparam dtuong end))
  (if (setq cen (osnap  p11 "_CEN")) (progn
  (command "Circle" "_non" cen (getvar 'filletrad) "")
   (setq ent (entlast))
(setq lst (list ent p11))
  (command "DIMRADIUS" lst "_non" "" )
  (entdel ent)))
  )

Tháng 5 14, 2019

5 giờ trước, Doan Nguyen Van đã nói:

Gộp ý tưởng của các bác + google tý viết được Lisp như thế này

Các bác test xem.

Mình đã test trường hợp 2 pline, 1 pline và 1 line, 1 line và 1 arc đều sử dụng được, k biết còn trường hợp nào không ?

vbk.lsp
[✎]


(defun C:VBK( / DTUONG1 DTUONG2 dtuong11 dtuong22 end )
(if (and
	      (setq dtuong1  (entsel "\nChon doi tuong 1"))
	      (setq dtuong2 (entsel "\nChon doi tuong 2"))
	      ) (progn
  		(setq dtuong11 (car dtuong1))
	      (setq dtuong22 (car dtuong2))
(if (= (Cdr (assoc 0 (entget dtuong11))) "LWPOLYLINE") (PROGN
  (setq end  (vlax-curve-getendparam dtuong11))
  (Polyline dtuong11 )
) (if (= (Cdr (assoc 0 (entget dtuong22))) "LWPOLYLINE") (progn
	(setq end  (vlax-curve-getendparam dtuong22))
  (Polyline dtuong22)
	) (progn
	    (command "fillet" "r" pause "")
		(command "FILLET" dtuong11 dtuong22)
	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")
	    )))))
	(princ)
	)
(defun Polyline( dtuong / p11 cen lst ent )
  (command "fillet" "r" pause "")
  (command "_.FILLET" (osnap (cadr dtuong1) "_nea") (osnap (cadr dtuong2) "_nea"))
  (setq p11 (vlax-curve-getpointatparam dtuong end))
  (if (setq cen (osnap  p11 "_CEN")) (progn
  (command "Circle" "_non" cen (getvar 'filletrad) "")
   (setq ent (entlast))
(setq lst (list ent p11))
  (command "DIMRADIUS" lst "_non" "" )
  (entdel ent)))
  )

OK rồi cám ơn bạn nhiều

Tháng 5 14, 2019

5 giờ trước, Doan Nguyen Van đã nói:

Gộp ý tưởng của các bác + google tý viết được Lisp như thế này

Các bác test xem.

Mình đã test trường hợp 2 pline, 1 pline và 1 line, 1 line và 1 arc đều sử dụng được, k biết còn trường hợp nào không ?

vbk.lsp
[✎]


(defun C:VBK( / DTUONG1 DTUONG2 dtuong11 dtuong22 end )
(if (and
	      (setq dtuong1  (entsel "\nChon doi tuong 1"))
	      (setq dtuong2 (entsel "\nChon doi tuong 2"))
	      ) (progn
  		(setq dtuong11 (car dtuong1))
	      (setq dtuong22 (car dtuong2))
(if (= (Cdr (assoc 0 (entget dtuong11))) "LWPOLYLINE") (PROGN
  (setq end  (vlax-curve-getendparam dtuong11))
  (Polyline dtuong11 )
) (if (= (Cdr (assoc 0 (entget dtuong22))) "LWPOLYLINE") (progn
	(setq end  (vlax-curve-getendparam dtuong22))
  (Polyline dtuong22)
	) (progn
	    (command "fillet" "r" pause "")
		(command "FILLET" dtuong11 dtuong22)
	    (command "DIMRADIUS" (list (entlast) (cdr (assoc 10 (entget (entlast)))) ) "_non" "")
	    )))))
	(princ)
	)
(defun Polyline( dtuong / p11 cen lst ent )
  (command "fillet" "r" pause "")
  (command "_.FILLET" (osnap (cadr dtuong1) "_nea") (osnap (cadr dtuong2) "_nea"))
  (setq p11 (vlax-curve-getpointatparam dtuong end))
  (if (setq cen (osnap  p11 "_CEN")) (progn
  (command "Circle" "_non" cen (getvar 'filletrad) "")
   (setq ent (entlast))
(setq lst (list ent p11))
  (command "DIMRADIUS" lst "_non" "" )
  (entdel ent)))
  )

Mình thấy thay đoạn này:

(if (setq cen (osnap p11 "_CEN")) 
(progn
(command "Circle" "_non" cen (getvar 'filletrad) "")
(setq ent (entlast)) 
(setq lst (list ent p11)) (command "DIMRADIUS" lst "_non" "" )
(entdel ent)
))

Bằng đoạn này máy chạy thấy nhẹ hơn

(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-activedocument acadObj))
(setq modelSpace (vla-get-modelspace doc))
(if (setq cen (osnap  p11 "_CEN")) 
  (vla-adddimradial modelSpace (vlax-3d-point cen) (vlax-3d-point p11) -0.5)
  )

Không biết có ôn không nhưng đang sử dụng rất ok

Tháng 5 17, 2019

Nếu đt 1 cắt đt 2: dùng lệnh fillet có 4 kq

Nếu đt 1 kéo dài cắt đt 2: dùng lệnh fillet có 2 kq

line - arc không cắt nhau: dùng lệnh fillet có 2 kq

Dùng lisp: 1 kq duy nhất

Nếu thay bằng

(command "FILLET" dtuong1 dtuong2)

số kq giống như dùng lệnh fillet

Đăng nhập

[Giúp đỡ] Lisp đo bán kính sau khi Fillet

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

ngokiet 169

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

ngokiet 169

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

Danh Cong 422

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

ngokiet 169

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

Doan Van Ha 3.194

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

ngokiet 169

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

Danh Cong 422

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

CadExTools 102

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

CadExTools 102

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

ngokiet 169

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 Nguyen Van 489

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