Đến nội dung


Hình ảnh
- - - - -

[Đã xong]Rải đối tượng theo đường dẫn Dynamic


  • Please log in to reply
23 replies to this topic

#21 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 January 2014 - 11:19 AM

Từ Cad 2012 thì phần array khỏi nói rồi, vì các đối tượng array đã được gộp chung 1 group có reactor, chỉnh sửa dễ dàng, có đủ 3 option là Rec, Por, Path :). các mục Dynamic này ket nhớ k nhầm diễn đàn xuất hiện năm 2011


  • 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


#22 Hoan1111

Hoan1111

    biết lệnh adcenter

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

Đã gửi 17 January 2014 - 01:15 PM

Đúng là có từ AutoCAD2011, bác ạ!


  • 0

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#23 Hantinhsaycad

Hantinhsaycad

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 1073 Bài viết
Điểm đánh giá: 376 (khá)

Đã gửi 17 January 2014 - 02:17 PM

Hì hì ..., Nhưng mình thấy Lisp hay : muốn dừng giữa ...lưng chừng vẫn vô tư ....


  • 1

Đừng để một ai chẳng nhận được gì khi rời chỗ bạn, cho dù bạn biết rằng không bao giờ gặp lại.

Ngạn ngữ Pháp


#24 cong6743

cong6743

    Chưa sử dụng CAD

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

Đã gửi 20 October 2015 - 10:48 AM

Chức năng rải đối tượng theo đường dẫn thì có nhiều cách, nhiều lisp.
Lisp của bác Duy thì có nhiều chứng năng, đáp ứng đầy đủ yêu cầu người dùng.
hochoaivandot xin post thêm 1 lisp nữa. Lisp này chỉ được cái là nó Dynamic nên vui vui mắt thôi.
Mình không theo dõi diễn đàn nhiều sợ đã có người post lisp như thế này rồi. Nếu trùng lặp thì các mod xoá topic giúp nhé.
 
