Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Phidoi_gabay

Chia đường cong

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

Hi all !

E muốn dải thép cho 1 đoạn tường cong bất kỳ, bác nào có lisp dải chấm thép như vậy ko nhỉ? Chứ chia ra rồi coppy thì lâu quá. Đa tạ , đa tạ !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Hi all !

E muốn dải thép cho 1 đoạn tường cong bất kỳ, bác nào có lisp dải chấm thép như vậy ko nhỉ? Chứ chia ra rồi coppy thì lâu quá. Đa tạ , đa tạ !

Bạn tạo cho dấu chấm thép là một Block -> Sau đó sử dụng lệnh ME hoặc DIV để chia dấu chấm thép (là Block) trên đường cong

Command: me MEASURE

Select object to measure:

Specify length of segment or [block]: B : gõ B

 

Enter name of block to insert: L2 -> Đây chính là tên Block chấm thép mà bạn đã tạo

 

Align block with object? [Yes/No] <Y>: enter

 

Specify length of segment: 200 : khoảng cách giữa các chấm thép

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Hi all !

E muốn dải thép cho 1 đoạn tường cong bất kỳ, bác nào có lisp dải chấm thép như vậy ko nhỉ? Chứ chia ra rồi coppy thì lâu quá. Đa tạ , đa tạ !

Đây là lisp gửi tặng các bạn có nhu cầu rải thép trên đường cong, đa giác bất kỳ.

Yêu cầu người dùng tạo trước 1 block là mặt cắt thép: gồm vòng tròn có hatch kiểu solid.

Lisp yêu cầu pick Curve, pick block mặt cắt thép, kích thước a rải thép, bán kính thép

Rải trên hay dưới curve.

ok

