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

thanhlong.hygt

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    41

  • Đã tham gia

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

Bài đăng được đăng bởi thanhlong.hygt

  2. Đã đăng · Trả lời báo cáo

    - Chào anh em trên diễn đàn, hiện tại mình đang có nguyện vọng viết 1 tool ứng dụng trên nền autocad, ứng dụng chủ yếu xử lý các đối tượng đã vẽ của autocad để tính diện tích. mình đã sơ bộ useform, yêu cầu, thuật toán giải và code bằng vba được 1 phần nhỏ. Các bạn có thể viết lại bằng bất cứ ngôn ngữ nào
    - Do kiến thức hạn hẹp nên triển khai rất lâu, và chưa biết về cách bảo mật.
    - Mình muốn qua diễn đàn nhờ anh em giới thiệu bạn nào đã viết ứng dụng nền autocad vì như vậy sẽ hiểu các đối tượng, thuộc tính của Autocad để viết giúp mình.
    - Chi phí theo thỏa thuận, và rất hy vọng được hợp tác, giao lưu để mình hoàn thành dự án. Mình ở HN. SĐT O398.125-135

  4. Đã đăng · Trả lời báo cáo

    Nhờ các bạn trên diễn đàn viết hộ mình cái list

    1. Khi chọn đối tượng trên bản vẽ (tất cả các đối tượng,  nếu mầu là bylayer,  hay byblock,  block thì list đều truy cập vào và lấy mã mầu cụ thể của đối tượng mình chọn {mã mầu từ 1 đến 255 của cad}).

    2. sau đó lisp yêu cầu nhập thông số cho lineweight. (Bước này có lựa chọn nếu dùng phim cách thì tự động chấp nhận giá trị thông số lần nhập trước)

    3. Sau nhi nhập xong lisp tự động tìm mầu của đối tượng mình vừa chọn rồi truy cập vào Plos style table file *.ctb hiện hành gán thông số Lineweight cho mầu mình chọn bằng thông số đã nhập.

    Lý do yêu cầu là do mình  là dân giao thông, thường xuyên làm việc trên bản vẽ k được quản lý layer đúng cách. khi in thường in theo mầu. việc tìm mầu của đối tượng và gán nét in cho mầu rất mất thời gian do vậy mình nhờ các bạn viết giúp. Do 500 anh em mỗi người mỗi phương lên em xin cám ơn và hậu tạ bằng thẻ điện thoại hoặc chuyển khoản, chi phí thì các bác đừng chê chủ yếu quan trong là lời cám ơn gửi đến các anh em. Số điện thoại mình 0978.112.992 mình có dùng zalo bạn nào giúp mình có thể liên hệ qua zalo cho mình nhé. thankyou

     

    • Vote giảm 1

  5. Đã đăng · Trả lời báo cáo

    10 giờ trước, Doan Van Ha đã nói:

    Bắt điểm trong cad đôi lúc không như ý muốn. Bạn cứ gõ vào dòng tìm kiếm chữ "bắt điểm" sẽ thấy lòi ra 1 đống các trường hợp không bắt điểm được. Tôi cũng đã từng bị nên đành chấp nhận 1 biện pháp nào khả thi là được rồi.

    Vâng, Dù là đáp án nào thì mình cũng cần một lời thank. Thank mọi người đã quan tâm và giúp đỡ.

  6. Đã đăng · Trả lời báo cáo

    2 giờ trước, Danh Cong đã nói:

     

    + Lỗi do phần mềm ( cũng do 1 phần cách thức sử dụng phần mềm quá chủ quan).

    Hiện tại trong bản vẽ của bạn: 1 mét = 1 đơn vị trong cad. Nhưng các đối tượng bạn vẽ "quá xa" gốc tọa độ cad ; 25 000 000 (m) . Tương đương 25 ngàn cây số theo tỷ lệ thật.

    Còn cái hình vẽ Intersection kia để quá nhỏ. Cad tính toán không nổi nên nó bó tay.

    Kiểm chứng lại bằng cách dời đối tượng về gốc 0.0 là lại bắt điểm ngon lành.

    Vậy nên nếu không thực sự cần thiết thì hãy vẽ gần gốc tọa độ thôi, đừng đi xa quá !!!

    Do mình chạy file trên file bình đồ (Chắc sử dụng hệ tọa độ vn hoặc giả định ở quá xa). Ngoài cách move về gần về gốc tọa độ có cách nào k bạn. mình thử dùng hệ tọa độ giả định cũng đều k được. Dùng cad 2015 cũng k được. Hy vọng có được biện pháp hữu hiệu nhất. Thank

  7. Đã đăng · Trả lời báo cáo


         Mình có bản vẽ cần bắt các điểm giao nhau để vẽ nhưng mình k thể hiểu tại sao lại k bắt được điểm giao nhau mặc dù đã bật osnap và bật chế độ Intersection. 

       Kính mong các Pro chỉ giáo. vị trí giao khoanh tròn mầu đỏ trong bản vẽ

    https://www.cadviet.com/forum/applications/core/interface/file/attachment.php?id=3221

     

    image.png.af35281254845ea9888beb7743d2b579.pngimage.thumb.png.6386f76611a720aacddede107d072d97.pngbat diem.dwgimage.thumb.png.69beef9d08c06ce4fed77d4b0f8cfb1d.png

     

  8. Đã đăng · Trả lời báo cáo

    Vào lúc 10/4/2018 tại 10:58, quocmanh04tt đã nói:

    Chắc là muốn như vầy: 

    
(defun c:lc  (/ LM:ListBox str lstData ST:SendKeys)
 (defun c:Xformat  nil
  (alert "B\U+1EA1n có ch\U+1EAFc là XÓA S\U+1EA0CH \U+1ED5 c\U+1EE9ng không?")
  (princ))
 (setq lstData (acad_strlsort
                (list    ;Viet tiep cac lenh vao duoi dong nay theo mau "Ten lenh Noi dung"
                 "Erase \tXoa doi tuong" "Copy \tSao chep doi tuong" "Mirror \tLay doi xung" "CO \tCopy th\U+00F4ng minh"
                 "XFormat \tXóa s\U+1EA1ch \U+1ED5 c\U+1EE9ng, d\U+1EADp tan màn h\U+00ECnh...")))
 (defun ST:SendKeys  (keys / ws)
  (vlax-invoke-method (setq ws (vlax-create-object "WScript.Shell")) 'sendkeys keys)
  (vlax-release-object ws)
  (princ))
 (defun LM:ListBox  (title data multiple / file tmp dch return)
  (cond ((not
          (and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
               (write-line (strcat "listbox : dialog { label = \""
                                   title
                                   "\"; spacer; : list_box { key = \"list\"; multiple_select = "
                                   (if multiple
                                    "true"
                                    "false")
                                   "; width = 100; height= 30; tabs = \"10 20 30\";
                               } spacer; ok_cancel;}")
                           file)
               (not (close file))
               (< 0 (setq dch (load_dialog tmp)))
               (new_dialog "listbox" dch))))
        (t
         (start_list "list")
         (mapcar 'add_list data)
         (end_list)
         (setq return (set_tile "list" "0"))
         (action_tile "list" "(setq return $value)")
         (setq return (if (= 1 (start_dialog))
                       (mapcar '(lambda (x) (nth x data)) (read (strcat "(" return ")")))))))
  (if (< 0 dch)
   (unload_dialog dch))
  (if (setq tmp (findfile tmp))
   (vl-file-delete tmp))
  return)
 (cond ((setq str (LM:ListBox "Ghi ch\U+00FA l\U+1EC7nh - lisp CAD - @ketxu - 2/6/2012 :" lstData nil))
        (setq str (car str))
        (ST:SendKeys (strcat (substr str 1 (vl-string-position 32 str)) "\n"))))
 (princ))

     

    Bạn nào hướng dẫn mình tăng cỡ chữ trong hộp thoại hiện tên lệnh được không. List này hay mà máy em chữ nhỏ quá

  16. Đã đăng · Trả lời báo cáo

     

    Lisp này chỉ dùng cho lwpolyline, vì vậy bạn dùng lệnh convert của CAD để chuyển thành lwpolyline

     

    (defun AppendLs (ls e)(append (if ls ls nil) (list e)))
(defun ObjInters (o1 o2 id / g ps n)
    (setq    g    (vlax-invoke o1 'IntersectWith o2 id)    ps '())
    (while g (setq    ps (AppendLs ps (list (car g) (cadr g) (caddr g))) g (cdddr g))    )    ps
)
(defun Bulge (p1 p2 r / a)
    (setq a (/ (distance p1 p2) 2 r))
    (setq a (/ (atan (/ a (sqrt (- 1 (* a a))))) 2))
    (/ (sin a) (cos a))
)

(defun C:II ( / b fz i l li lp lq ls n ob om p p1 p2 r ss) ; Insert vertex at intersections
    (setq i 0 fz 0.1) ; sai so giao diem lech so voi dinh pline
    (princ "Chon pline:")    (setq ss (ssget ":S") ob (vlax-ename->vla-object (ssname ss 0)) )
    (princ "Chon cac duong giao:")
    (setq ls (mapcar 'vlax-ename->vla-object
                                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*LINE")(8 . "ENTCOC"))))))))
    (foreach o ls
        (setq p (car(ObjInters ob o acExtendNone)) lp (AppendLs lp p))    
        (setq lq (AppendLs lq (vlax-curve-getParamAtPoint ob (vlax-curve-getClosestPointTo ob p)))))
    (setq li (vl-sort-i lq '>) )
    (foreach i li
        (setq n (fix (nth i lq)) p (nth i lp))
        (setq p1 (vlax-curve-getPointAtParam ob n) p2 (vlax-curve-getPointAtParam ob (1+ n)))
        (if (and  (< fz (distance p p1)) (< fz (distance p p2)))
            (progn
                (setq b (vlax-invoke Ob 'GetBulge n))
                (vlax-invoke Ob 'AddVertex (1+ n) (list (car p)(cadr p)))
                (if (/= b 0)
                    (progn
                        (setq r (/ (distance p1 p2) 2 (sin (* 2 (atan b)))))
                        (vlax-invoke Ob 'SetBulge n (Bulge p p1 r))
                        (vlax-invoke Ob 'SetBulge (1+ n) (Bulge p p2 r))))
            )
        ))

)

    Thank bác ạ. mấy hôm nay e ít thời gian quá nên giờ mới vào thank các bác được

  17. Đã đăng · Trả lời báo cáo

    Bác xem giúp e với ạ. Trường hợp đường 2d polyline trong bản vẽ này  http://www.cadviet.com/upfiles/3/116735_file_lodi.dwg  thì lệnh trên báo lỗi

     

     

    báo lỗi trên cad2005

    "

    Command: ii undo Enter the number of operations to undo or
    [Auto/Control/BEgin/End/Mark/Back] <1>: be
    Command:
    Chon pline muon them dinh
    Nhap ten layer chua cac line can tim giao cat voi pline

    Chon line giao cat mau
    Select objects: Specify opposite corner: 21 found

    Select objects:  break Select object:
    Specify first break point:
    Specify second break point:
    At least one break point must be on polyline.*Invalid*

    "

  19. Đã đăng · Trả lời báo cáo

    Thank bác vì món quà bác tặng.

    E đã test lại thì thấy lỗi với đường polyline ạ. Đối với đường polyline kết quả sau khi chạy lisp chỉ cắt đối tượng ở điểm giao thứ nhất ạ. e cũng không biết về sự khác nhau giữa đường poline và đường 2d polyline lắm. chỉ thi thoảng dùng lệnh plinetype chọn biến hệ thống là 0 or 1 or 2 rồi dùng lệnh pe chọn 2d polyline thì nó chuyển thành polyline ạ. Chuyển ngược lại thì không được

  20. Đã đăng · Trả lời báo cáo

    E đã test bác ạ.

    - Test Lisp cũ trước khi sửa được 292 đỉnh chứ không phải 299 đỉnh ạ. E dùng lisp chứ không biết kiểm tra số đỉnh như thế nào. tại có đỉnh trùng nhau mà

    - Test lisp sau khi sửa thì báo lỗi không chạy được bác ạ. Hay e sửa và thêm không đúng chỗ không biết

     

    /- Thêm các dòng code :...
    vào phía dưới dòng code (command "undo" "be") và phía trên dòng code (setq obj (vlax-ename->vla-object pl)

    Giữa hai dòng này e thấy còn mấy dòng nữa ạ

     

    Thonng bao loi:

    "Command: ii undo Enter the number of operations to undo or
    [Auto/Control/BEgin/End/Mark/Back] <1>: be
    Command:
    Chon pline muon them dinhzoom
    Specify corner of window, enter a scale factor (nX or nXP), or
    [All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: e
    Command:
    Error: no function definition: GESTRING; error: An error has occurred inside
    the *error* functionAutoCAD variable setting rejected: "cmdecho" nil"

     

    Tối kiến của e là có thể giải bài toán bằng cách vẽ pline theo đường dẫn đi qua các đỉnh đường dẫn và các điểm giao cắt.

    Liệu theo cách này thì code bác viết có dễ hơn k ạ. 

  21. Đã đăng · Trả lời báo cáo

    Thank bác Bình ạ. E đã test và kết quả lisp đã thêm được đỉnh ngon mà k lỗi j. Nhưng để nó tổng quát hơn e mong bác sửa giúp e một số yếu tố để kết quả nó như mong đợi ạ.

    Trong bản vẽ yếu tố xác định giao là 225 line thuộc lỚp "ENTCOC" ===> Kết quả là 225 đỉnh

    Bài toán như sau: Kiểm tra vị trí giao giữa đường pline và các line

        - Nếu vị trí giao không trùng vị trí 1 đỉnh nào của Pline thì thêm đỉnh tại vị trí giao (n line giao với pline tại cùng 1 vị trí cho ra n đỉnh tại điểm giao với Pline)

        - Nếu vị trí giao trùng vị trí 1 đỉnh nào của Pline thì xét tiếp n line giao với pline tại cùng 1 đỉnh cho ra n đỉnh tại vị trí đỉnh Pline)

     

    + Bác có thể giúp e bỏ điều kiện chỉ nhận các line thuộc lớp EnTcoc không ạ. Hoặc cách nào để lựa chọn Xác định line giao với pline theo lớp với ạ

  22. Đã đăng · Trả lời báo cáo

    mình đã tesp thử máy bảo lỗi bạn ạ. bạn xem giúp mình với

     

     

    nếu pline cần thêm đỉnh là polyline thì báo lỗi

    "Command: ii
    Chon pline:
    Select objects:
    Chon cac duong giao:
    Select objects: Specify opposite corner: 225 found

    Select objects:  ZOOM
    Specify corner of window, enter a scale factor (nX or nXP), or
    [All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: E
    Command: II Unknown command "II".  Press F1 for help.

    Command: ; error: bad argument value: does not fit in byte: 667"

     

     

    Nếu pline cần thêm đỉnh là 2d polyline thì báo lỗi

    "Command: ii

    Chon pline:
    Select objects:
    Chon cac duong giao:
    Select objects: Specify opposite corner: 125 found

    Select objects:  ZOOM
    Specify corner of window, enter a scale factor (nX or nXP), or
    [All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: E
    Command: II Unknown command "II".  Press F1 for help.

    Command: ; error: bad argument value: does not fit in byte: 458"

  23. Đã đăng · Trả lời báo cáo

    Thank các bác nhé.

    Thank bác "ndtnv" ạ. Bác có thể giúp e cho chót không. e không  được hiểu về lisp cho lắm.

    E đã tìm trên diễn đàn nước ngoài có được lisp break đối tượng tại tất cả vị trí giao nhau rồi nối lại. Cái này thủ công hơn một công đoạn nhưng điều quan trọng là vẫn chưa giải quyết được bài toán nếu có hai đối tượng giao cùng 1 điểm với đường pline thì cách làm trên chỉ tạo thêm được một đỉnh lại vị trí giao. Mong được các bác giúp. em sẽ nghĩ và viết lại yêu cầu để mọi người dễ hiểu. sorry nếu dữ liệu của e thiếu.

    - Xin lỗi bác Bình vì e chưa sửa bài viết. Cũng tại e nghĩ vì các đối tượng giao nhau sẽ tạo ra một điểm giao nên e nghĩ yêu cầu đủ rồi lên không bổ sung. hì, e bổ sung luôn ạ

    116735_chen_dinh.pnghttp://www.cadviet.com/upfiles/3/116735_chen_dinh.dwg

  25. Đã đăng · Trả lời báo cáo

    Nếu nhằm mục đích xóa tất cả các điểm trùng nhau của 1 Lwpolyline bất kỳ, không phân biệt có arc hay không, thì dùng lisp này (còn nếu có thêm điều kiện là chỉ xóa các điểm liên tiếp mà trùng nhau thì phải sửa lisp tí):

    (defun C:HA( / ent)
(vl-load-com)
(if
  (and
   (setq ent (car (entsel "\nChon Lwpolyline: ")))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)))))
  (entmod (LM:HA:UniqueFuzz (entget ent) 1E-8)))
(princ))
(defun LM:HA:UniqueFuzz (lst fz)
(if lst
  (cons (car lst) (LM:HA:UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))

    Bạn có thể giúp mình bổ sung thêm chức năng nhập khoảng cách min bỏ đỉnh không. Nếu khoảng cách nhỏ hơn khoảng cách min thì bỏ đỉnh nếu khoảng cách lớn hơn thì  giữ nguyên lại đỉnh. thank bạn

×