Rdt.gif
 


 (defun LM:PolyCentroid ( e / l )
(foreach x (setq e (entget e))
(if (= 10 (car x)) (setq l (cons (cdr x) l)))
)
(
(lambda ( a )
(if (not (equal 0.0 a 1e-8))
(trans
(mapcar '/
(apply 'mapcar
(cons '+
(mapcar
(function
(lambda ( a b )
(
(lambda ( m )
(mapcar
(function
(lambda ( c d ) (* (+ c d) m))
)
a b
)
)
(- (* (car a) (cadr B)) (* (car B) (cadr a)))
)
)
)
l (cons (last l) l)
)
)
)
(list a a)
)
(cdr (assoc 210 e)) 0
)
)
)
(* 3.0
(apply '+
(mapcar
(function
(lambda ( a b )
(- (* (car a) (cadr B)) (* (car B) (cadr a)))
)
)
l (cons (last l) l)
)
)
)
)
)
(defun LM:SSBoundingBox ( ss / i l1 l2 ll ur )
(repeat (setq i (sslength ss))
(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a B))) '(min max) (list l1 l2))
)
(defun GetCenterSs (ss / bb e kq)
(setq bb (LM:SSBoundingBox ss))
(setq e (entmakex
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 1)
(list 10 (caar bb) (cadar bb))
(list 10 (caadr bb) (cadar bb))
(list 10 (caadr bb) (cadadr bb))
(list 10 (caar bb) (cadadr bb))
)
))
(if e (setq kq (LM:PolyCentroid e)))
(entdel e)
kq
)
(defun ss-union ( s1 s2 / si )
(cond
( (null s1) s2)
( (null s2) s1)
( t
(repeat (setq si (sslength s1))
(ssadd (ssname s1 (setq si (1- si))) s2)
)
s2
)
)
)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun ss2ent(ss / sodt index lstent ent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq
ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun MakeLine (PT1 PT2 Layer Color)
(entmakex (list '(0 . "LINE")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 PT1) (cons 11 PT2))))
(defun InsertObjTanCurve(en ss_Obj pt_iso pt / obj_en pt_iso_vla pt_vla att ss e obj newobj)
(setq
obj_en (vlax-ename->vla-object en)
pt_iso_vla (vlax-3D-point pt_iso)
pt_vla (vlax-3D-point pt)
)
(setq att (angle pt (polar pt (angle '(0 0 0) (vlax-curve-getFirstDeriv obj_en (vlax-curve-getParamAtPoint obj_en pt))) 2)))
(setq ss (ssadd))
(repeat (setq n (sslength ss_Obj))
(setq e (ssname ss_Obj (setq n (1- n))))
(setq obj (vlax-ename->vla-object e))
(setq newobj (vla-copy obj))
(vla-move newobj pt_iso_vla pt_vla)
(vla-rotate newobj pt_vla att)
(setq ss (ssadd (vlax-vla-object->ename newobj) ss))
)
ss
)
(defun GetDir (en pt1 pt2 / dis1 dis2 dis)
(setq
dis1 (vlax-curve-getDistAtPoint en pt1)
dis2 (vlax-curve-getDistAtPoint en pt2)
dis (- dis2 dis1)
)
(if (/= dis 0) (/ dis (abs dis)) 1)
)
(defun MeDyn (en ss_Obj ptiso pt1 dis ptcuoi / ss dis1 disn sumdis dir time i pt obj1 obj_en ss_obj1)
(setvar "osmode" 0)
(setq
ss (ssadd)
obj_en (vlax-ename->vla-object en)
dis1 (vlax-curve-getDistAtPoint obj_en pt1)
disn (vlax-curve-getDistAtPoint obj_en ptcuoi)
sumdis (- disn dis1)
dir (if (/= sumdis 0) (/ sumdis (abs sumdis)) 1)
time (if (/= sumdis 0) (1+ (fix (/ (abs sumdis) dis))) 1)
i 0
)
(repeat time
(setq
pt (vlax-curve-getPointAtDist obj_en (+ dis1 (* i dis dir)))
ss_obj1 (InsertObjTanCurve en ss_Obj ptiso pt)
)
(setq ss (ss-union ss ss_obj1))
(setq i (1+ i))
)
ss
)
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
(defun GetMid (pt1 pt2) (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))
(defun C:rdt(/ en obj_en ss_Obj ptiso data dir dis dis1 dis2 e err gr gr_fl n nmax nx oldos pt1 pt2 ptcuoi ptisodef ss1 temperr txt)
(defun Bdraw()
(setq OldOs (getvar "osmode"))
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(setvar "INSUNITS" 0)
(setq temperr *error*)
(setq *error* err)
)
(defun Edraw()
(setvar "cmdecho" 1)
(if OldOs (setvar "osmode" OldOs))
(if temperr (setq *error* temperr))
(princ)
)
(defun err (msg)
(if OldOs (setvar "osmode" OldOs))
(setvar "cmdecho" 1)
(if ss1 (ST:ss-delete ss1))
(if temperr (setq *error* temperr))
)
(Bdraw)
(setq en (car (entsel "\nTim")))
(setq obj_en (vlax-ename->vla-object en))
(setq ss_Obj (ssget) n (sslength ss_Obj))
(cond
((and (= n 1) (= (dxf 0 (setq e (ssname ss_Obj 0))) "INSERT")) (setq ptisoDef (dxf 10 e) txt "<Diem chen Block>"))
((and (= n 1) (= (dxf 0 (setq e (ssname ss_Obj 0))) "*TEXT")) (setq ptisoDef (dxf 10 e) txt "<Diem chen Text>"))
((and (= n 1) (= (dxf 0 (setq e (ssname ss_Obj 0))) "LINE")) (setq ptisoDef (GetMid (dxf 10 e) (dxf 11 e)) txt "<Diem giua Line>"))
(t (setq ptisoDef (GetCenterSs ss_Obj) txt "<Tam cua doi tuong>"))
)
(setq ptiso (getpoint (strcat "\nBase point" txt)))
(if (not ptiso) (setq ptiso ptisoDef))
(setq
ss1 nil
pt1 (vlax-curve-getClosestPointTo en (getpoint "Diem goc"))
pt2 (vlax-curve-getClosestPointTo en (getpoint pt1 "diem tiep"))
dis1 (vlax-curve-getDistAtPoint en pt1)
dis2 (vlax-curve-getDistAtPoint en pt2)
dis (abs (- dis1 dis2))
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i[Number]:")
(while
(progn
(setq
gr (grread t 15 0)
gr_fl (car gr)
data (cadr gr)
)
(cond
((and (= 5 gr_fl) (listp data))
(progn
(if ss1 (ST:Ss-Delete ss1))
(setq ss1 (MeDyn en ss_Obj ptiso pt1 dis (vlax-curve-getClosestPointTo en data)))
)
t
)
((= 2 gr_fl)
(cond
((vl-position data '(78 110)) ; C/c Curve Aligned
(progn

(if ss1 (ST:Ss-Delete ss1))
(if (not dir) (setq dir (GetDir en pt1 pt2)))
(setq
nmax (fix (abs (/ (- (abs (- (vlax-curve-getDistAtParam en (vlax-curve-getStartParam en)) (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))) dis1) dis dir)))
nx (getint (strcat "Copy m\U+1EA5y l\U+1EA7n <Max:" (itoa nmax) ">:"))
)
(if (not nx) (setq nx nmax))
(setq ptcuoi (vlax-curve-getPointAtDist en (+ dis1 (* nx dis dir))))
(MeDyn en ss_Obj ptiso pt1 dis ptcuoi)
)
))
nil
)
((and (= 3 gr_fl) (listp data))
(progn
(if ss1 (ST:Ss-Delete ss1))
(setq ss1 (MeDyn en ss_Obj ptiso pt1 dis (vlax-curve-getClosestPointTo en data)))
)
nil
)
)
)
)
(Edraw)
)

 
P/S:
- Lisp này là sản phẩm chôm sửa từ lisp array dynamic của ketxu.
- Lisp sử dụng nhiều hàm con của ketxu và Lee-mac.
- Cad đời cao thì cũng có dynamic nhưng mình cứ upload để dùng cho cad đời thấp.
- Định post thêm vaod trong topic của bác Duy, nhưng thấy topic có nhiều lisp quá sợ khó cho quá trình tìm kiếm của cadviet.com

 

 

Cho mình hỏi cad của mình bị sao mà mình chọn xong tim thì không có các thao tác tiếp theo nhỉ.

Nhờ các bạn giúp đỡ!

Thanks!

75372_3.png


  • 0