pphung183
-
Số lượng nội dung
375 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
59
Bài đăng được đăng bởi pphung183
-
-
Cái này thì ok rồi
Thanks bạn nhiều nhé!
Bạn có thường sử dụng lệnh torient không? Đôi khi sau khi gõ lệnh torient để sử dụng thì không dùng được(nó bị thoát ra ah, không cho dùng đến bước 2)
Cho nên lsp này kết hợp với lệnh torient mình sợ đôi khi nó cũng bị như trên (mình chỉ nói lên trường hợp mình gặp phải thôi ah)
thaks bạn nhiều lắm !
Lsp của bạn chạy tốt nhưng khi quay att block đi 1 góc thì nó bị lệch tâm ah !
(cái khó ở đây là sau khi quay att block xong nó phải ở ngay tâm)
Đã nói làm đại chứ có Tét đâu :lol: , nếu có bản vẽ up lên thỉ bắn trúng tâm ngay :D ... Thử lần nữa xem trúng tâm không nhé :)
(Lisp này ko dùng lệnh torient) , nếu trật nữa thì trốn thôi :wub: :
-
1
-
-
Bạn thử Lisp này xem có khá hơn ko :) chỉ đoán và làm đại chứ ko có bản vẽ để Test :D :
-
-
Lisp làm theo hướng bác ndtnv (không dùng Active X) + gợi ý của bạn quocmanh04tt
Post Tham Khảo :
(defun c:l1 (/ dxf mid ss i en lst e lf lm p13 p14 l ang pt lt1 x lg1 ptm13 ptm14 lmg) (defun dxf (code en) (cdr (assoc code (entget en))) ) (defun mid (p1 p2) (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2) ) (command "undo" "be") (setq ss (ssget '((0 . "dimension") (-4 . "<or") (70 . 32) (70 . 33) (-4 . "or>")))) (setq i (sslength ss)) (while (setq en (ssname ss (setq i (1- i)))) (setq lst (entget en)) (setq e (tblobjname "dimstyle" (dxf 3 en)) lf (dxf 144 e)) (setq lm (vl-remove-if '(lambda (x) (member (car x) (list -1 330 5 410 2))) lst)) (setq p13 (dxf 13 en) p14 (dxf 14 en) l (dxf 42 en) pt (mid p13 p14)) (setq lt1 (/ l 6) lt1 (- lt1 (setq x (* 100 (fix (/ lt1 100))))) lt1 (/ (+ (cond ((> lt1 50) 100) ((= lt1 0) 0) (50)) x) lf) lg1 (- (/ l lf) (* 2 lt1))) (setq ang (angle p13 p14) pm13 (polar pt ang (* lg1 0.5)) pm14 (polar pt (+ pi ang) (* lg1 0.5))) (entmod (subst (cons 13 pm13) (assoc 13 lm) lst)) (entmakex (subst (cons 14 pm14) (assoc 14 lm) lm)) (setq lmg (subst (cons 13 pm14) (assoc 13 lm) lm)) (entmakex (subst (cons 14 pm13) (assoc 14 lmg) lmg)) ) (command "undo" "e") (princ))
-
2
-
-
(setq lst(vl-remove-if ''((x)(vl-position (car x) '(-1 330 5 1 2 102 310 300 330 331 340 350 390 410))) (entget en)))
Dùng subst thay cho append cho dxf 13, 14 mới và (rem (dxf 70 lst) 128)
Vâng, tôi biết vấn đề này...phức tạp để nhớ và CAB đã có viết một hàm về Entmake DIMENTION và HATCH.
Bạn tham khảo :
https://www.theswamp.org/index.php?topic=4814.15
Tôi thì theo hướng khác và cũng đã giải quyết việc update này cho mọi loại Dimstyle :)
-
1
-
-
Có lẽ bác pphung183 phức tạp hóa vấn đề, nếu bác entmake từ data của thằng dim cũ thì không phụ thuộc vào DIMLFAC và STYLE (Chỉ thay đổi dxf13 và 14).
Hình như lisp cũ có chơi cả dim xiên rồi mà???
1/ Trong truong hợp này change data không như bạn nghĩ :) . Thử đơn giản :
(defun c:changdata (/ dxf lst pt1 pt2 en)
(defun dxf (code en) (cdr (assoc code (entget en))) )
(setq en (car (entsel)))
(setq lst (vl-remove-if '(lambda (x) (member (car x) '(-1 5 13 14))) (entget en)))
(setq pt1 (dxf 13 en) pt11 (polar pt1 0 100) pt2 (dxf 14 en))
(entmakex (append lst (list (cons 13 pt1) (cons 14 pt11)))) )
thì lúc đó xem Dim mới sẽ chạy đâu ....
2/ Hình như lisp cũ có chơi cả dim xiên rồi mà??? :
Lisp cũ bị lỗi khi điểm p13 ở góc 0 <ang< pi/2, p14 ở góc pi <ang< 3pi/2
-
1
-
-
Lisp hoạt động ngon quá, mà do yêu cầu của mình đưa ra chưa dc rõ ràng lắm nên có KQ chưa dc như mong muốn !
Bài toán mình đặt ra mới là trường hợp KQ thứ 2, thiếu trường hợp KQ thứ 1 =]]]
Mô tả: L1 chia 4 có 2 trường hợp:
1) KQ ra có đuôi dạng _50 hoặc _00 thì giữ nguyên không làm tròn gì cả, vd: 4000/4= 1000 (đuôi _00), chia dim L1 thành 3 dim: 1000-2000-1000, tương tự 5000/4 = 1250-2500-1250 (đuôi _50)
2) Các trường hợp khác làm tròn lên thành bội số 50, vd: 3150/4= 787.5 làm tròn lên thành 800, chia dim 3150 thành 3 dim 800-1550-800
Mô tả: L2 chia 6 có 2 trường hợp:
1) KQ ra có đuôi dạng _50 hoặc _00 thì giữ nguyên không làm tròn gì cả, vd: 5100/6= 850 (đuôi 50), chia dim L1 thành 3 dim: 850-3400-850, tương tự 6000/6 = 1000-4000-1000 (đuôi _00)
2) Các trường hợp khác làm tròn xuống thành bội số 50, vd: 3150/6= 525 làm tròn xuống thành 500, chia dim 3150 thành 3 dim 500-2150-500
Đã update :) . Chơi luôn chia Dim xiên , đứng ....Hạn chế : Chỉ sử dụng cho Dimstyle có dimlfac = 1 (Do làm theo bản vẽ của bạn :D ). Nên sẽ ko đúng với mọi dimstype :lol:
http://www.cadviet.com/upfiles/5/127397_lll__chia_dim_2.rar
Rảnh rỗi sẽ update tiếp :D
-
3
-
-
Do phải vẽ kết cầu dầm lặp lại nhiều lần nên rất mệt và dễ nhầm lẫm vì mỗi dầm một chiều dài khác nhau nên nhờ các bác viết dùm 1 lisp như sau
Mô tả: L1 chia 4, làm tròn lên thành bội số 50, vd: 3150/4= 787.5 làm tròn lên thành 800, chia dim 3150 thành 3 dim 800-1550-800
Mô tả: L2 chia 6, làm tròn xuống thành bội số 50, vd: 3150/6= 525 làm tròn xuống thành 500, chia dim 3150 thành 3 dim 500-2150-500
Lệnh: L1 > chọn các L1( dầm nhiều nhịp) >enter> xong
Lệnh: L2 > chọn các L2 ( dầm nhiều nhịp)>enter> xong
Ban đầu:
Kết quả:
Thanks các bác đã dành chút thời gian đọc bài của em !!
Xin đính kèm file: http://www.cadviet.com/upfiles/5/112169_chia_dim.dwg
Hóng lâu wa roi hả :D . Chay thử Lisp này xem có trúng ý ko nha :)
-
2
-
-
Tôi không biết thì tôi hỏi, nhờ "giúp đỡ". Post trùng bài, làm mất thời gian... tôi cũng đã xin lỗi. Sống ở trên đời ai cũng có lúc nhầm, chưa đúng, sai thì nhận đó là điều tất yếu nhưng không nên sống ích kỷ, từ bụng ta suy ra bụng người, tự kiêu, GATO. Có những người Việt Nam cứ nghĩ là mình giỏi, hơn người nhưng trong Tiếng Việt còn không biết cấu trúc 1 câu văn, viết sai chính tả.
Cảm ơn bạn đã góp ý.
Potay voi nhung suy nghĩ ấu trĩ ... :lol:
Hãy suy nghĩ và tạo ra những điều mới lạ từ chính mình, bạn sẽ thấy hạnh phúc
Giúp đỡ để cùng nhau tiến bộ, bạn sẽ thấy vinh hạnh
Cứ mãi giấu dốt, sỉ diện hảo, thì bạn cứ mãi là người GATO đấy. :)
-
vậy là không có cách nào đơn giản hơn nhỉ, ông a của e chỉ cho dùng lệnh UCS [world] ở cả 2 file cad rồi copy sang, thử 1 phát thì copy được, nhưng đến lúc em làm thì lại không được, với cả bác nói rõ cái BIND được ko ạ
Có đấy :D ... xài Cad 2013 trở lên là Ctrl+C & Ctrl+V vô tư . Nếu Cad 2008 chắc phải làm nhiêu khê :wub:
Bạn chưa từng dùng Xref à :blink: . xài tới nó là biết Bind là gì.
Cái UCS của bạn đang là World thì dùng đến nó làm gì nua , chỉ là ông anh bạn múa cho vui thoi vì chắc là xài Cad Version khác 2008 thôi :D
Đoạn Code nhỏ kiểm tra UCS có phải là Word ko đây :
(defun c:us () (if (eq (getvar 'worlducs) 1) (alert "\nUCS is world...") (alert "\nUCS not World!!!")) )
-
1
-
-
đây là bản vẽ thang e muốn copy ra, nó không bị ngược, nhưng chỉ cần copy sang chỗ khác bằng Ctrl + C thậm chí ngay trong bản vẽ này cũng bị ngược một số chữ ghi chú, copy bằng lệnh CO trong cad thì không sao. Em đã dùng lệnh UCS [world] cũng ko ăn thua
Bạn tham khảo :
http://www.cadviet.com/forum/topic/142257-xin-h-i-v-block-thu-c-tinh/
-
1
-
-
Vấn đề của bạn là lỗi oái ăm của thang Dynami Block khi Ctr+C & Ctr+V mà tôi có bàn luận ở trong một topic diễn đàn này :wub:
Giải quyết :
-WBLOCK phần muốn Copy
-XATTACH the drawing
-BIND-Explode
Chúc thành công!
-
- Chào các Anh/Chị
+ Tôi có bản vẽ gồm nhiều thửa (mỗi thửa là một Polyline khép kín). Trong mỗi thửa có 3 đối tượng Text và một đối tượng dạng Line, tất cả các đối tượng này thuộc một lớp.
+ Xin các Bác giúp cho 1 Lisp để liên kết 4 đối tượng trong mỗi thửa đó thành 1 khối (Block) mà VỊ TRÍ (TỌA ĐỘ) CỦA BẢN VẼ ĐÓ KHÔNG THAY ĐỔI.
- Chân thành cảm ơn các Bác đã giúp đỡ tôi.
- Các Bác Xem file đính kèm theo đường dẫn sau: http://www.cadviet.com/upfiles/2/1_11.dwg
Similar topics from web:Oh my God :blink: ! Thái độ nhờ giúp đở của bạn là như thế sao??? Cách hành xử này sẽ khiến nhung ai muốn giúp bạn sẽ cạch mặt bạn luôn.
Với Bản vẽ này của bạn thì việc tạo hàng loạt Block sao cái quét chọn là không quá khó đối với tôi :D . Nhưng giờ thì hết hứng để giúp :lol:
-
Xin lỗi các bạn nhé nếu làm mất thời gian, làm phiền đến các bạn.
Mình không phải dân chuyên sử dụng Autocad, không sử dụng thường xuyên nên có những nội dung và thuật toán chưa phân biệt được. Gia nhập diễn đàn cũng là mong muốn ứng dụng thêm các cái hay, tiện ích cho công việc.
Khi có sự thay đổi nên hỏi và mong các bạn giúp đỡ.
Trân thành cảm ơn.
Thế bản vẽ đâu? TRong mỗi Polyline có khoảng nhiêu object??? Đưa bản vẽ lên và nói cụ thể muốn gì :)
-
(defun c:mc() (setq ss (ssget '((0 . "*TEXT")))) (foreach en (acet-ss-to-list ss) (command "_txt2mtxt" en "") (acet-tjust en "MC"); set justify cho Mtext vua moi chuyen thanh ) )
Em tìm thấy code chuyển Dtext thành Mtext, nhưng em không tìm thấy nút để trả lời bên topic đó nên mạo mụi tạo topic này.
Tình hình là em muốn setup justify cho Mtext vừa được tạo ra nhưng làm hoài không được. Nhờ mọi người sửa giúp!
Cảm ơn!
(defun c:mc()
(setq ss (ssget '((0 . "*TEXT"))))
(foreach en (acet-ss-to-list ss)
(command "_txt2mtxt" en "")
(acet-tjust en "MC"); set justify cho Mtext vua moi chuyen thanh
)
)
Cấu trúc hàm (acet-tjust ss A) trong đó : ss là tập selection set.
Do đó code của bạn chỉnh lại :) :
(defun c:mc(/ ss s)
(setq ss (ssget '((0 . "TEXT"))) s (ssadd))
(foreach en (acet-ss-to-list ss)
(command "_txt2mtxt" en "") (setq s (ssadd (entlast) s)) )
(acet-tjust s "MC"); set justify cho Mtext vua moi chuyen thanh
)
-
1
-
-
Tin mừng: 20 năm nữa Việt Nam sẽ có cơ hội bằng với Hàn Quốc năm 2000:D :D :D
Con Rồng:
Cháu tiên:
Vậy đây là con ai?
(Video clip này do (ks.) Hà Anh gởi tặng 2 lúa:)
http://www.cadviet.com/upfiles/5/110802_world_plowing_record_66_bottom_plow.mp4
:D :D :D
Bí thư Thành ủy Hà Nội Hoàng Trung Hải đã khẳng định :
"Thà nghèo nhưng yên bình còn hơn giàu mà không an toàn"
Đầu năm toàn nghe tin dzui :D . Sướng thiệt :wub:
-
2
-
1
-
-
+ Cám ơn góp ý của bác pphung183, xin bác tư vấn thêm ở ý 2!
+ ý 3: Nếu leader line chỉ có 2 Segment thì dễ giải quyết hơn, nếu nhiều thì hơi rắc rối. Nếu chủ thớt chấp nhận kiểu multi copy thì OK.
P/S: ý 2 có lẽ dùng clockwise thì ổn.
Dùng cách củ chuối command tạo offset trong vòng lặp repeat cho đỡ nhức đầu :D (bỏ pt2) :
(command "_offset" (* dis (setq i (1+ i))) opl "non" pt1 "")
-
Yêu cầu 2: (Chọn 1 leader nhập khoảng cách offset, số lượng, phía để tạo các leader mới theo kiểu offset)
(defun c:tt (/ LWPoly ang clr ele ent i lma lpl lsp nle npl obi obj ole dis opl pt1 pt2 sll) (defun LWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 0)) (mapcar (function (lambda (p) p)) lst)))) (princ "\nSelect a Leader...!") (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER")))) (progn (setq ent (ssname ele 0) ole (vlax-ename->vla-object ent) clr (vla-get-DimensionLineColor ole) lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent)) lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent))) (setq opl (LWPoly lsp) obj (vlax-ename->vla-object opl)) (vla-put-color obj clr) (if (and (setq dis (getdist "\nOffset distance: ")) (setq sll (getint "\nNumber of Leader:")) (setq pt1 (getpoint "\nSelect side to offset to: "))) (progn (setq pt2 (vlax-curve-getclosestpointto obj pt1 t) ang (angle pt1 pt2)) (if (< pi ang (* pi 2)) (setq dis (- dis))) (setq i 0) (repeat sll (setq obi (vla-offset obj (* dis (setq i (1+ i)))) npl (entlast) lpl (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl))) (setq nle (vlax-ename->vla-object (entmakex (append lma lpl)))) (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole)) (vla-put-DimensionLineColor nle clr) (entdel npl)) (vla-erase obj))))) (princ))
Ý tưởng của bạn tuyệt vời :) . Tuy nhiên mình xin góp ý nhỏ :) :
- Đoạn code tạo đối tượng opl nên đặt sau phần nhập getdist, getint và getpoint để tránh nếu lở Enter thì không xuất hiện Pline thừa
- Việc xác dis (if (< pi ang (* pi 2)) (setq dis (- dis))) để chọn hướng offset có vẽ không ổn :D
- Ý tưởng offset tạo ra các Leader song song cách đều theo 2 phương, Trong khi chủ thớt muốn có thê là khoảng // trục X khác trục Y.
-
2
-
-
Lisp nay chỉ theo 1 chiều đuoc thôi, nêu Le theo chiều khác hay các huong khac nhau thì không đươc.Bạn có thể viết cho phuong bất kỳ của Le được không
Code trên tôi viết tổng quát cho việc tạo và xóa objects Le. Có thể một lúc nào đó bạn tự viết cho mình trường hợp 2 và 3 nếu bạn có danh sách các points :D .
Trường hơp 1 có thể rút gọn lại cho Le theo chiều khác hay các huong khac nhau :) :
(defun c:Ele (/ doc p1 s l l1 lst p3 p4 a p2 pg lm) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint "\nPick chon diem chuan cho cac diem goc cua Leaders...")) ) (progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) (caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (cadr lst) a (angle p4 p3) p2 (polar p1 (+ a (* pi 0.5)) 1) pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg)) (vlax-put le 'Coordinates lm) ) (vla-delete s) )) (princ))
-
1
-
-
Nguyện vọng 1 đây :) :
(defun c:Ele (/ getXdata SaVa dxf2va SetXdata doc ms p1 p2 s l l1 lst p3 p4 pg lm type pt te pts obj lx) (defun getXdata (obj / typ val) (vla-getxdata obj "" 'typ 'val) (if (and typ val) (apply 'mapcar (cons 'cons (list (vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val)))))) ) (defun SaVa (mode lst) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray mode (cons 0 (1- (length lst)))) lst)) ) (defun dxf2va (lst *typ *val / d) (set *typ (SaVa vlax-vbInteger (mapcar 'car lst))) (set *val (SaVa vlax-vbVariant (mapcar '(lambda (x) (if (listp (setq d (cdr x))) (vlax-3D-point d) (vlax-make-variant d))) lst))) ) (defun SetXdata (obj lst) (dxf2va lst 'typ 'val) (vla-SetXData obj typ val) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ms (vla-get-ModelSpace doc)) (princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint "\nPick chon diem chuan cho cac diem goc cua Leaders...") p2 (polar p1 (* pi 0.5) 1)) ) (progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) (caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (polar p3 pi 1) pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg)) (setq type (vla-get-type le) pt (vlax-3d-point pg) te (vla-AddMText ms pt 1 "") pts (SaVa 5 lm)) (setq obj (vla-AddLeader ms pts te type)) (vla-Erase te) (if (setq lx (getXdata le)) (SetXdata obj lx) ) (vla-put-Coordinate obj 2 pt) (vla-put-StyleName obj (vla-get-StyleName le)) (vla-put-layer obj (vla-get-layer le)) (vla-put-arrowheadsize obj (vla-get-arrowheadsize le)) (vla-put-DimensionLineColor obj (vla-get-DimensionLineColor le)) (vla-Erase le)) (vla-delete s) )) (princ))
-
1
-
-
bạn xem giúp mình file mình gửi mình có ghi đầy đủ yêu cầu
http://www.mediafire.com/download/84hcefvboj2c8q3/Lisp+Le.dwg
bạn xem làm được thì giúp mình viết 1 cái lisp như thế này nhé
thanks
Dường như các objs Le trong bản vẽ của bạn là copy từ đâu đó chứ không phải tạo ra từ lệnh Le :P
Việc tạo Obi Leader từ Lisp phải có ít nhất 2 points nên yêu cầu 2 3 là mù mờ :)
Có thể đáp ứng nguyện vọng 1 của bạn cũng là không đơn giản :wub: nhưng làm được :D
-
1
-
-
Ít thế tiếp đi chứ
Không hiểu ý bạn muốn ji ? Cắt Le tại gốc hay đâu ? :)
-
1
-
-
Hoằn chớ dại" gởi THỊT NHÍM cho ...anh Hai Lúa!" :) :) :)
Tình hình là ÔNG TÂY KÉT AutoCAD2017 đã chuyển được PDF sang .DWG một cách ngon ghẻ:
Nếu thấy khó khăn quá thì tặng Bạn Lisp này (Bên World quét chọn text cần Copy rồi Ctrl+C; Bên Cad Load lisp gõ w2c [Cao Text đang lấy 2,5]) :
(defun c:w2c (/ GetClipBoardText str pt)
(defun GetClipBoardText (/ htm kq) ; Michael Puckett
(setq kq (vlax-invoke (vlax-get (vlax-get (setq htm (vlax-create-object "htmlfile"))
'ParentWindow) 'ClipBoardData) 'GetData "Text")) (vlax-release-object htm) kq) ;;;;;
(if (and (setq str (GetClipBoardText)) (setq pt (getpoint "\nSpecify text start point: ")) )
(progn (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
(cons 10 pt) (cons 7 (getvar "textstyle")) (cons 1 str) (cons 40 2.5)))
(command "_.explode" "L") )) (princ))
-
3
-
-
Tình hình là em chuyển từ PDF sang > . DWG bị lỗi fon chữ loằng ngoằng , không hiểu vì sao???
(fon chữ của .DOC là Arial )
Không biết Bạn có thử xài Able2Extract.Pro_9.0.10.0 chưa? Phần mềm này tôi thấy hiệu quả ko bị lỗi fon chữ loằng ngoằng như bạn nói ...
Nó còn convert nhiều thứ nữa ....
-
3
-
[Nhờ Viết Lisp] Dim Nhanh Giữa Các Line (Hoặc Pl)
trong AutoLisp
Đã đăng · Trả lời báo cáo