quocmanh04tt
-
Số lượng nội dung
1123 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
153
Bài đăng được đăng bởi quocmanh04tt
-
-
-
Không hoàn toàn, nhưng mục đích cũng tương tự như nhu cầu của bạn:
https://www.youtube.com/watch?v=3Y_cTfjmolo&ab_channel=NguyễnQuốcMạnh
https://www.youtube.com/watch?v=5e-oggqRIVk&ab_channel=NguyễnQuốcMạnh
-
33 phút trước, cuongtk2 đã nói:Chỉ cần findfile chính nó là ra được path, tuy nhiên có thể xảy ra ngoại lệ double file. Đó là lý do mình muốn có hàm như thế
Bạn có thể gán điều kiện find nhiều file, thêm nữa đọc và kiểm tra nội dung của file text nào đó mà bạn quy định.
-
1
-
-
- Với câu hỏi chủ thớt thì mình không biết.
- Nhưng đối với chương trình có dung lượng không quá lớn thì mình cho tất cả các loại file (.lsp, .fas, .dcl, .dwg, .txt ...) vào 1 file .VLX (thậm chí cả .vlx).
- Vấn đề lưu, kiểm tra khi đường dẫn thay đổi thì mình đi theo hướng dưới đây, không biết có giúp được gì cho các bạn không???
(defun c:tt (/ file fwrite myfile path LM:getfiles:browseforfolder LM:getfiles:fixdir)
(defun LM:getfiles:fixdir (dir)
(vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
(defun LM:getfiles:browseforfolder (msg dir flg / err fld pth shl slf)
(setq err (vl-catch-all-apply (function (lambda (/ app hwd)
(if (setq app (vlax-get-acad-object)
shl (vla-getinterfaceobject app "shell.application")
hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
fld (vlax-invoke-method shl
'browseforfolder
(if (vl-catch-all-error-p hwd)
0
hwd)
msg
flg
dir))
(setq slf (vlax-get-property fld 'self)
pth (LM:getfiles:fixdir (vlax-get-property slf 'path))))))))
(if slf
(vlax-release-object slf))
(if fld
(vlax-release-object fld))
(if shl
(vlax-release-object shl))
(if (vl-catch-all-error-p err)
(prompt (vl-catch-all-error-message err))
pth))
(setq myfile "myfile.txt")
(cond ((and (setq path (getenv "MYPROGRAM\\MYPATH"))
(setq file (findfile (strcat path "\\" myfile)))))
((progn (while (not
(and (setq path (LM:getfiles:browseforfolder "Chon thu muc" nil 512))
(setq file (findfile (strcat path "\\" myfile))))))
(setenv "MYPROGRAM\\MYPATH" path))))
;; chuong trinh chinh
(setq fwrite (open file "a"))
(alert (write-line (strcat "Duong dan mac dinh:\n" path) fwrite))
(close fwrite)
(princ)) -
-
Cách thứ 3 (hehehe...):
(defun c:tt (/ lst pol ssx)
(if (and (setq ssx (ssget)) (setq pol (car (entsel "\nPick chon curve: "))))
(progn (setq lst (vl-remove pol (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssx))))
lst (vl-remove-if-not '(lambda (x / o)
(and (vlax-method-applicable-p (setq o (vlax-ename->vla-object x)) 'intersectwith)
(vlax-invoke (vlax-ename->vla-object pol) 'intersectwith o acextendnone)))
lst)
ssx (ssadd))
(foreach e lst (setq ssx (ssadd e ssx)))
(sssetfirst nil ssx)))
(princ))-
1
-
-
Mình cũng tham gia tý:
(defun c:tt (/ a d e p s _lwpoly) (defun _lwpoly (l) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length l)) (cons 70 1)) (mapcar '(lambda (p) (cons 10 (trans p 1 0))) l)))) (setq d (cond (#othedglin2rec#) (100))) (initget 2) (setq d (cond ((getdist (strcat "\nChieu dai canh khac <" (rtos d 2 2) ">: "))) (d))) (setq #othedglin2rec# d) (while (setq s (ssget '((0 . "LINE")))) (while (and (setq e (ssname s 0)) (ssdel e s)) (setq p (mapcar '(lambda (x) (cdr (assoc x (entget e)))) '(10 11)) a (apply 'angle p)) (entdel e) (_lwpoly (mapcar '(lambda (x y) (polar x (+ a (* y pi)) (* 0.5 d))) (append p (reverse p)) (list 0.5 0.5 1.5 1.5))))) (princ))-
2
-
-
Mình tham gia 1 cái, không dùng đường "công vụ" và gọn hơn tý!
(defun c:tt (/ ang els ent etp lst p10 ss) (if (and (setq ent (car (entsel "\nChon Dimension trong hang can loai bo: "))) (member (setq etp (vla-get-ObjectName (vlax-ename->vla-object ent))) '("AcDbAlignedDimension" "AcDbRotatedDimension")) (setq els (entget ent)) (setq ss (ssget '((0 . "DIMENSION") (-4 . "<NOT") (-4 . "&") (70 . 6) (-4 . "NOT>"))))) (progn (setq ang (rem (cond ((eq etp "AcDbRotatedDimension") (cdr (assoc 50 els))) ((eq etp "AcDbAlignedDimension") (angle (cdr (assoc 13 els)) (cdr (assoc 14 els))))) pi) p10 (polar (cdr (assoc 10 els)) ang 1.0) lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (foreach e lst (if (equal (rem (angle p10 (cdr (assoc 10 (entget e)))) pi) ang 1e-8) (setq ss (ssdel e ss)))) (sssetfirst nil ss))) (princ))
-
-
41 phút trước, DuongTrungHuy đã nói:Thường gặp trường hợp này mình làm như sau Bạn
- Vẽ đoạn thẳng vô cùng A và (xA,10000000)
- Tìm giao của đoạn thẳng này với spline qua hàm giao 2 đối tượng.
- Giao đó là điểm cần tìm, xong xoá đoạn thẳng phụ trợ đó đi.
Có vẻ như:
Bác có xe hơi, nhưng bác lại thích đi xe đò. hehehe...
-
1
-
-
Bạn xem cái này có giúp được gì không!
-
1
-
-
Mình thường làm:
Dimrotated: Dxf_50
DimAligned: góc bởi 2 dxf 13 và 14
-
1
-
-
21 giờ trước, trungboss0608 đã nói:Nhờ mọi người giúp đỡ. Mình cần lấy giữ liệu 3 ô trong vòng tròn của file cad sang 3 cột của bên excel. Xin cảm ơn!
Các đối tượng rời rạc nên lisp chạy khá lâu. (lệnh: XKL).
-
2
-
1
-
-
Bước 1: Dùng lệnh AUDIT-> Yes->
Bước 2: Zoom -> All ->
Bước 3: Xoá các đối tượng bị lỗi.
-
Cách làm bán thủ công (làm việc với từng file):
Bước 1: Dùng lệnh wblock (tuỳ chọn: Entire Drawing).
Bước 2: Tìm trên diễn đàn này lisp ẩn hiện objects, dùng lệnh VIS.
-
1
-
-
Lisp bác @thiep post thiếu hàm DXF.
@alibaba2209: Bạn copy hàm này vào lisp:
(defun dxf (k e) (cdr (assoc k (entget e))))
-
2
-
-
9 phút trước, thiep đã nói:Bởi vì đâu có đọc được file vlx của quocmanh đâu. Chỉ thấy hộp thoại thôi.
VLX thì đúng là bình thường không đọc được, nhưng vẫn có thể test. Nếu bác nói 40 ATT thì có thể, vì khi đó hộp thoại nó quá dài...
-
13 phút trước, thiep đã nói:Dùng lisp của quocmanh cũng được nhưng nếu ở 1 blockRef có ATT nhiều hơn 4 thì Thiep nghĩ lisp sẽ không phù hợp nữa.
Chắc bác chỉ mới xem hình hoặc video thì bác mới quả quyết vậy!
P/s: Hiện doslib đã hỗ trợ đến cad 2021 rồi bác
-
1
-
-
Link ở dưới video.
-
1
-
1
-
-
Viết cho bạn, xem có đúng ý không???
(defun c:tt (/ els ent fn fw id ins pnt ss zco)
(cond ((and (setq ss (ssget '((0 . "TEXT") (8 . "Docao"))))
(setq fn (getfiled "Nhap the file" (getvar 'DWGPREFIX) "txt" 1)))
(setq fw (open fn "w")
id 0)
(write-line "STT\tTOA DO-X\tTOA DO-Y\tTOA DO-Z" fw)
(while (and (setq ent (ssname ss 0)) (ssdel ent ss))
(if (setq zco (distof (cdr (assoc 1 (setq els (entget ent))))))
(progn (setq ins (cdr (assoc 10 els))
pnt (list (- (car ins) 0.225) (cadr ins) zco))
(write-line (apply 'strcat
(cons (itoa (setq id (1+ id)))
(mapcar '(lambda (x) (strcat "\t" (rtos x 2 2))) pnt)))
fw))))
(close fw)))
(princ))-
1
-
-
12 giờ trước, xaydungcadviet đã nói:Cảm ơn anh rất nhiều @quocmanh04tt đã bớt chút thời gian để viết Lisp, em đã dùng qua mọi thứ rất tốt ạ, nhưng em đang thắc mắc một chỗ là đôi khi em muốn dãn theo phương X hoặc phương Y thì nó lại theo phương ngược lại ạ, ý của em là anh có thể thêm là mặc định là 1 phương nào đó luôn được không; hoặc giống Lisp của bác @Doan Nguyen Van dùng lệnh -->kích theo phương nào thì nó dãn theo phương đó luôn, em chân thành cảm ơn anh em đã quan tâm.
Lisp của mình chỉ đổi vị chứ không thay phương (Kiên trì đường lối).
Có nghĩa là: ban đầu phương nào (X hoặc Y) thì vẫn giữ nguyên phương đó, chỉ co giãn khoảng cách theo nhu cầu.
-
1
-
-
-
Ý bác @gia_bachlà nên dùng REACTOR ấy mà…! (Đoán mò vậy).
P/s: Đoán tiếp… Bác ấy đã viết rồi nhưng chưa đưa lên… kekeke...
-
@thiep: Bác phức tạp hóa vấn đề rồi (qua đối tượng trung gian Table), lại còn hạn chế luôn từ Cad2007 trở về trước nữa.
String cuối cùng để gán vào Text tổng, mình lấy như sau:
(setq str "%<\\AcExpr (")
(foreach ent (acet-ss-to-list ssdim)
(setq dim (vlax-ename->vla-object ent)
oid (getIDobject dim))
(if (distof (vla-get-TextOverride dim))
(setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).TextOverride>%"))
(setq str (strcat str "+%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Measurement \\f \"%lu2\">%"))))
(setq str (strcat str ") \\f \"%lu2%pr" (itoa prec) "\">%"))-
1
-
Nhờ viết lisp chèn 1 đoạn thằng khác layer vào 1 đoạn thằng liền mạch!
trong AutoLisp
Đã đăng · Trả lời báo cáo
Chắc thế này: