Chia đường cong

[Phidoi_gabay 14]

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

[transu 19]

bác Tue NV còn ở đó ko dậy.cho em hỏi tý

[Tue_NV 3.912]

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

[Phidoi_gabay 14]

Thanks bác nhé. E làm đc rùi. Have a nice day !

[thiep 365]

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

[ninhson 0]

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

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

Mai bạn đi đi tây á!

[thiep 365]

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