Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
linhhero

[Yêu cầu] Lisp rải STT tăng dần theo đường cong

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

linhhero    0

CŨng là 1 giải pháp hay.Cám ơn pro nhiều

Nhưng mình có thắc mắc làm sao Ar theo dường cong được nhỉ (hay là mesuare)

auto number mình cũng ko rõ.Mong pro chỉ giáo.

Thân!

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
mathan    57

Gửi bạn dùng thử

;; Free lisp code from CADViet - Edit by mathan
;;;;;;;;;;;;;;;;;;;;;;;; Doi huong tuyen
(defun c:rev (/ ss count lwp ent obj oname sss revlwpl revln)
 (defun revlwpl(/ eo el len)
(setq eo ent)
(setq el (list(assoc 210 ent)))
(while (member (assoc 10 ent) ent)
  (if (= 0.0 (assoc 42 ent))
  (setq el (cons (assoc 42 ent) el))
  (setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
  )
  (setq el (cons (assoc 41 ent) el))
  (setq el (cons (assoc 40 ent) el))
  (setq el (cons (assoc 10 ent) el))
  (setq ent (member (assoc 10 ent) ent))
  (setq ent (cdr ent))
)
(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
(while (>= len 0)
  (setq el (cons (nth len eo) el))
  (setq len (- len 1))
)
(setq ent el)
(entmod ent)
(princ "\n Da thay doi xong huong tuyen ")
 )
 (defun revln (/ pt1 pt2)
(setq pt1 (cons 10 (cdr (assoc 11 ent))))
(setq pt2 (cons 11 (cdr (assoc 10 ent))))
(setq ent (subst pt1 (assoc 10 ent) ent))
(setq ent (subst pt2 (assoc 11 ent) ent))
(entmod ent)
(princ "\n Da thay doi xong huong tuyen ")
 )

 (princ "\n Chon duong can doi huong....")
 (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))

 (setvar "CMDECHO" 0)
 (command "._UNDO" "_BEgin")
 (if ss
(progn
  (setq count 0 lwp 0)
  (while (> (sslength ss) count)
 (setq ent (ENTGET (ssname ss count))
 	obj (vlax-ename->vla-object (ssname ss count))
 	oname (vlax-get-property obj 'ObjectName)
 )
 (cond
((= oname "AcDb3dPolyline")(setq lwp(+ 1 lwp)))
((= (cdadr ent) "LWPOLYLINE")(revlwpl))
((= (cdadr ent) "POLYLINE")
  (progn
(setq sss (ssadd (ssname ss count)))
(vl-cmdf "convertpoly" "Light" sss "")
(setq ent (ENTGET (ssname sss 0)))
(revlwpl)
  )
)
((= (cdadr ent) "LINE")(revln))
 )
 (setq count (+ count 1))
  )
)

 )
 (command "._UNDO" "_End")
 (if(> lwp 0)
(if(> lwp 1)
  (princ(strcat "\n Khong doi chieu duoc " (itoa lwp) " 3dPolylines."))
  (princ"\n Khong the doi chieu duoc cac duong 3dPolyline.")
)
 )

 (princ)
)
;;;;;;;;;;;;;;;; Phan chinh
(defun c:rait ()
(vl-load-com)
  (princ "\n Chon pline....")
  (setq pl1 (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))
  (setq pl (ssname pl1 0))
  (command "lengthen" pl "")
  (setq chieudai (getvar "PERIMETER"))
(setq caotext (getreal"\nNhap chieu cao text :"))
(setq sobd (getreal"\nNhap so bat dau :"))
(setq sogia (getreal"\nNhap buoc so tang :"))
(setq kcl (getreal"\nNhap khoang cach le :"))
(setq ngan (getreal"\nNhap khoang cach ngan :"))
(setq dai (getreal"\nNhap khoang cach dai :"))
(mathan)
)
;;;;;;;;;;;;;; xac dinh goc cua doan thang tinh tu diem ke vuong goc voi duong tim so voi duong chuan
(defun Vg (curve1 pt d2x / dvs)
(vl-load-com)    
 	(setq VS d2x)
 	(setq pt (vlax-curve-getClosestPointTo curve1 (trans pt 1 0))
ang (angle '(0 0) (Vlax-curve-getfirstderiv curve1 (vlax-curve-getParamAtPoint curve1 pt))) )
  (setq pt2 (polar pt (- ang (/ pi 2)) vs))
(princ)
)
;;;;;;;;;;;;;;;;;;;;; Phan nhap ly trinh va offset
(defun mathan (/ d1 curve po ktra)
(vl-load-com)
(command "._UNDO" "_BEgin")
(setq osm (getvar "osmode" ))
(setvar "osmode" 0)
(setq dem 0 dodai 0 ktra "OK")
(while (< dodai chieudai)
(setq dodai (* dem kcl))
(if (= ktra "OK") (setq ktra "NOT OK" kc ngan) (setq ktra "OK" kc dai))
(setq po (vlax-curve-getPointAtDist pl dodai))
(vg pl po kc)
(setq a pt2 goc (/ (* ang 180) pi))
(setq stt (+ sobd (* dem sogia)))
(setq text (rtos stt 2 0))
(command "_TEXT" a caotext goc text)
(setq dem (+ dem 1))
); end while
(command "._UNDO" "_End")
(setvar "osmode" osm)
(princ)
)

Mình định viết code này cho bạn từ hôm qua mà bận quá giờ mới gửi được

Lưu ý 1 chút, nếu rải chưa đúng hướng bạn cần chỉnh

- Đổi hướng pline lệnh REV

- Nếu text nhầm bên, bạn nhập lại khoảng cách offset âm là được

Chúc bạn vui với lisp này

P/s: code còn hơi rườm rà, có thời gian mình sẽ chau chuốt lại sau

  • Vote tăng 2

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
linhhero    0

Sao e chạy lisp bị báo lỗi nhỉ :(

Đầu tiên e load lisp,rôi đánh lệnh rait ---> select object -->

 

 

Nhap chieu cao text :2

 

Nhap so bat dau :1

 

Nhap buoc so tang :1

 

Nhap khoang cach le :3.4

 

Nhap khoang cach ngan :3

 

Nhap khoang cach dai :6

._UNDO Current settings: Auto = On, Control = All, Combine = Yes, Layer = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

<1>: _BEgin

Command: ; error: no function definition: VLAX-CURVE-GETPOINTATDIST

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
ketxu    2.649

1. Lệnh Rev

2. Lisp bạn đâu có liên quan đến ACET ?

3. Lỗi xuất hiện ở hàm (mathan)

4. (vl-load-com) chỉ load 1 lần trong toàn phiên làm việc của CAD

  • 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  

×