Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
13 replies to this topic

#1 linhhero

linhhero

    biết pan

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

Đã gửi 25 July 2012 - 02:43 PM

Chào các bác :)
Bác nào có thể giúp e viết 1 cái lisp rải Số thứ tự (STT) tăng dần theo 1 dường cong cho trước
Xem file đính kèm: http://www.mediafire...doa78j5hyjx8tj0
Mong chờ tin vui :) Thanks các bác nhiều ^^
  • 0

#2 linhhero

linhhero

    biết pan

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

Đã gửi 27 July 2012 - 02:08 PM

Không có bác nào giúp e sao?
  • 0

#3 sgcq

sgcq

    Hội Hai Lúa

  • Members
  • PipPipPipPipPipPipPip
  • 1880 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 27 July 2012 - 03:08 PM

Đề tài hay. Trong khi chờ đợi hàng hiệu, mời bác thử cách nông dân 4 bước:

http://www.cadviet.c...tbangxuly_1.dwg
  • 1

12728974_230210507314169_718723558582070 HỘI HAI LÚA

           fanpage: https://www.facebook.com/HoiHaiLua/

 

 

 

 

 

 


#4 linhhero

linhhero

    biết pan

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

Đã gửi 27 July 2012 - 03:42 PM

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

#5 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 27 July 2012 - 04:09 PM

http://www.cadviet.c...pic=42771&st=60
Xem ở đây xem có đáp ứng được ko bạn! (Vui lòng đọc xong topic rồi mới phản hồi)
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#6 mathan

mathan

    biết vẽ rectang

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

Đã gửi 27 July 2012 - 04:26 PM

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
  • 2
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#7 sgcq

sgcq

    Hội Hai Lúa

  • Members
  • PipPipPipPipPipPipPip
  • 1880 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 27 July 2012 - 08:21 PM

Có lisp rồi. E trốn lun nhé.
  • 0

12728974_230210507314169_718723558582070 HỘI HAI LÚA

           fanpage: https://www.facebook.com/HoiHaiLua/

 

 

 

 

 

 


#8 damvinhduy

damvinhduy

    biết vẽ line

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

Đã gửi 27 July 2012 - 08:41 PM

Có lisp rồi. E trốn lun nhé.

Có lisp rồi sao không cảm ơn người ta hả bạn?
  • 0

#9 linhhero

linhhero

    biết pan

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

Đã gửi 31 July 2012 - 09:14 AM

hix Giờ mình mới vào đc forum.
Cám ơn a mathan nhiều nhé!
  • 0

#10 linhhero

linhhero

    biết pan

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

Đã gửi 31 July 2012 - 10:03 AM

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

#11 mathan

mathan

    biết vẽ rectang

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

Đã gửi 31 July 2012 - 10:33 AM

Bạn cài Express tool chưa?
Cài vào rùi sẽ ngon ngay thui.
  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#12 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 July 2012 - 11:16 AM

Bạn thêm dòng này vào đầu hoặc cuối file lisp :

(vl-load-com)
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#13 mathan

mathan

    biết vẽ rectang

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

Đã gửi 31 July 2012 - 11:22 AM

Bạn thêm dòng này vào đầu hoặc cuối file lisp :

(vl-load-com)

Đã có dòng lệnh đó trong LISP rùi bạn ah
  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#14 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 July 2012 - 12:15 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC