tientracdia
-
Số lượng nội dung
145 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi tientracdia
-
-
-
-
Mình muốn bạn giúp chỉnh lisp trên, không thể hiện đường line và mũi têm của Dim. Cảmơn
-
Lisp thống kê rất hay.
Mình muốn nhờ bạn bổ sung viết bảng thống kê, như sau : chọn tên điểm của cạnh 2 đầu, và chọn cạnh ( khi chọn cạnh thì đổi màu ). Thống kê theo bảng vẽ sau.
Cám ơn
-
1
-
-
-
Không hiểu bạn đang nói gì ...
-
1
-
-
hehe .... buon qua khong ai cuu
-
1
-
-
Mình có 1 file txt và file Cad. Muốn sử dụng lisp trên để thay thế của file txt vào Cad, nhưng không thay thế được.
Mong được bạn giúp.
-
1
-
-
Vào lúc 19/1/2018 tại 22:48, huunhantvxdts đã nói:Đã gửi cho bạn xem thêm clip bản hoàn thiện hơn
Chưa nhận được bạn ơi. Bạn xem lại giúp mình
tranvantien.qhxd.longan@gmail.com
-
Vào lúc 5/3/2017 tại 10:42, huunhantvxdts đã nói:Đây là bản nâng cấp hoàn thiện. mọi người xem làm theo hướng dẫn
Tuyệt quá. Bạn cho mình xin bộ chương trình này với.
tranvantien.qhxd.longan@gmail.com
-
Hay quá, Bạn cho mình xin một bản đi
-
- hi bạn thông cảm, sáng giờ bị sếp dí chưa kip sữa cho bạn ^^, giờ mới rãnh xem, bạn xem nhoc sữa vậy vừa ý chưa hì :P
;=============================================================================================================== (defun K:style (MyStyle MyFont) (entmake (list (cons 0 "STYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbTextStyleTableRecord") (cons 2 MyStyle) (cons 3 MyFont) (cons 70 0)))) ;;;;; ;============================ ;;-------------------------------------- (defun K:layer (ten clr) (if (null (tblsearch "LAYER" ten)) (entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 ten) (cons 62 clr)) ) ) ) ;;;;;;;;;;------------------------------------------- ;;;;;;;;;;;============================================================ (defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst) (setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) '(100 . "AcDbPolyline") (cons 90 (length listpoint)) (cons 70 (if closed 1 0)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP))))) (if xdata (setq Lst (append lst (list (cons -3 (list xdata)))))) (entmakex Lst)) ;end;================================= ;;; (defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata) (entmakex (list '(0 . "LINE") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 6 (if Linetype Linetype "bylayer")) (cons 48 (if LTScale LTScale 1)) (cons 10 PT1) (cons 11 PT2) (cons -3 (if xdata (list xdata) nil))))) ;;;;;;-------------------------------------------------------------------------------------------- ;ham tao text 2 (defun taotext (point height string justify layer textstyle mau / lst) (setq lst (list '(0 . "TEXT") (cons 10 point) (cons 40 height) (cons 1 string) (cons 8 (if layer layer (getvar "clayer"))) (cons 7 (if textstyle textstyle (getvar 'textstyle))) (cons 62 (if mau mau 256)) ) justify (strcase justify)) (cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point))))) ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))) ) (entmakex Lst) );end mktext ;-------------------------------------- (alert "LSP xuat bang thong ke goc canh , lenh: KKP") ;;---------------------------------------------------------------------------------------------- (defun c:kkp(/ ss ename lst lstcanh lstgoc dem p1 p2 p3 d ang1 ang2 goc kdo dau i k m f j pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 goc270 pt tt ll gg ptt pll pgg old canh kgoc) (vl-load-com) (setq old (getvar 'osmode)) (setvar 'osmode 0) (if (null (tblsearch "style" "ARIAL-bang")) (K:style "ARIAL-bang" "arial.ttf")) (K:layer "bang-goccanh" 4) (prompt "chon PLine:") (setq ss (ssget "+.:E:S" '((0 . "*POLYLINE")))) (if ss (progn ;-------------------------------------------------------------------- (setq ename (ssname ss 0)) (setq lst (acet-geom-vertex-list ename)) (setq lstcanh nil lstgoc nil) ;================================================ (setq p1 (car lst) dem 1) ;=============================================================== (while (< dem (length lst)) (setq p2 (nth dem lst)) (setq d (distance p1 p2)) (setq lstcanh (append lstcanh (list d))) (setq p1 p2 dem (1+ dem)) (princ) ) (setq bdau 1) (foreach x lst (taotext (polar x (/ pi 2) 0.5) 0.8 (itoa bdau) "M" "bang-goccanh" "ARIAL-bang" 1) (setq bdau (1+ bdau)) ) ;================================================================================== (setq p1 (car lst) dem 1) ;=============================================================================== (while (< dem (1- (length lst))) (setq p2 (nth dem lst)) (setq p3 (nth (1+ dem) lst)) (setq ang1 (angle p2 p1) ang2 (angle p2 p3)) (setq goc (abs (- ang1 ang2))) (if (> goc PI) (setq goc (- (* 2 pi) goc)) ) ;================================================================================ (setq kdo (* (/ goc pi) 180.0)) (setq lstgoc (append lstgoc (list kdo))) ;==================================================================================== (setq p1 p2 dem (1+ dem)) ) ;======================================================================================== (setq pt (getpoint "\nChon diem dat bang:")) (if (/= pt nil) (progn (setq pt1 (mapcar '+ pt (list 45.0 0.0 0.0)) pt2 (mapcar '+ pt (list 0.0 -4.0 0.0)) pt3 (mapcar '+ pt (list 45.0 -4.0 0.0)) pt4 (mapcar '+ pt (list 5.0 0.0 0.0)) pt5 (mapcar '+ pt (list 25.0 0.0 0.0))) ;-------------------------------------------------- (taotext (mapcar '+ pt (list 2.5 -2.0 0.0)) 1.8 "TT" "M" "bang-goccanh" "ARIAL-bang" nil) (taotext (mapcar '+ pt (list 15.0 -2.0 0.0)) 1.8 "L" "M" "bang-goccanh" "ARIAL-bang" nil) (taotext (mapcar '+ pt (list 35.0 -2.0 0.0)) 1.8 "GOC" "M" "bang-goccanh" "ARIAL-bang" nil) (makeline pt2 pt3 nil nil nil nil) ;----------------------------------------------------- (setq i 1) (while (<= i (length lst)) (progn ;-------------------------- (setq tt (list 2.5 (- (* -5.0 i) 2.0) 0.0)) (setq ptt (mapcar '+ pt tt)) ;-------------------------------- ;------------------------------ (taotext ptt 1.8 (itoa i) "M" nil nil 4) (setq i (1+ i)) ) ) ; end while ;=============================================== (setq k 0 m 1) (repeat (- (length lst) 1) (setq ll (list 15.0 (- (* -5.0 m) 4.5) 0.0)) (setq pll (mapcar '+ pt ll)) (setq canh (nth k lstcanh)) (taotext pll 1.8 (rtos canh 2 3) "M" "bang-goccanh" "ARIAL-bang" nil) (setq m (1+ m)) (setq k (1+ k)) ) ;============================================== (setq f 0 j 1) (repeat (- (length lst) 2) (setq gg (list 35.0 (- (* -5.0 j) 7.0) 0.0)) (setq pgg (mapcar '+ pt gg)) (setq kgoc (nth f lstgoc)) (taotext pgg 1.8 (chuyendo kgoc) "M" "bang-goccanh" "ARIAL-bang" nil) (setq f (1+ f)) (setq j (1+ j)) ) ;---------------------------------------- (setq goc270 (- 0 (/ PI 2))) (setq pt6 (polar pt goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt7 (polar pt1 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt8 (polar pt5 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))) pt9 (polar pt4 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))) (makeline pt4 pt9 nil nil nil nil) (makeline pt5 pt8 nil nil nil nil) (makepline (list pt pt1 pt7 pt6) 1 nil nil nil nil) ;============================================= ) ;end progn if ) ; end if pt ); end progn ss (alert "ban chua chon Pline nao") ) ;end if ss ;======================================================================================== (alert "Xong ^^") (setvar 'osmode old) (princ) ); end Kkp ;=================================================================================== ;========================chuyen sang do phut giay (defun chuyendo(so / done kphgiay kphut kgiay xong) (setq done (fix so)) (setq kphgiay (* (- so done) 60)) ;14,76 (setq kphut (fix kphgiay)) ; 14 (setq kgiay (rtos (* (- kphgiay kphut) 60) 2 0)) ;46" (setq xong (strcat (itoa done) "%%d" (itoa kphut) "'" kgiay "''")) )BẠN CÓ THỂ BỔ SUNG VẺ GÓC CẠNH TRÊN SƠ ĐỒ LƯỚI THÌ TUYỆT LUÔN
-
không thấy bản vẽ bạn ơi
-
BẠN CHO LẠI MÌNH FILE MẪU, ĐỂ MÌNH LÀM THỬ XEM. FILE TRÊN MÌNH KHÔNG VẼ ĐƯỢC LƯỚI
-
Bạn copy trichthua này thay vào chỗ cũ là được
(car emin)
(+ (cadr emin)
)
)
(vla-put-closed (LWP lstp *Model*) :vlax-True)
(setq ss (ssadd (entlast) (ssadd)))
(setq p2 (ACET-SS-DRAG-MOVE
ss
(list (car emin) (cadr emin))
"Chon vi tri bat dau trich thua: "
)
)
(command ".move" ss "" emin p2)
(setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
(setq ss (ssdel encur (ssget "_CP" lstp)))
(command ".copy" ss "" p2 p2)
(setq p3 (ACET-SS-DRAG-MOVE
(ssadd encur ss)
p2
"Chon vi tri dat ban do trich thua: "
)
)
(command ".move" ss encur "" p2 p3)
(setvar "cecolor" "0")
(setq encur (ssname (ssget "X" '((62 . 104))) 0))
(setq lstobj1 (vl-remove encur (gettouching encur))
ss (acet-list-to-ss lstobj1)
)
(acet-ss-zoom-extents ss)
(break_with lstobj1 encur)
(vlax-invoke-method ActDoc 'Regen acActiveViewport)
(vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
(setq lst3 (acet-geom-vertex-list (entlast)))
(entdel (entlast))
(setq LenssBR (SS-enlst (ssget "F" lst3)))
(foreach x LenssBR
(if (or (not (eq (dxf 0 x) "TEXT"))
(not (eq (dxf 0 x) "MTEXT"))
)
(entdel x)
)
)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)
Lisp trichthua rất hay, thanks;
Mình muốn nhờ anh anh bổ sung thêm cho cho việc xử lý khi trích khu vưc cần trích save ra file cần lưu trong thư mục đó và đúng tọa độ theo bản vẽ gốc.
-
Không biết sao mình vào không được? bạn có thể up cho mình một bản đi
-
Mình không vào được facebook của bạn, nhờ chỉ giúp
-
Chào Bạn, phần mềm này mình tự viết phục vụ công tác đo vẽ khảo sát địa hình Bạn à. Để cài đặt nó hơi rườm rà và cũng chỉ thích hợp nếu Bạn hành nghề khảo sát. Bạn có thể vào tham khảo ở https://www.facebook.com/VeBinhDo/?ref=bookmarks
hoặc
Phần mềm bạn viết hay quá. Có thể cho mình xin một bộ được không ?
-
mong bạn up chương trình để ae học hỏi tí
-
Như thế mất rất nhiều thời gian và phải lập công thức. Em đã làm đc rồi ạ! Tuy nhiên hơi mất công đoạn trải mảng block xong lấy ra tọa độ rồi lại xóa đi.
Chương trình của em đây!
Bạn có những tiện ích hay quá. giới thiệu cho mình xem các tiện ích 1,2,3,4 xem tham khảo với bạn
-
Xin lỗi nha
-
mình cần Chuyen text cao độ về cao độ thực trong z của Cad
http://www.cadviet.com/upfiles/5/114381_drawing1.dwg
rất mong được giúp
-
2
-
-
bạn dùng file này để chuyển text về tọa độ Z = theo giá trị của text
Mình rất cần lisp chuyển cao độ text, link bị ngưng, mong các bạn nào có cho giúp.
cám ơn
-
Chương trình của bạn nội suy 3 số lẽ. bạn chỉnh giúp 2 số lẽ thôi.
Lisp dim khoảng cách liên tiếp trên Polyline - Pline
trong AutoLisp
Đã đăng · Trả lời báo cáo
Sorry, mình không hiểu block bạn tạo và nằm ở đâu.
Nếu việc tạo block khó vậy mình có thể dùng điểm point trê cad để chèn vào được không bạn
canh moc ranh.dwg