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

Tháng 5 25, 2013

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é.

(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

Similar topics from web:

Phần mềm thống kê thép Dựa vào bản vẽ cad?

Ứng dụng CNTT trong Xây Dựng

Tài liệu DVD phần mềm kỹ thuật các loại uy tín! | Tư vấn kỹ thuật ...

ketxu

Tháng 5 25, 2013

Hay quá HHVD ơi ^^

Tháng 10 14, 2013

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é.
(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

Similar topics from web:

Phần mềm thống kê thép Dựa vào bản vẽ cad?

Ứng dụng CNTT trong Xây Dựng

Tài liệu DVD phần mềm kỹ thuật các loại uy tín! | Tư vấn kỹ thuật ...

ketxu

Similar topics from web:
Phần mềm thống kê thép Dựa vào bản vẽ cad?

Ứng dụng CNTT trong Xây Dựng

Tài liệu DVD phần mềm kỹ thuật các loại uy tín! | Tư vấn kỹ thuật ...

ketxu

Lisp rất hay bác ạ, nhưng bác có thể thêm đoạn code là khi rải đến đâu thì hiện số đối tượng được rải đến đó được không bác? Thanks bác ạ

Tháng 10 14, 2013

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é.
(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

Similar topics from web:
Phần mềm thống kê thép Dựa vào bản vẽ cad?

Ứng dụng CNTT trong Xây Dựng

Tài liệu DVD phần mềm kỹ thuật các loại uy tín! | Tư vấn kỹ thuật ...

ketxu

Lisp rất hay bác ạ, nhưng bác có thể viết thêm đoạn code là khi dải đến đâu thì hiện số đối tượng được rải đến đó. Thanks bác nhiều ạ

Tháng 10 14, 2013

Lisp rất hay bác ạ, nhưng bác có thể viết thêm đoạn code là khi dải đến đâu thì hiện số đối tượng được rải đến đó. Thanks bác nhiều ạ

Hề hề hề,

Cái vụ này chắc chả quá khó với bác HHVD song có cần thiết hay không thì lại là vấn đề mà TrieuBB cần suy nghĩ. Với tốc độ rải như rứa thì cái số có hiện lên cũng chả kịp đọc, nhất là với cái loại kẻm nhẻm kèm nhèm như tui. Vả lại có hiện lên cũng chả lấy gì làm oai cả.

Có chăng là sau khi rải xong sẽ có một thông báo cho người dùng biết là đã rải bao nhiêu đối tượng có nhẽ sẽ là yêu cầu hợp lý hơn.

Tháng 10 14, 2013

Lisp rất hay bác ạ, nhưng bác có thể viết thêm đoạn code là khi dải đến đâu thì hiện số đối tượng được rải đến đó. Thanks bác nhiều ạ

Ý tưởng này hay, sẽ là 1 cải tiến thú vị và tiện lợi cho người dùng.

Tháng 10 14, 2013

Lisp sửa theo ý kiến bạn trieubb

http://www.cadviet.com/upfiles/3/4652_rdt.lsp

http://youtu.be/sjG5unLRBfg

Tháng 10 15, 2013

Lisp sửa theo ý kiến bạn trieubb

http://www.cadviet.com/upfiles/3/4652_rdt.lsp

http://youtu.be/sjG5unLRBfg

Lisp chạy rất ngon. Thanks bac Tue_NV nhiều ạ. Có cái này thì e biết được dừng đến đâu là hợp lý nhất, với lại mỗi người có 1 mục đích khác nhau mà bác nhỉ. Hi hi thanks bác nhiều ạ

Tháng 12 11, 2013

Lisp sửa theo ý kiến bạn trieubb

http://www.cadviet.com/upfiles/3/4652_rdt.lsp

http://youtu.be/sjG5unLRBfg

Bác có thể thêm chức năng rải text đi cùng và thay đổi giá trị cho text, hỏi giá trị bắt đầu (có thể là 1, hoặc 1 số bất kỳ) được ko ạ?

Tháng 12 11, 2013

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é.
(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)

)

Mình đang sử dụng lisp này để viết ứng dụng rải hố ga đang bị vướng mắc nhờ mọi người giúp đỡ.

ở đây mình chỉ sử dụng rải đối tượng là 1 Block thôi nên muốn công tác chọn đối tượng để rải chỉ 1 lần nghĩa là muốn thay hàm ssget bằng hàm entsel

Đoạn lisp cần giúp đỡ

(setq en (car (entsel "\nTim")))

(setq obj_en (vlax-ename->vla-object en))

Lisp cũ

(setq ss_Obj (ssget))

muốn thay

(setq ss_Obj (entsel "\nChon Block ho ga"))

Đây là lisp mình đã sửa lại

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/71521-da-xong-rai-doi-tuong-theo-duong-dan-dynamic/

 (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 ent 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 "\nDuong tim cong:")))
