Đế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

#1 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 25 May 2013 - 10:09 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
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
  • 2

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 25 May 2013 - 11:55 AM

Hay quá HHVD ơi ^^


  • 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


#3 trieubb

trieubb

    biết vẽ ellipse

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

Đã gửi 14 October 2013 - 09:44 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
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 ạ


  • 0

#4 trieubb

trieubb

    biết vẽ ellipse

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

Đã gửi 14 October 2013 - 09:50 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

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 ạ


  • 1

#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 14 October 2013 - 11:10 AM

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.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 14 October 2013 - 04:13 PM

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.


  • 0

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 October 2013 - 05:28 PM

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

 

http://www.cadviet.c.../3/4652_rdt.lsp

 

 

http://youtu.be/sjG5unLRBfg


  • 1

#8 trieubb

trieubb

    biết vẽ ellipse

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

Đã gửi 15 October 2013 - 08:24 AM

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

 

http://www.cadviet.c.../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 ạ


  • 0

#9 dovansinh

dovansinh

    biết pan

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

Đã gửi 11 December 2013 - 08:54 AM

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

 

http://www.cadviet.c.../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 ạ?


  • 0
Đỗ Văn Sinh - 0936588006
Email: dovansinh@gmail.com
Skype: dovansinh
Yahoo: dovansinh_haui

#10 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 11 December 2013 - 10:04 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)
)

 

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.c...ng-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)
)


  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 December 2013 - 10:12 AM

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?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 11 December 2013 - 10:19 AM

ý 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


  • 0

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 December 2013 - 10:42 AM

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


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 11 December 2013 - 10:53 AM

À, 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??


  • 0

#15 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 December 2013 - 11:00 AM

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.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#16 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 11 December 2013 - 11:19 AM

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 


  • 0

#17 thuphong

thuphong

    biết vẽ circle

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

Đã gửi 13 December 2013 - 10:54 AM

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

 

http://www.cadviet.c.../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


  • 0

#18 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 December 2013 - 06:52 AM

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.mediafir...28757952r4t1afy


  • 0

#19 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 January 2014 - 08:32 PM

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ệ


  • 0

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


#20 Hoan1111

Hoan1111

    biết lệnh adcenter

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

Đã gửi 16 January 2014 - 11:40 PM

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

 

 


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