Chuyển đến nội dung
Diễn đàn CADViet

cuongtk2

Thành viên
  • Số lượng nội dung

    419
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    33

Mọi thứ được đăng bởi cuongtk2

  1. Tìm trong code thấy chữ "chunhat" thì thay bằng layer tùy ý "XXXX", Nếu muốn layer hiện hành thì thay bằng (getvar "Clayer"). Xóa dim thì xóa mấy dòng make_dim là được. Code anh không lưu nên nhác sửa.
  2. (defun c:hcncheo( / ANG ANG1 DIST E ENT ENTS H L1 L2 LISTDINH NAME OBJ P1 P2 P3 P4 P5 P6 PARAM PE PS PT) (setq ents (entsel "\nPick entity")) (if (null ents) (exit)) (setq pt (cadr ents) ent (car ents) name (acet-dxf 0 (entget ent))) (if (null (or (= name "LWPOLYLINE") (= name "LINE")) ) (exit) ) (if (= name "LWPOLYLINE") (setq obj (vlax-ename->vla-object ent) pt (vlax-curve-getclosestpointto obj pt) param (fix (vlax-curve-getParamAtPoint obj pt)) ps (vlax-curve-getPointAtParam obj param) pe (vlax-curve-getPointAtParam obj (+ param 1)) ) ) (if (= name "LINE") (setq ps (acet-dxf 10 (entget ent)) pe (acet-dxf 11 (entget ent)) ) ) (setq p1 (if (< (car ps) (car pe)) ps pe) p2 (if (< (car ps) (car pe)) pe ps) ang (angle p1 p2) ang1 (+ ang (* pi 0.5)) dist (DISTANCE p1 p2)) (alert (strcat "L= " (rtos dist 2 2))) (setq l1 (getdist "\nL1:")) (setq l2 (getdist "\nL2:")) (if (> (+ l1 l2) dist) (alert "Tong L1 + L2 qua lon") ) (setq h (getdist "\nH:")) (setq p3 (polar p1 ang l1) p4 (polar p2 ang (- 0 l2)) p5 (polar p4 ang1 h) p6 (polar p3 ang1 h) ) (DEFUN list_point_pline (p1 w) (LIST (LIST 10 (CAR p1) (CADR p1)) (CONS 40 w) (CONS 41 w) (CONS 42 0.0)) ) (DEFUN make_lwpolyline (list_dinh dong_lai do_day layer / dlist elist1 e_list n i) (SETQ n (LENGTH list_dinh)) (SETQ dlist nil) (SETQ i 0) (WHILE (< i n) (SETQ dlist (APPEND dlist (list_point_pline (NTH i list_dinh) do_day) ) ) (SETQ i (1+ i)) ) (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE") (CONS 100 "AcDbEntity") (CONS 410 "Model") (CONS 8 layer) (CONS 100 "AcDbPolyline") (CONS 90 n) (CONS 70 dong_lai) ;(cons 43 0.0) (CONS 38 0.0) (CONS 39 0.0))) (SETQ e_list nil) (SETQ e_list (APPEND elist1 dlist)) (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0)))) (ENTMAKE e_list) ) (DEFUN make_dim_y1 (style p1 p2 p3 ang layer / d e_list basepoint p4) (SETQ e_list (LIST (CONS 0 "DIMENSION") (CONS 100 "AcDbEntity") (CONS 67 0) (CONS 410 "Model") (CONS 8 layer) (CONS 100 "AcDbDimension") (cons 10 p3) (cons 11 p3) (LIST 12 0.0 0.0 0.0) (CONS 70 32) (CONS 1 "") (CONS 71 5) (CONS 72 1) (CONS 41 1.0) (CONS 42 0) (CONS 52 0.0) (CONS 53 0.0) (CONS 54 0.0) (CONS 51 0.0) (LIST 210 0.0 0.0 1.0) (CONS 3 style) (CONS 100 "AcDbAlignedDimension") (cons 13 p1) (cons 14 p2) (LIST 15 0.0 0.0 0.0) (LIST 16 0.0 0.0 0.0) (CONS 40 0.0) (CONS 50 ang) (CONS 100 "AcDbRotatedDimension") ) ) (ENTMAKE e_list) ) (setq listdinh (mapcar '(lambda (e) (list (car e) (cadr e)) ) (list p3 p4 p5 p6)) ) (MAKE_LWPOLYLINE listdinh 1 0 "chunhat") (MAKE_DIM_Y1 "Standard" p3 p6 (polar p1 (- 0 ang) (+ h h)) ang1 "dim") (MAKE_DIM_Y1 "Standard" p1 p3 (polar p1 ang1 (+ h h)) ang "dim") (MAKE_DIM_Y1 "Standard" p4 p2 (polar p1 ang1 (+ h h)) ang "dim") ) thử lại nhé
  3. Anh cũng không rõ lắm, chắc do mấy cái hàm nó bị lẫn, em thử load từng đoạn vào xem , đếm đủ bằng nhau số ngoặc đơn () cho từng đoạn để load khỏi lỗi. Anh cũng không có máy khác để test.
  4. Đây em (defun c:hcncheo( / ANG ANG1 DIST E ENT ENTS H L1 L2 LISTDINH NAME OBJ P1 P2 P3 P4 P5 P6 PARAM PE PS PT) (setq ents (entsel "\nPick entity")) (if (null ents) (exit)) (setq pt (cadr ents) ent (car ents) name (acet-dxf 0 (entget ent))) (if (null (or (= name "LWPOLYLINE") (= name "LINE")) ) (exit) ) (if (= name "LWPOLYLINE") (setq obj (vlax-ename->vla-object ent) pt (vlax-curve-getclosestpointto obj pt) param (fix (vlax-curve-getParamAtPoint obj pt)) ps (vlax-curve-getPointAtParam obj param) pe (vlax-curve-getPointAtParam obj (+ param 1)) ) ) (if (= name "LINE") (setq ps (acet-dxf 10 (entget ent)) pe (acet-dxf 11 (entget ent)) ) ) (setq p1 (if (< (car ps) (car pe)) ps pe) p2 (if (< (car ps) (car pe)) pe ps) ang (angle p1 p2) ang1 (+ ang (* pi 0.5)) dist (DISTANCE p1 p2)) (alert (strcat "L= " (rtos dist 2 2))) (setq l1 (getdist "\nL1:")) (setq l2 (getdist "\nL2:")) (if (> (+ l1 l2) dist) (alert "Tong L1 + L2 qua lon") ) (setq h (getdist "\nH:")) (setq p3 (polar p1 ang l1) p4 (polar p2 ang (- 0 l2)) p5 (polar p4 ang1 h) p6 (polar p3 ang1 h) ) (DEFUN make_lwpolyline (list_dinh dong_lai do_day layer / dlist elist1 e_list n i) (SETQ n (LENGTH list_dinh)) (SETQ dlist nil) (SETQ i 0) (WHILE (< i n) (SETQ dlist (APPEND dlist (list_point_pline (NTH i list_dinh) do_day) ) ) (SETQ i (1+ i)) ) (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE") (CONS 100 "AcDbEntity") (CONS 410 "Model") (CONS 8 layer) (CONS 100 "AcDbPolyline") (CONS 90 n) (CONS 70 dong_lai) ;(cons 43 0.0) (CONS 38 0.0) (CONS 39 0.0))) (SETQ e_list nil) (SETQ e_list (APPEND elist1 dlist)) (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0)))) (ENTMAKE e_list) ) (DEFUN make_dim_y1 (style p1 p2 p3 ang layer / d e_list basepoint p4) (SETQ e_list (LIST (CONS 0 "DIMENSION") (CONS 100 "AcDbEntity") (CONS 67 0) (CONS 410 "Model") (CONS 8 layer) (CONS 100 "AcDbDimension") (cons 10 p3) (cons 11 p3) (LIST 12 0.0 0.0 0.0) (CONS 70 32) (CONS 1 "") (CONS 71 5) (CONS 72 1) (CONS 41 1.0) (CONS 42 0) (CONS 52 0.0) (CONS 53 0.0) (CONS 54 0.0) (CONS 51 0.0) (LIST 210 0.0 0.0 1.0) (CONS 3 style) (CONS 100 "AcDbAlignedDimension") (cons 13 p1) (cons 14 p2) (LIST 15 0.0 0.0 0.0) (LIST 16 0.0 0.0 0.0) (CONS 40 0.0) (CONS 50 ang) (CONS 100 "AcDbRotatedDimension") ) ) (ENTMAKE e_list) ) (setq listdinh (mapcar '(lambda (e) (list (car e) (cadr e)) ) (list p3 p4 p5 p6)) ) (MAKE_LWPOLYLINE listdinh 1 0 "chunhat") (MAKE_DIM_Y1 "Standard" p3 p6 (polar p1 (- 0 ang) (+ h h)) ang1 "dim") (MAKE_DIM_Y1 "Standard" p1 p3 (polar p1 ang1 (+ h h)) ang "dim") (MAKE_DIM_Y1 "Standard" p4 p2 (polar p1 ang1 (+ h h)) ang "dim") )
  5. cuongtk2

    Array đơn hướng với góc tùy ý

    Assoc Array 1 chiều với 2 lựa chọn số lượng hoặc khoảng cách để cho mình có thêm lựa chọn ArrayDonhuong.rar
  6. cuongtk2

    giúp mình làm Lisp nối so le các đoạn thẳng song song

    Với line nằm ngang thì dùng cái này (defun c:noiline ( / I KEY LS LS2 N P SS SS1 ) (defun pointmininline (ent / ENTG LS LS1 PE PS) (setq entg (entget ent) ps (acet-dxf 10 entg) pe (acet-dxf 11 entg) ls (list ps pe)) (setq ls1 (vl-sort ls '(lambda (p1 p2) (< (car p1) (car p2)) ) ) ) ls1 ) (DEFUN make_lwpolyline (list_dinh dong_lai do_day layer / dlist elist1 e_list n i) (SETQ n (LENGTH list_dinh)) (SETQ dlist nil) (SETQ i 0) (WHILE (< i n) (SETQ dlist (APPEND dlist (list_point_pline (NTH i list_dinh) do_day) ) ) (SETQ i (1+ i)) ) (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE") (CONS 100 "AcDbEntity") (CONS 410 "Model") (CONS 8 layer) (CONS 100 "AcDbPolyline") (CONS 90 n) (CONS 70 dong_lai) ;(cons 43 0.0) (CONS 38 0.0) (CONS 39 0.0))) (SETQ e_list nil) (SETQ e_list (APPEND elist1 dlist)) (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0)))) (ENTMAKE e_list) ) (setq ss (ssget '((0 . "LINE"))) ss (acet-ss-to-list ss)) (setq ss1 (vl-sort ss '(lambda (e1 e2) (< (cadr (car (pointmininline e1))) (cadr (car (pointmininline e2))) ) ) ) ) (setq n (length ss1) i 0 ls (list)) (initget 1 "T P") (setq key (GETKWORD "Bat dau tu duoi Trai / Phai")) (if (= key "T") (while (< i n) (progn (setq ls2 (pointmininline (nth i ss1))) (if ( = (rem i 2) 0) (setq ls (append ls (list (car ls2) (cadr ls2)))) (setq ls (append ls (list (cadr ls2) (car ls2)))) ) ) (setq i (1+ i)) ) (while (< i n) (progn (setq ls2 (pointmininline (nth i ss1))) (if ( = (rem i 2) 0) (setq ls (append ls (list (cadr ls2) (car ls2)))) (setq ls (append ls (list (car ls2) (cadr ls2)))) ) ) (setq i (1+ i)) ) ) (setq ls (mapcar '(lambda (p) (list (car p) (cadr p))) ls)) (MAKE_LWPOLYLINE ls 0 0 "ketqua") (initget 1 "Y N") (setq key (GETKWORD "Xoa line cu khong Yes / No")) (if (= key "Y") (foreach n ss1 (entdel n)) ) )
  7. cuongtk2

    Lỗi in Cad bị Đậm nét

    Thường gặp ở in bằng máy Photocopy, cài driver PCL6 của máy photo đó là được.
  8. cuongtk2

    diện tích trong cad

    Không trả lời cũng ngu mà trả lời cũng ngu, khó xử quá.
  9. cuongtk2

    diện tích trong cad

    5,6ha = 56.000,0 m2. = 5.600.000,0 dm2 tương ứng với unit đó là dm. Nhưng hầu hết không ai dùng đơn vị dm để vẽ, hoặc m hoặc mm tương ứng 1unit.
  10. cuongtk2

    Array đơn hướng với góc tùy ý

    Mỗi thứ viết ra đều phải có mục đích của nó, cái này em viết chủ yếu là để rải bậc thang, rải cây trên TMB, chưa ưng ý xóa di cũng dễ.
  11. cuongtk2

    Array đơn hướng với góc tùy ý

    Bác Hà thử có làm được như thế này không?
  12. cuongtk2

    Array đơn hướng với góc tùy ý

    Anh không rõ, hình như 2013 trở lên mới được. Lâu nay xài cad 2021 nên không để ý.
  13. cuongtk2

    Hiệu chỉnh đường kích thước đo chiều dài cung tròn

    Muốn cho Extension Line hướng tâm thì góc phải >= 90 độ
  14. cuongtk2

    Array đơn hướng với góc tùy ý

    1. Sau khi copy bạn có thể điều chỉnh khoảng cách copy không? 2. Muốn tăng thêm số lượng copy thì phải làm như thế nào? 3. Muốn xóa phần copy bạn chỉ cần xóa 1 đối tượng có được không? Đối tượng array ra đời cũng có cái lý của nó. Xử lý được phần hậu copy.
  15. cuongtk2

    Hiệu chỉnh đường kích thước đo chiều dài cung tròn

    Nó dùng để đo dài , không phải đo góc nên không thể hướng tâm được. Nếu hướng tâm thì khoảng cách giữa 2 mút Extension line sẽ ngắn hơn Dimension line. Dùng một đoạn lớn hơn 330mm không rõ bao nhiêu lần để biểu diễn 330mm không có ý nghĩa gì.
  16. cuongtk2

    Array đơn hướng với góc tùy ý

    Dùng cái file phía trên hình. DLL phải netload mới chạy được. Cái dưới là code nguồn để biên dịch , phải có kiến thức về .NET mới xài được.
  17. cuongtk2

    Array đơn hướng với góc tùy ý

    File nguồn ở đây cho ai thích vọc ArrayDonhuongs.rar
  18. (defun c:test (/ A LS OBJ ss ) (setq ss (mapcar '(lambda (x) (vlax-ename->vla-object x)) (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))) )) (foreach obj ss (progn (setq color (vla-get-color obj) ls (vlax-safearray->list (vlax-variant-value (vla-Explode obj))) ) (foreach n ls (if (= (vla-get-color n) 0) (vla-put-color n color)) ) (vla-Erase obj) ) ) )
  19. Câu hỏi mông lung quá trời. Tùy vào tình huống mà mình lấy ra điểm tọa độ phù hợp, pick vào màn hình lấy tọa độ của điểm pick , postion của 1 entity, hoặc 1 list của polyline...
  20. Block có màu thì mới có tác dụng nhé: (defun c:test (/ A LS OBJ) (setq obj (vlax-ename->vla-object (car (entsel)) ) color (vla-get-color obj)) (setq ls (vlax-safearray->list (vlax-variant-value (vla-Explode obj)))) (foreach n ls ; by block = 0 (if (= (vla-get-color n) 0) (vla-put-color n color)) ) )
  21. Em giải đó bác. Thay vì entsel đổi thành getcorner. Còn việc offset rồi cloud thì đường bao phải chính xác rồi mới nên làm. Tuy nhiên cái convexhull này lởm quá, thua cái denaulay
  22. Thực ra lisp chỉ phục vụ mục tiêu đánh dấu hết vùng những text có nội dung giống nhau thôi, để khỏi bỏ sót. Ví dụ như trong đống số 8 có lẫn 1 cái số 7 thì đường bao 7 nó sẽ vươn đến. Bạn có thể coi đó là 1 bản nháp để xem những text đó nó có mặt đến đâu thôi. Bài toán của bạn có thể mở rộng bằng cách chọn một diện tích mẫu đại diện cho 1 số để lấy 4 diểm góc cho 1 số, với getcorner. Sau đó nhân rộng diện tích với các text giống mẫu được chọn. baodiem.lsp
  23. Chọn 1 mẫu Dtext để lấy nội dung , rồi select , nó sẽ chỉ lọc ra những Dtext có nội dung giống như mẫu. Vẽ pline theo đường bao lồi những text được tìm thấy tại text position theo thuật toán Convexhul của LeeMac
  24. cuongtk2

    Nhờ chỉnh sửa lisp tính khối lượng solid

    Đại khái thế thôi em, cái quan trọng là biết chỗ để sửa thôi.
×