(setq obj_en (vlax-ename->vla-object en))
;(setq ent (car (entsel "\nChon Block ho ga:")))
(prompt "\nChon Block ho ga:")
(setq ss_Obj (ssget))
;(setq ss_Obj (vlax-ename->vla-object ent))
;(setq ptisoDef (dxf 10 ent))
(setq e (ssname ss_Obj 0))
(setq ptiso (dxf 10 e))
(setq
ss1 nil
pt1 (vlax-curve-getClosestPointTo en (getpoint "\nDiem goc")))
(initget 1 "D K")
(setq luachon (getkword "\nLua chon phuong phap rai pick diem tiep theo/Khoang cach rai:<D or K>"))
(if (or (= luachon "D") (= luachon "d"))
(progn
(setq
pt2 (vlax-curve-getClosestPointTo en (getpoint pt1 "\nDiem tiep theo"))
dis1 (vlax-curve-getDistAtPoint en pt1)
dis2 (vlax-curve-getDistAtPoint en pt2)
dis (abs (- dis1 dis2))
)
)
(setq dis (getreal "\nKhoang cach rai:"))
)
(prompt "\nPick diem cuoi[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)
)

Tháng 12 11, 2013

Chỉ mất công vì 1 cái enter mà làm mất đi tính đa năng của lisp thì có nên chăng?

Tháng 12 11, 2013

ý mình ở đây là muốn bỏ luôn công tác chọn đối tượng rải mà là sẽ insert từ ngoài vào luôn

lúc đó chỉ cần chọn tim thôi

chứ 1 cái enter không là vấn đề

P/S do không được đào tạo mà là tay ngang nên cứ mò mẫn từ từ được cái này rồi làm cái khác

Tháng 12 11, 2013

ý mình ở đây là muốn bỏ luôn công tác chọn đối tượng rải mà là sẽ insert từ ngoài vào luôn

lúc đó chỉ cần chọn tim thôi

chứ 1 cái enter không là vấn đề

P/S do không được đào tạo mà là tay ngang nên cứ mò mẫn từ từ được cái này rồi làm cái khác

À, tự vì bạn dùng hàm entsel nên tôi mới nghĩ thế. Chứ thay chọn block trên bản vẽ bằng cách chọn block từ bản vẽ khác thì đây cũng là 1 ý tưởng tốt. Hy vọng chủ topic sẽ bổ sung thêm 1 tùy chọn nữa để phù hợp nhu cầu từng người. Tôi hơi ngại sửa lisp người khác nên chỉ dám comment thế thôi.

Tháng 12 11, 2013

À, tự vì bạn dùng hàm entsel nên tôi mới nghĩ thế. Chứ thay chọn block trên bản vẽ bằng cách chọn block từ bản vẽ khác thì đây cũng là 1 ý tưởng tốt. Hy vọng chủ topic sẽ bổ sung thêm 1 tùy chọn nữa để phù hợp nhu cầu từng người. Tôi hơi ngại sửa lisp người khác nên chỉ dám comment thế thôi.

Hỏi khí không phải nhưng do gà mờ nên chưa hiểu hết được các cách chọn khác nhau.( khi thì biến trả về là list khi thì ename khi thì obj nói chung đang mơ hồ)

