trieubb
-
Số lượng nội dung
63 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi trieubb
-
-
Nếu vẫn còn làm công việc đó Bạn vào đây xem sao nhé!
Do nghề mình cũng hay đụng vấn đề này nên "Thấy hay là làm"
(à mình lấy ý tưởng từ pfievxd)
https://www.facebook.com/huy.duongtrung/videos/721324744718032/?l=6051686449029806241
sao không có lisp nhỉ bạn
-
7 năm rồi mà không có cao thủ nào dứt điểm cái LISP này sao
-
1
-
-
Với bài toán rõ ràng như thế bạn nên hatch và đọc property Area của Hatch
Vâng bạn, vấn đề là bản vẽ rất nhiều, nên làm thủ công như vậy thì chết
-
Thử cái này xem đã đúng ý chưa.
;Doan Van Ha - CADViet.com - Ngay 02/4/2012 ;Muc dich: tang/giam nhieu ly trinh voi cung 1 gia tri (VD ky hieu ly trinh: "Km:0+00.00", can tang 100.00) ;So chu so le phu thuoc ket qua. (defun C:HA( / entlst tang) (princ "\nChon cac Text ly trinh can tang/giam...") (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT") (1 . "Km:*"))))))) (setq tang (getreal "\nNhap gia tri (met) tang/giam: ")) (foreach ent entlst (entmod (subst (cons 1 (HA (cdr (assoc 1 (entget ent))) tang)) (assoc 1 (entget ent)) (entget ent)))) (princ)) ;----- VD: txtcu = "Km:0+20.32" ; tang = 100.00 (defun HA(txtcu tang / trai phai txtmoi) (setq somoi (+ (* (atoi (TRAI_STR (substr txtcu 4) "+")) 1000) (atof (PHAI_STR (substr txtcu 4) "+")) tang)) (setq trai (fix (/ somoi 1000.0))) (setq phai (- somoi (* trai 1000))) (strcat "Km:" (itoa trai) "+" (if (= phai (atoi (rtos phai 2 0))) (rtos phai 2 0) (rtos phai 2 2)))) (defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1)))) (defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))
Lisp hay nhưng bác xem lại có 1 lỗi như sau: VD Km:1+5.45 cộng vào 5m nữa kết quả thành Km:0+10.45
Thứ hai là bác có thể sửa cái chữ số m ấy lúc nào cũng là 3 số VD Km:1+5.45 thành Km:1+005.45
-
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 ạ
-
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
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
-
-
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?
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 ...
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 ạ
-
Có cao thủ nào giúp em với ạ??? e đang cần quá ạ.
-
Hề hề hề,
Nếu là bạn muốn viết lisp mới thì phải làm đúng quy định chứ nhể???
Hãy gửi bản vẽ thể hiện những điều bạn đã có trước khi chạy líp và thể hiện những cái bạn cần sau khi sử dụng lisp chớ.
Mình không phải có chuyên môn về ống nước như bạn nên không thể có những bản vẽ tương tự của bạn và cũng không thể hiểu yêu cầu của bạn một các tương đối chuẩn xác nếu như không được nhòm thấy cái bản vẽ của bạn bạn ạ.
Dân kỹ thuật thì thường hay nói chuyện với nhau bằng bản vẽ chứ văn tự dài dòng nhiều khi dẫn tới hiểu nhầm nhau chí chết đấy bạn ạ.
Các bác ơi, các bác cố gắng giúp em với ạ??? Nay sang tháng rồi mà không ai giúp cả. Hu hu
-
Hề hề hề,
Nếu là bạn muốn viết lisp mới thì phải làm đúng quy định chứ nhể???
Hãy gửi bản vẽ thể hiện những điều bạn đã có trước khi chạy líp và thể hiện những cái bạn cần sau khi sử dụng lisp chớ.
Mình không phải có chuyên môn về ống nước như bạn nên không thể có những bản vẽ tương tự của bạn và cũng không thể hiểu yêu cầu của bạn một các tương đối chuẩn xác nếu như không được nhòm thấy cái bản vẽ của bạn bạn ạ.
Dân kỹ thuật thì thường hay nói chuyện với nhau bằng bản vẽ chứ văn tự dài dòng nhiều khi dẫn tới hiểu nhầm nhau chí chết đấy bạn ạ.
Vâng ạ, cảm ơn bác phamthanhbinh đã quan tâm, được bác giúp em yên tâm rồi. File bản vẽ đây bác ạ http://www.cadviet.com/upfiles/3/16281_do_chieu_dai_ong_nuoc.dwg mong bác giúp đỡ ạ
-
Sao không dùng phầm mềm thiết kế mà dùng lisp. Nova hay phần mềm gì làm cái này cũng OK hết.
Dùng phần mềm bạn còn có thể lựa chọn vét ngang, vét theo độ dốc hay vét theo đường tự nhiên nữa.
Viết lisp không tối ưu đâu bạn...
bác nói thế thì còn nói gì nữa, nhưng vấn đền là dùng lisp cơ bác ạ
-
Nhờ các bác sửa giùm em cái lisp bóc phong hóa và tính luôn diện tích đã bóc ghi kết quả ra màn hình. Cái này http://www.cadviet.com/upfiles/3/16281_bphs.lsp em viết nhưng nó mất nhiều công đoạn quá. Các bác có thể giúp em làm sao chỉ có các thao tác. 1-chọn đường tự nhiên, 2 -chọn điểm đầu, điểm cuối, 3-chọn chiều sâu cần bóc, 4- chọn vị trí ghi kết quả là OK, thanks các bác ạ
-
Hề hề hề,
Không hiểu yêu cầu của bạn là gì nữa????
Cái lisp bạn post lên hình như có sự sửa chữa gì của bạn trong đó.
Bản thân lisp đã cho phép bạn chọn một tập hợp các đối tượng và đáng lẽ với mỗi đối tượng bạn phải ghi text một lần thì việc này đã được sửa để chỉ ghi một lần tổng kich thước..
Ngoài ra cái vòng lặp While đầu tiên của lisp chưa rõ điều kiện kết thúc vòng lặp.
Vậy nên chả biết bạn cần sửa thế nào nữa??????
Vâng rất cảm ơn bác đã quan tâm ạ. Cái lisp đó là e tự sửa lại từ cái lisp đo tổng chiều dài, tóm lại là nhờ bác viết lại luôn theo ý tưởng của e bác ạ. Tức là viết lisp thực hiện đo chiều dài hàng loạt đoạn ống theo cách dùng chuột quét hàng loạt đường ống và ghi kết quả theo đường kính ống (là tên layer VD D25, D32, D40...) ra bên cạnh đường ống đó VD D32 - 250.36m và có màu theo lớp D32 VD mầu vàng, hướng xoay theo đoạn thẳng cần đo
-
Em chào các bác, em có file lisp này: cdnl.lsp. http://www.cadviet.com/upfiles/3/16281_cdnl.lsp Nó thực hiện đo chiều dài đoạn ống theo đường kính ống (là tên layer VD D25, D32, D40...) rồi ghi kết quả ra bên cạnh đường ống đó VD D32 - 250.36m và có màu theo lớp D32 VD mầu vàng, hướng xoay theo đoạn thẳng cần đo. Nhưng làm từng đoạn 1 thì lâu quá. Em nhờ các bác sửa lại cho em làm sao ghi được hàng loạt bằng các quét chuột qua các đối tượng ạ. Em cảm ơn nhiều ạ, à em đang cần gấp ạ.
-
Sửa cho bạn đây. Lisp có thể dùng cho Line, Polyline, Lwpolyline, Spline.
;Doan Van Ha - CADViet.com - Ngay 16/5/2012. Edit 11/7/2013 ;Muc dich: nhom cac doi tuong *Line cung Length va cung Layer, sau do xuat ra file. (defun C:HA( / entlst lst fn pw) (princ "\nChon cac doi tuong de lay chieu dai can xuat ra file...") (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*LINE"))))))) (foreach ent entlst (setq lst (cons (list (cdr (assoc 8 (entget ent))) (atof (rtos (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2 4))) lst))) (setq lst (LM:ListOccurrences lst)) (setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1)) (setq pw (open fn "w")) (write-line (strcat "Chieu dai" "\t" "So luong" "\t" "Layer") pw) (foreach n lst (write-line (strcat (vl-prin1-to-string (cadr (car n))) "\t" (itoa (cdr n)) "\t" (car (car n))) pw)) (close pw) ) (defun LM:ListOccurrences (lst) ;Thank Lee Mac (if lst (cons (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst))))) (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
Lệnh rất hay bác ạ nhưng bác có thể viết them 1 cái là chỉ cần thống kê chiều dài và tên layer ra luôn bản vẽ và đặt cạnh từng đoạn luôn không bác, thanks bác nhiều.Chờ tin bác
-
Chào bạn Thaistreetz,
Bạn dùng thử cái này nha:
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) ;;;-------------------------------------------------------------------- (defun C:TL( / ss L e) (setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))) L 0.0 k (getvar "dimlfac") ) (vl-load-com) (while (setq e (ssname ss 0)) (setq L (* k (length1 e))) (setq ans (getstring "\n Ban hay chon phuong an nhap ket qua ")) (if (= ans "1") (progn (setq te (entget(car(entsel "\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)) (entmod te) ) (progn (setq p (getpoint "\n Chon diem nhap ket qua" )) (setq h (getreal "\n Nhap chieu cao text ket qua ")) (command "text" p h "0" (rtos L 2 2)) ) ) (ssdel e ss) ) (princ) ) ;;;--------------------------------------------------------------------
Đoạn lisp này mình chỉnh sửa lại từ cái lisp của bác SSG và bác Tue_nv do mình nghĩ có thể bác Tue_NV hiểu nhầm ý bạn. Bạn muốn lấy các độ dài của từng đoạn chứ không phải lấy tổng độ dài, vả lại bạn cũng muốn kết quả ghi theo tỷ lệ của dimstyle hiện tại chứ không phải là kết quả đo được nữa. Ở lisp này mình cũng để bạn chọn phương án nhap kết quả , nhưng bạn lưu ý là khi lisp hỏi bạn chỉ cần gõ 1 hoặc enter là đủ bạn nhé. Bạn xài thử xem nhé. Nếu có gì trục trặc xin báo lại vì mình cũng chưa kiểm nghiệm nó do chưa có thời gian bạn ạ. Thực ra mình cũng chưa ưng ý với lisp này do nếu như bạn chọn khá nhiều đối tượng thì việc nhớ được trật tự khi lựa chọn đối tượng không hề dễ. Theo ý mình thì nên mỗi lần chỉ chọn một đối tượng và sau khi chạy xong thi lisp sẽ hỏi bạn có muốn tiếp tục hay không, nếu có thì chọn đối tượng tiếp, còn nếu không thì kết thúc sẽ thuận lợi cho việc chỉnh sửa trên bản vẽ của bạn hơn.
Không biết bạn nghĩ sao, nếu bạn đồng ý mình sẽ cải tạo lại đoạn lisp trên bạn nhé.
Chúc bạn vui.
@ Bác Tue_NV: Mạn phép bác sửa lại chút xíu cái lisp của bác cho gần với yêu cầu của bạn Thaistreetz hơn. Mong bác không giận.
Bác viết thêm là thể hiện thứ tự các đoạn cần điền chiều dài (theo thứ tự mà lisp nhận được) chứ không biết đâu mà ghi chiều dài được bác ạ. Mong bác giúp đỡ
-
Mình gửi bạn lisp xuất sang file text,mình thường dùng đề lấy cao độ khi làm san nền ( một số video hướng dẫn san nền mình cũng dùng lisp này)
(defun doichu () (setvar "cmdecho" 0) (setvar "cmdecho" 0) (setvar "osmode" 0) (if_file2) ;(setq s (getstring "\nFilename <Khong-Ten>: ")) ;(if (= s nul) (setq s "Khong-Ten")) (setq fn (open filename2 "w")) (setq i 0) (setq j 1) (prompt "\n") (prompt "\Chän C¸c §iÓm Cao §é : ") (setq ss (ssget (list (cons 0 "Text")))) (if ss (progn (repeat (sslength ss) (setq ent (entget (ssname ss i))) (setq nd (cdr (assoc 1 ent))) (setq ss1 (cdr (assoc 72 ent))) (setq ss2 (cdr (assoc 73 ent))) (if (and (= ss1 0) (= ss2 0)) (setq td (cdr (assoc 10 ent))) (setq td (cdr (assoc 11 ent))) ) ;(setq td1 (cdr (assoc 10 ent))) (setq Y (cadr td)) (setq X (car td)) (setq z (caddr td)) (write-line (strcat (itoa j) " " (rtos X 2 3) " " (rtos Y 2 3) " " (rtos z 2 3) " " nd ) fn) (setq i (+ i 1)) (setq j (+ j 1)) ) ) ) (close fn) (setvar "osmode" 191) (prompt "\n**** Chóc B¹n Thµnh C«ng ***") (princ) ) ;******************************** ;********* (defun c:xtd () (doichu) ) ;;***************************Mo file (defun if_file1 (/ name1) (if (= filename1 nil) (progn (setq name1 (getfiled "Më TËp Tin Chøa Sè LiÖu" (strcat "d:/canhan/TUAN/luu/" "solieu") "txt" 2)) (if name1 (setq filename1 (strcase name1))) ) (progn (setq name1 (getfiled "Më TËp Tin Chøa Sè LiÖu" filename1 "txt" 2)) (if name1 (setq filename1 (strcase name1))) ) ) ) ;****************************Ghi file (defun if_file2 (/ name2) (if (= filename2 nil) (progn (setq name2 (getfiled "Më TËp Tin Chøa Sè LiÖu" (strcat "d:/canhan/TUAN/luu/" "solieu") "txt" 1)) (if name2 (setq filename2 (strcase name2))) ) (progn (setq name2 (getfiled "Lu TËp Tin Sè LiÖu" filename2 "txt" 1)) (if name2 (setq filename2 (strcase name2))) ) ) )Vậy bác có cái nào làm ngược lại không bác? tức từ file txt (giống như file bác xuất ra) và import các điểm vào bản vẽ có hiện cái cột thứ 5 cao độ lên ấy bác.
-
Jin xin giới thiệu chương trình thống kế cốt thép cho kết cấu bê tông cốt thép - CTK
Chương trình thuộc dự án phát triển CADViet Utility
Khác với các chương trình thống kê khác, chương trình gồm có hai phần độc lập:
- Phần 1 được viết bằng VB để tối ưu hóa việc soạn thảo và chỉnh sửa, file xuất ra dạng text có đuôi là (*.tk5)
- Phần 2 là file Lisp, bạn chỉ cần load trong Cad file CTK.lsp rồi gọi lệnh ctk, chương trình sẽ yêu cầu chọn file (*.tk5) và chọn điểm chèn.
Hình 1: Chương trình soạn thảo
Hình 2: Gọi lệnh ctk trong AutoCAD, yêu cầu chọn file
Hình 3: Kết quả
Mình mới down hôm nay, thấy ngay 2 chỗ chưa hợp lý lắm bạn ạ, 1 đó là cái chỗ nhập đường kính thép ấy, theo mình cái đó là chọn chứ không cho nhập chứ nhập 11 nó cũng được hihi. Nên cho chọn các đường kính có trên thị trường để tránh nhầm lẫn gây buồn cười. Ví dụ như 12, 14 mà không có 13
2 là cái ô hình dạng, kích thước cũng cần đường kẻ ngang chứ bạn.
-
Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.
1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.
2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín
3.Lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn
Các thao tác để tạo pline bao ngoài có thể gói gọn bằng lisp này, của 1 Pro người nga do 1 pro người Việt (^^) giới thiệu.Lệnh Eco.Sau khi có em bao ngoài rồi thì việc còn lại k có j phứcc tạp cả ^^
;;;; External contour of objects(defun C:ECO (/ *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm iNSpT ) (defun *error* (msg) (princ msg) (mapcar '(lambda (x) (vla-put-visible x :vlax-true)) hiden) (vla-endundomark adoc) (if (and tmp_blk (not (vlax-erased-p tmp_blk)) (vlax-write-enabled-p tmp_blk) ) ;_ end of and (vla-erase tmp_blk) ) ;_ end of if (if osm (setvar "OSMODE" osm) ) ;_ end of if (foreach x loc (vla-put-lock x :vlax-true)) ) ;_ end of defun (vl-load-com) (setvar "CMDECHO" 0) (setq osm (getvar "OSMODE")) (if (zerop (getvar "WORLDUCS")) (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" "")) ) ;_ end of if (setq isRus (= (getvar "SysCodePage") "ANSI_1251")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) blks (vla-get-blocks adoc) lays (vla-get-layers adoc) ) ;_ end of setq (vla-startundomark adoc) (if isRus (princ "\n§£§í§Ò§Ö§â§Ú§ä§Ö §à§Ò§ì§Ö§Ü§ä§í §Õ§Ý§ñ §á§à§ã§ä§â§à§Ö§ß§Ú§ñ §Ü§à§ß§ä§å§â§Ñ") (princ "\nSelect objects for making a contour") ) ;_ end of if (vlax-for lay lays (if (= (vla-get-lock lay) :vlax-true) (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)) ) ;_ end of progn ) ;_ end of if ) ;_ end of vlax-for (if (setq sel (ssget)) (progn (setq sel (ssnamex sel)) (setq iNSpT '(0 0 0)) (setq sel (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr sel)) ) ;_ end of mapcar ) ;_ end of setq (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel)))) (setq unnamed_block (vla-add (vla-get-blocks adoc) (vlax-3d-point inspt) "*U" ) ;_ end of vla-add ) ;_ end of setq (foreach x sel (setq oname (strcase (vla-get-objectname x))) (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT" ) ) ;_ end of member nil ) ((= oname "ACDBBLOCKREFERENCE") (vla-insertblock unnamed_block (vla-get-insertionpoint x) (vla-get-name x) (vla-get-xscalefactor x) (vla-get-yscalefactor x) (vla-get-zscalefactor x) (vla-get-rotation x) ) ;_ end of vla-InsertBlock (setq blk (cons x blk)) ) (t (setq obj (cons x obj))) ) ;_ end of cond ) ;_foreach (setq lay (vla-item lays (getvar "CLAYER"))) (if (= (vla-get-lock lay) :vlax-true) (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)) ) ;_ end of progn ) ;_ end of if (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))) ) ;_ end of vlax-make-safearray obj ) ;_ end of vlax-safearray-fill ) ;_ end of vlax-make-variant unnamed_block ) ;_ end of vla-copyobjects ) ;_ end of progn ) ;_ end of if (setq obj (append obj blk)) (if obj (progn (setq tmp_blk (vla-insertblock csp (vlax-3d-point inspt) (vla-get-name unnamed_block) 1.0 1.0 1.0 0.0 ) ;_ end of vla-insertblock ) ;_ end of setq (vla-getboundingbox tmp_blk 'MinPt 'MaxPt) (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt) DS (max (distance MinPt (list (car MinPt) (cadr MaxPt))) (distance MinPt (list (car MaxPt) (cadr MinPt))) ) ;_ end of max DS (* 0.2 DS) ;1/5 DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS)) MaxPt (mapcar '+ MaxPt (list DS DS)) ) ;_ end of setq (lib:Zoom2Lst (list MinPt MaxPt)) (setq sset (ssget "_C" MinPt MaxPt)) (if sset (progn (setvar "OSMODE" 0) (setq hiden (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)) ) ;_ end of vl-remove-if ) ;_ end of mapcar hiden (vl-remove tmp_blk hiden) ) ;_ end of setq (mapcar '(lambda (x) (vla-put-visible x :vlax-false)) hiden ) ;_ end of mapcar (setq pt (mapcar '+ MinPt (list (* 0.5 DS) (* 0.5 DS)))) (vl-cmdf "_.RECTANG" (trans MinPt 0 1) (trans MaxPt 0 1)) (setq pl (vlax-ename->vla-object (entlast))) (setq sc (entlast)) (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "") (while (> (getvar "CMDACTIVE") 0) (command "")) ) ;_ end of lambda ) ;_ end of VL-CATCH-ALL-APPLY ) ;_ end of VL-CATCH-ALL-ERROR-P (if isRus (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â") (princ "\nIt was not possible to construct a contour") ) ;_ end of if ) ;_ end of if (setq ec sc) (while (setq ec (entnext ec)) (setq ret (cons (vlax-ename->vla-object ec) ret)) ) (setq ret (vl-remove pl ret)) (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x)) (list pl tmp_blk) ) ;_ end of mapcar (setq pl nil tmp_blk nil ) ;_ end of setq (setq ret (mapcar '(lambda (x / mipt) (vla-getboundingbox x 'MiPt nil) (setq MiPt (vlax-safearray->list MiPt)) (list MiPt x) ) ;_ end of lambda ret ) ;_ end of mapcar ) ;_ end of setq (setq ret (vl-sort ret '(lambda (e1 e2) (< (distance MinPt (car e1)) (distance MinPt (car e2)) ) ;_ end of < ) ;_ end of lambda ) ;_ end of vl-sort ) ;_ end of setq (setq pl (nth 1 ret) ret (vl-remove pl ret) ) ;_ end of setq (mapcar 'vla-erase (mapcar 'cadr ret)) (mapcar '(lambda (x) (vla-put-visible x :vlax-true)) hiden ) ;_ end of mapcar (foreach x loc (vla-put-lock x :vlax-true)) (if pl (progn (initget "Yes No") (if (= (getkword (if isRus "\n§µ§Õ§Ñ§Ý§ñ§ä§î §à§Ò§ì§Ö§Ü§ä§í? [Yes/No] : " "\nDelete objects? [Yes/No] : " ) ;_ end of if ) ;_ end of getkword "Yes" ) ;_ end of = (mapcar '(lambda (x) (if (vlax-write-enabled-p x) (vla-erase x) ) ;_ end of if ) ;_ end of lambda obj ) ;_ end of mapcar ) ;_ end of if ) ;_ end of progn (if isRus (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â") (princ "\nIt was not possible to construct a contour") ) ;_ end of if ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if (vl-catch-all-apply '(lambda () (mapcar 'vlax-release-object (list unnamed_block tmp_blk csp blks lays) ) ;_ end of mapcar ) ;_ end of lambda ) ;_ end of VL-CATCH-ALL-APPLY ) ;_ end of progn ) ;_if not (foreach x loc (vla-put-lock x :vlax-true)) (setvar "OSMODE" osm) (vla-endundomark adoc) (vlax-release-object adoc) (command ".area" "o" "L")(setq dt (getvar "area"))(command ".erase" L "") (writeres dt) (princ)) ;_ end of defun;;; ========== HELPER FUNCTION ==========================================(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc) (setq pt (trans pt 0 1)) (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE") SSZ (getvar "SCREENSIZE") X_Pix (car SSZ) Y_Pix (cadr SSZ) X_Len (* (/ X_Pix Y_Pix) Y_Len) Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len)) Uc (polar Lc 0.0 X_Len) Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len)) Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)) ) ;_ end of setq (if (and (> (car pt) (car Lc)) (< (car pt) (car Uc)) (> (cadr pt) (cadr Lc)) (< (cadr pt) (cadr Uc)) ) ;_ end of and t nil ) ;_ end of if) ;_ end of defun(defun DTR (a) (* pi (/ a 180.0)))(defun lib:pt_extents (vlist / tmp) (setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x)) (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) '(0 1 2) ) ;_ end of mapcar ) ;_ end of mapcar ) ;_setq (list (mapcar '(lambda (x) (apply 'min x)) tmp) (mapcar '(lambda (x) (apply 'max x)) tmp) ) ;_ end of list) ;_defun(defun lib:Zoom2Lst (vlist / bl tr Lst OS) (setq Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst) ) ;_ end of setq (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr))) (progn (setq OS (getvar "OSMODE")) (setvar "OSMODE" 0) (command "_.Zoom" "_Window" (trans bl 0 1) (trans tr 0 1) "_.Zoom" "0.95x" ) ;_ end of command (setvar "OSMODE" OS) t ) ;_ end of progn NIL ) ;_ end of if) ;_ end of defun(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))(defun WriteRes(kq / OK e data)(setq OK nil)(while (not OK)(setq e (car (entsel "\tChon text ghi ket qua:")))(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text")))(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))(princ))Vẫn không tính được hình này bác ạ
-
Không ổn tí nào bác "pfievxd" và bác "Happyspringla2007" ạ vấn đề bác hãy thử lại nếu nó cắt nhau trên dưới thì nó sai hết bác ạ (bác xem hình 1 nhé)
nhân đây bác sửa dùm em tính cái hình như thế này ạ (hình 2)
-
Em xin chào bác Tue_NV, lisp của bác rất hay, nhưng bác có thể sửa lại dùm em là nó có thể đánh từ trên xuống hay không ạ.
Lisp của bác nó toàn đánh từ dưới lên thôi ạ. Và em cũng đồng tình với bác catly là đánh theo chiều cao thì sao hả bác.
Bác có thể giúp em không ạ. Em đang cần dùng lisp này ạ
-
Hề hề hề
Phải chăng bạn cần cái này:
(defun c:glt (/ pl plst pa pd k l ltg p0 a lt lt1 lt2 txt tg etg txtp txtp1 txtp2 dl dl1 dl2) (vl-load-com) (command "undo" "be") (setq ucsold (getvar "ucsname")) (command "ucs" "w") (setq pl (car (entsel "\n Chon polyline can ghi ly trinh"))) (setq plst (vl-sort (acet-geom-vertex-list pl) '(lambda (x y) (< (car x) (car y))))) (setq pa (getstring t "\n Chon chieu ghi ly trinh <T or P>: ")) (if (= (strcase pa) "T") (setq pd (car plst)) (setq pd (last plst)) ) (setq p0 (getpoint "\n Chon diem goc ghi ly trinh")) (setq ltg (getreal "\n Nhap ly trinh goc: ")) (setq k (getint "\n Chon so chu so thap phan: ")) (setq l (getint "\n Chon phuong an ghi ly trinh <1 or 2>: ")) (setq a (getpoint "\n Chon point can ghi ly trinh")) (while ( /= a nil) (if (= l 1) (progn (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001) (setq lt (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) ) ltg ) ) (setq lt (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) ) ltg ) ) ) (setq dl (abs (- lt (* (fix (/ lt 1000)) 1000)))) (if (< (fix dl) 100) (if (< (fix dl) 10) (setq txtp (strcat "00" (rtos dl 2 k))) (setq txtp (strcat "0" (rtos dl 2 k))) ) (setq txtp (rtos dl 2 k)) ) (if (> lt 0) (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "+" txtp)) (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "-" txtp)) ) (setq tg (car (entsel "\n Chon text can thay the "))) (setq etg (entget tg)) (setq etg (subst (cons 1 txt) (assoc 1 etg) etg)) (entmod etg) ) (progn (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001) (progn (setq lt1 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) ) ltg ) ) (setq lt2 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh"))) (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) ) ltg )) ) (progn (setq lt1 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) ) ltg )) (setq lt2 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh"))) ) ltg )) ) ) (setq dl1 (abs (- lt1 (* (fix (/ lt1 1000)) 1000)))) (if (< (fix dl1) 100) (if (< (fix dl1) 10) (setq txtp1 (strcat "00" (rtos dl1 2 k))) (setq txtp1 (strcat "0" (rtos dl1 2 k))) ) (setq txtp1 (rtos dl1 2 k)) ) (setq dl2 (abs (- lt2 (* (fix (/ lt2 1000)) 1000)))) (if (< (fix dl2) 100) (if (< (fix dl2) 10) (setq txtp2 (strcat "00" (rtos dl2 2 k))) (setq txtp2 (strcat "0" (rtos dl2 2 k))) ) (setq txtp2 (rtos dl2 2 k)) ) (if (and (>= lt1 0) (>= lt2 0)) (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 ))) (if (and (>= lt1 0) (< lt2 0)) (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 ))) (if (and (< lt1 0) (>= lt2 0)) (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 ))) (if (and (< lt1 0) (< lt2 0)) (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 ))) (setq tg (car (entsel "\n Chon text can thay the "))) (setq etg (entget tg)) (setq etg (subst (cons 1 txt) (assoc 1 etg) etg)) (entmod etg) ) ) (setq a (getpoint "\n Ban hay chon diem tiep theo: ")) ) (if (/= ucsold "") (command "ucs" "p") ) (command "undo" "e") (princ) )Hề hề hề.
@ phamxuanly gtvt: hãy gửi bản vẽ bị lỗi lên...
Kính chuyển bác phamthanhbinh lisp của bác khi chọn lý trình gốc là 0 thì tại 1000m ghi là Km1+000, 2000m ghi là Km2+000, 3000m ghi là Km3+000 thì ok, nhưng đến 4000m nó lại ghi là Km3+1000 bác xem lại nhé
-
Sắp tết rồi mà không có cao thủ nào giúp đỡ
-
Đây là ví dụ mình down được ở trên mạng
http://www.4shared.com/file/IQLvlYfC/bt2.html
mời các cao thủ quan tâm giúp đỡ
Tính diện tích tạo nên từ những vùng giao nhau giữa 2 đường polyline
trong AutoLisp
Đã đăng · Trả lời báo cáo
bác có thể tách riêng thành 1 lisp riêng rồi check xem nó lỗi tùm lum rồi ạ