; Lisp rai thep tren curve, Block matcat thep da co tren ban ve
; Copyright by THIEP 2009 (0918841230)
; Free from CADVIET.COM
(defun get_point_above_curve (EntCu pt dis / param ang)
 (if (setq param (vlax-curve-getParamAtPoint EntCu pt))
     (setq ang	(- (angle '(0 0 0) (vlax-curve-getFirstDeriv EntCu param))
	   (/ pi 2)
	)
     )
 )
(polar pt ang dis) 
)
;------
(defun DXF (code en) (cdr (assoc code (entget en))))
;------
(defun c:cpa (/ enCUR enBL nameBL Lcur d n dime n1 p1 pt l1 cmdo fi)
 (command "undo" "be")
 (vl-load-com)
 (setq cmdo (getvar "cmdecho"))				
 (setvar "cmdecho" 0)
 (setq	doc (vla-get-ActiveDocument
      (vlax-get-acad-object)
    )
 )
 (setq mspace (vla-get-modelspace doc))
 (setq enCUR (car (entsel "\nPick a curve: ")))
 (setq enBL (car (entsel "\nPick origin block for insert")))
 (setq nameBL (dxf 2 enBL))
 (setq glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
Lcur (glength enCUR)
 )
 (setq l1 0.0)
 (setq d (getreal "\nSelect distance for insert block: "))
 (setq fi (getreal "\nSelect radius of slice: "))
 ; --
 (if  (> (car (vlax-curve-getEndPoint enCUR))
      (car (vlax-curve-getStartPoint enCUR))
   )
   (setq fi (- fi))
   )
 (initget 128 "T D")
 (setq wTD (getkword "\nBan rai thep tren hay duoi curve <Tren/Duoi>: <T>"))
 (if (= WTD "D")
   (setq fi (- fi))
 )
;------

 (setq objBL (vlax-ename->vla-object enBL))
 (setq n (/ Lcur d))
   (if	(< (- n (setq n1 (fix n))) 0.5)
     (setq n n1)
     (setq n (1+ n1))
   )
 (setq dime (/ Lcur n))
 (repeat (+ n 1)
   (setq p1 (vlax-curve-getPointAtDist enCUR l1))
   (setq pt (vlax-3d-point (get_point_above_curve enCUR p1 (* fi 1.2))))
   ;(command ".insert" nameBL pt "" "" "")
   (vla-InsertBlock mspace pt nameBL 1 1 1 0)
   (setq l1 (+ l1 dime))
 )
 (command "undo" "end")
 (setvar "cmdecho" cmdo)
 (princ)
)

Các bạn dùng và rep cho mình nhé

 

 

 

"Mai đi rồi nhớ CADVIET vô cùng!"

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Mai bạn đi đi tây á!

Vâng mình đi "tây" nhưng là "phương trời tây", cách TPHCM 700km lận.

Ở một nơi không có internet, nơi yên ba thăm thẳm, mình đã update lại lisp CPA.LSP và xin gửi lại cho các bạn

GHI CHÚ:

- Lisp đôi khi ngộ nhận rải thép trên thành dưới, dưới thành trên. Nếu gặp trường không theo ý muốn thì các bạn đổi T thành D, D thành T

- Lisp rải thép trên curve: trong đó Line, Spline, LWPolyline, Circle, ellipse là tập hợp con của Curve.

; Lisp rai thep tren curve
; Copyright by THIEP 6-2009 (0918841230)
; Free from CADVIET.COM
;;; Update v.2: 7/2009
;;;--------------------------
(defun ADDCIR (ModelS p R)
 (vla-Addcircle
   ModelS
   (vlax-3d-point p)
   R
 )
)
;;;------------
(defun ArrOBJ (cir / doc mspace po L)
 (setq L (cons cir L))
 (setq	CIRArr (vlax-make-safearray
	 vlax-vbObject
	 (cons 0 (1- (length L)))
       )
 )
 (vlax-safearray-fill CIRArr L)
)
;;;--------------------------
(defun get_point_above_curve (EntCu pt dis / param ang)
 (if (setq param (vlax-curve-getParamAtPoint EntCu pt))
     (setq ang	(- (angle '(0 0 0) (vlax-curve-getFirstDeriv EntCu param))
	   (/ pi 2)
	)
     )
 )
(polar pt ang dis) 
)
;------
(vl-load-com)
(defun c:cpa (/ addH enCUR PS PE enBL nameBL Lcur n k l1 dime n1 p1 pt l1 cmdo fi)
 (command "undo" "be")
 (setq cmdo (getvar "cmdecho"))				
 (setvar "cmdecho" 0)
 (setq	doc (vla-get-ActiveDocument
      (vlax-get-acad-object)
    )
 )
 (setq mspace (vla-get-modelspace doc))
 (setq enCUR (car (entsel "\nPick a curve: ")))
 (setq	PS (vlax-curve-getStartPoint encur)
PE (vlax-curve-getEndPoint encur)
 )
 (setq R (cond (R ) (2)))
 (setq oldR R)
 (setq R   (getreal (strcat "\nChon ban kinh thep <" (rtos oldR 2 0) "> : ")))
 (if (null R) (setq R oldR))
 (setq addH (vla-AddHatch mspace 1 "SOLID" T AcHatchObject))
 (setq glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
Lcur (glength enCUR)
 )
 (setq l1 0.0)
 (setq fi R)
 ; --
 (if  (> (car (vlax-curve-getEndPoint enCUR))
      (car (vlax-curve-getStartPoint enCUR))
   )
   (setq fi (- R))
   )
 (setq wTD (cond (wTD) ("T")))
 (initget 128 "T D")
      (setq TmpStr (strcat "\nBan rai thep tren hay duoi curve <T/D> <" wTD ">: ")
            wTD (cond ((getkword TmpStr)) (wTD))
      )
 (if (= WTD "D")
   (setq fi (- R))
   (setq fi R)
 )
 (setq d (cond (d) (20)))
 (setq oldd d)
 (setq d (getreal (strcat "\nChon khoang cach rai thep <" (rtos oldd 2 0) "> : ")))
 (if (null d) (setq d oldd))
;------
 (setq n (/ Lcur d))
   (if	(< (- n (setq n1 (fix n))) 0.5)
     (setq n n1)
     (setq n (1+ n1))
   )
 (setq dime (/ Lcur n))
 (vla-regen doc acAllViewports)
 (if (equal PS PE)
   (setq k n)
   (setq k (+ n 1))
 )
 (repeat k
   (setq p1 (vlax-curve-getPointAtDist enCUR l1))
   (setq pt (get_point_above_curve enCUR p1 (* fi 1.4)))
   (setq cir (ADDCIR mspace pt R))
   (vla-update cir)
   (setq arr (arrOBJ cir))
   (setq sl (vlax-invoke-method addH 'AppendOuterLoop arr))
   (setq l1 (+ l1 dime))
 )
 (command "undo" "end")
 (setvar "cmdecho" cmdo)
 (princ)
)			

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×