Đến nội dung


Hình ảnh

Chia đường cong


  • Please log in to reply
6 replies to this topic

#1 Phidoi_gabay

Phidoi_gabay

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 01 July 2009 - 03:34 PM

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

#2 transu

transu

    biết vẽ spline

  • Members
  • PipPip
  • 93 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 01 July 2009 - 03:51 PM

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

#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 01 July 2009 - 03:57 PM

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
  • 1

#4 Phidoi_gabay

Phidoi_gabay

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: 14 (tàm tạm)

Đã gửi 01 July 2009 - 04:18 PM

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

#5 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 01 July 2009 - 05:16 PM

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

#6 ninhson

ninhson

    biết pan

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

Đã gửi 01 July 2009 - 07:17 PM

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 á!
  • 0

#7 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 13 August 2009 - 10:42 AM

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

  • 1