Có cách nào để trả biến từ cách chọn (entsel) sang cách chọn (ssget) không??

Tháng 12 11, 2013

Ssget là chọn 1 tập hợp (nhiều) các đối tượng trên bản vẽ. Có thể chỉ chọn 1 nhưng nó trả về là tên tập chọn.

entsel là chọn duy nhất 1 đối tượng trên bản vẽ.

Còn vấn đề bạn hỏi ở trên lại khác: đó là insert 1 block từ bản vẽ khác vào bản vẽ hiện hành, sau đó mới rải.

P/S: xoay quanh mấy khái niệm này chắc lần hồi lạc mất chủ đề của topic. Có vài topic hỏi về lisp đó bạn.

Tháng 12 11, 2013

Ssget là chọn 1 tập hợp (nhiều) các đối tượng trên bản vẽ. Có thể chỉ chọn 1 nhưng nó trả về là tên tập chọn.

entsel là chọn duy nhất 1 đối tượng trên bản vẽ.

Còn vấn đề bạn hỏi ở trên lại khác: đó là insert 1 block từ bản vẽ khác vào bản vẽ hiện hành, sau đó mới rải.

Nói chuyện với bạn từ hồi nãy đến giờ mà quên cám ơn 1 câu. dù chưa tìm ra được 1 giải pháp hợp lý nào mình cũng cám ơn bạn đã quan tâm

Mình thấy vấn đề ở đây 1 bên là 1 đối tượng 1 bên là 1 bock nó có sự tượng đồng nên mới hỏi vậy.

hi vọng sớm tìm ra cách.

một lần nữa cám ơn bạn nhiều chúc bạn sức khỏe để giúp đỡ các a em trên diễn đàn diễn đàn

Tháng 12 13, 2013

Lisp sửa theo ý kiến bạn trieubb

http://www.cadviet.com/upfiles/3/4652_rdt.lsp

http://youtu.be/sjG5unLRBfg

Bác Tue_NV xem giúp giùm mình với, sao lisp "4652_rdt.lsp" này mình không download được. Link thì dẫn được vào trang dowload nhưng khi nhấp vào Dowloads thì báo lỗi. Chân thành cảm ơn

Tháng 12 13, 2013

Bác Tue_NV xem giúp giùm mình với, sao lisp "4652_rdt.lsp" này mình không download được. Link thì dẫn được vào trang dowload nhưng khi nhấp vào Dowloads thì báo lỗi. Chân thành cảm ơn

Chắc là chức năng download của diễn đàn bị lỗi.

Thuphong có thể download tại đây :

https://www.mediafire.com/?28757952r4t1afy

Tháng 1 16, 2014

H mới down cái cải tiến của bác Tuệ. Theo ket thì đi đến đâu hiện số Nhóm đối tượng được rải thì hợp lý hơn ^^

Thanked bạn HHVD và bác Tuệ

Tháng 1 16, 2014

Em thấy cái này cũng hay:

Tháng 1 17, 2014

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

Tháng 1 17, 2014

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

Tháng 1 17, 2014

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

Tháng 10 20, 2015

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é.
(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!

Tháng 11 30, 2019

Lisp hay lắm ạ. Nếu các bác thêm giúp em lựa chọn nhập khoảng các chèn giữa các đối tượng nữa thì hay quá.

Đăng nhập

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

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

hochoaivandot 111

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.984

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

trieubb 5

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

trieubb 5

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

phamthanhbinh 3.146

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

ThuyLinh313 156

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

Tue_NV 3.912

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

trieubb 5

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

dovansinh 0

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

huunhantvxdts 195

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

Doan Van Ha 3.201

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

huunhantvxdts 195

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

Doan Van Ha 3.201

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

huunhantvxdts 195

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

Doan Van Ha 3.201

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

huunhantvxdts 195

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

thuphong 18

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

Tue_NV 3.912

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.984

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

Hoan1111 695