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

gia_bach

CADViet Team
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.624

  • Đã tham gia

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

  • Ngày trúng

    122

Bài đăng được đăng bởi gia_bach

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

     
     
     
    5 giờ trước, QUOCMINHVT đã nói:

    Chào các tiền bối, các tiền bối cho em hỏi về vấn đề này chút ạ
    Em có làm một bản vẽ, nhưng về DIM, em không biết sao CAD lấy tròn số hơi sai, làm tròn giá trị nên đôi khi nó thừa 1 đơn bị, em không biết chỉnh lại thế nào cho nó khỏi bị tình tràng  này nữa.
    Ai biết xin giúp em, em cảm ơn ạ

     

    Cái này là do người vẽ ẩu thôi chứ CAD nó không ngu đâu!

     

    đó là do sai số công dồn thôi.

    vd:

    - 1550.3 làm tròn thành 1550

    - 750.4 cũng làm tròn thành 750

     nhưng 1550.3+ 750.4=2300.7 làm tròn thành 2301

     

    image.png.4702c562d43a8a42597e890407043da7.png

    • Vote tăng 2

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

    2 phút trước, Doan Van Ha đã nói:

    @gia_bach: hỏi ké ở đây tí: với zwcad có thể tạo dialog với các label của title bằng tiếng Việt không? Thanks!

    Tôi thường sử dụng .NET để làm giao diện, nên không rành về dialog lắm.

     

    @ngokiet ừ, để  CrossProduct  chạy cũng đc, chắc có gì nhầm lẫn giửa các CAD.

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

    5 phút trước, ngokiet đã nói:

    - Cái a210 không cần tính về Normalize mà chỉ cần tính CrossProduct thôi là được rồi. Tính về CrossProduct thì khi entmake nó cũng tính lại hay sao đó. 

    - Còn kiểm tra 3 điểm thẳng hàng thì đơn giản hơn là CrossProduct là <> '(0 0 0) . (not (vl-every 'zerop a210)) 

       Trong trường hợp này bạn phải tính 1 vecto bất kỳ nào đó vuông góc với phương đó làm a210 chứ ko lấy '(0 0 1) vì nếu z khác nhau.

    (còn kiểm tra p1 p2 p3 không trùng nhau nữa)

     

     

    @ngokiet

    - A210 phải tính vecto đon vị, đã kiểm tra.

    - ok tr/hợp thẳng hàng đưa về (0 0 1) là chưa chính xác.

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

    Xin cám ơn tất cả mọi người đã đọc và đóng góp ý kiến cho chủ đề này, nói chung là các code-Lisp đều chạy tốt trên AutoCAD.

    Tuy nhiên do cá nhân tôi, từ khi viết tool cho nhiều nền tảng khác AutoCAD (vd: ZwCAD, BricsCad, IntelliCAD...) tôi thường có thói quen chỉ sử dụng các hàm thuần AutoLISP, hạn chế sử dụng các hàm built-in của AutoCAD như Express-tool (acet-*) hay VisualLISP (vla-*) khi có thể. Dĩ nhiên nếu không có cách khác thì phải sử dụng các hàm built-in thôi.

    Nếu chỉ dùng AutoCAD thì việc sử dụng các hàm này sẽ tiết kiệm rất nhiều thời gian và công sức, đạt hiệu suất cao vì đã được tối ưu cho AutoCAD. Và mục đích chính là làm cho AutoCAD phục vụ mình nhanh hơn, diệu kỳ hơn ... đã đạt được.

    Nhưng trong trường hợp phài sử dụng các phần mềm CAD khác (vì lý do bản quyền, chi phí đầu tư ...)  thì sẽ gặp khá nhiều khó khăn khi chuyển đổi, tính tương thích không cao (các CAD khác không hỗ trợ hoặc hỗ trợ rất kém các hàm này). Nếu muốn viết lại hàm thì không có công thức/thuật toán để chuyển đổi.

    Trên cơ sở các lisp của mọi người, xin cập nhật và hiệu chỉnh để có thể chạy với các CAD khác.

      

    ;; CrossProduct (Gile)
;; Returns the cross product (vector) of two vectors
;;
;; Arguments: two vectors
(defun CrossProduct (v1 v2)
 (list    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)

;; Normalize (Gile)
;; Returns the single unit vector of a vector
;;
;; Argument : a vector
(defun Normalize (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)

;; Norm_3Points (Gile)
;; Returns the single unit normal vector of a plane definedby 3 points
;;
;; Arguments: three points
(defun norm_3pts (p0 p1 p2)
 (Normalize (CrossProduct (mapcar '- p1 p0) (mapcar '- p2 p0)))
)

;; Collinearity check (Lee Mac)
(defun isCollinear ( p1 p2 p3 fz )
 (equal (rem (angle p1 p2) pi) (rem (angle p2 p3) pi) fz)
)

(defun c:test(/ lp p1 p2 p3 a210)
  (if
    (and
       (setq p1 (getpoint "\nChon diem 1"))
       (setq p2 (getpoint p1 "\nChon diem 2"))
       (setq p3 (getpoint p2 "\nChon diem 3"))       )
    (progn
      (setq p1 (trans p1 1 0)
	    p2 (trans p2 1 0)
	    p3 (trans p3 1 0))
      (if (isCollinear p1 p2 p3 1e-6)
	(setq a210 '(0 0 1))
	(setq a210 (norm_3pts p1 p2 p3)))
      (setq lp (list p1 p2 p3))
      (setq lp (mapcar '(lambda(x) (trans x 0 a210)) lp))
      (entmakex (append
		  (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
			(cons 38 (caddar lp))(cons 90 (length lp)) )
		  (mapcar '(lambda(x) (list 10 (car x) (cadr x))) lp)
		  (list (cons 210 a210))))      )    )
  (princ))

     

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

    11 phút trước, DuongTrungHuy đã nói:

    Bạn chuyển mặt phẳng vẽ về 3 đỉnh của Poly3D thử xem được k? Lệnh UCS enter xong 3 và enter.

    Cám ơn bác, dùng lệnh UCS với 3 point để tạo 1 hệ trục tọa độ mới đã giải quyết được vấn đề (sau đó dùng lệnh Pline để vẽ như bình thường).

     

    Bác có thể giới thiệu cách vẽ đường LwPolyline dùng AutoLisp  ?

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

    Chào mọi người,

    Anh em cho hỏi cách vẽ đường LwPolyline theo 1 mặt phẳng bất kỳ sử dụng lệnh của Cad và dùng AutoLisp ?

     

    Cụ thể trong file đính kèm, có ba điểm thuộc đỉnh của đường polyline3d màu trắng,

     - làm cách nào vẽ được đường LwPolyline màu cyan ?

    image.thumb.png.95746c7e3f9caefa6e172483f3f9016d.png

    Cám ơn mọi người đã đọc tin.

    LwPolyline in 3d.dwg

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

    23 phút trước, Vũ quang Hiếu đã nói:

    Đầu tiên, em xin gửi lời chào đến các anh, chị trong diễn đàn và chúc diễn đàn ngày càng lớn mạnh

    Như tiêu đề, do công việc thường phải làm việc với bản đồ rộng, nhiều khu vực,  vì vậy, mỗi khi Paste Original Coordiantes em phải mất rất nhiều thời gian để tìm được đối tượng vừa Paste. Mong các cao thủ có thể viết giùm em 1 Lisp có chức năng zoom đến đối tượng vừa paste. Em xin cảm ơn và hậu tạ

    Nếu kết quả của việc Paste là 1 đối tượng, bạn có thể sử dụng lisp này. 

    (defun c:zoomLast(/ ll ur)
  (vla-GetBoundingBox (vlax-ename->vla-object (entlast)) 'LL 'UR)
  (vla-zoomwindow (vlax-get-acad-object) ll ur)
  (princ)  )

     

    • Like 1

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

     
     
     
     
    Vào lúc 5/4/2020 tại 09:57, quocmanh04tt đã nói:

    @thiep: 

    .......

        (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\">%"))))
    ........

    @thiệp Kết quả chỉ đúng tại thời điểm chạy Lisp.

    Sau đó nếu user edit giá trị từ TextOverride sang Measurement (hoặc ngược lai) thì lisp không tự phát hiện đc, và dĩ nhiên k/quả sẽ ko đúng.

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

     
     
     
     
    44 phút trước, Doan Van Ha đã nói:

    Tui có MTEXT này, mà sao thay đổi width của nó không được, kể cả dùng entmod và vla-put-width. Mọi người giúp xem.

      

    

(defun c:mwid (/ ent)
 (vl-load-com)
 (if (and (setq ent (car (entsel "\nSelect MTEXT: ")))
          (eq "MTEXT" (cdadr (entget ent))))
     (vla-put-width (vlax-ename->vla-object ent) 0.3))
 (princ))

     

     

    Hoi_CV.dwg

     

    Nó có thay đổi đấy chứ, bác thử set giá trị là 10000 sẽ thấy sự khác biệt.

     

    Nhưng hình như ý bác muốn set widthFactor giống dText ?! 

    bác xem phần Contents.

    image.png.c9124590dcc21953d3470cdc21d190da.png

    • Vote tăng 1

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

    Do C3D có 1 lệnh tên là dd (transparent command)  và chúng ta không thể định nghĩa lại lệnh này với Lisp của bạn.

    (thử kiểm tra bằng cách gọi lệnh dd trước khi load Lisp, nó cũng hiện thông báo tương tự)

     

    Tôi thử đổi tên Lisp thành dd1, thì Lisp chạy tốt.

    (defun c:dd1 () (command "ddim" ))

    • Vote tăng 1

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

    Vào lúc 12/12/2019 tại 09:02, dovananh.xd đã nói:

    bác Ketxu ơi. Cái lisp này sao không sử dụng được cho CAD2019 vậy ạ? Bác sửa lại giúp em với

    Em cảm ơn!

    Thử lisp này nhé. 

    ;@ketxu
(vl-load-com)
(if (null dmtd)
  (setq dmtd (vlr-command-reactor nil '((:vlr-unknownCommand . doimau)))))
;;*********************************************************************
(defun doimau (calling-reactor endcommandInfo / Layer_Key)
  (setq Layer_Key (strcase (nth 0 endcommandInfo)))
  (if (and (= (strlen (rtos (atoi Layer_Key) 2 0))(strlen Layer_key))(< (atoi Layer_key) 257))(doimaufunc)(princ "\nChua co lenh nao nhu the nay")))
;;*********************************************************************
(defun doimaufunc (/ dis1 ss)
  (setq col (atoi Layer_Key)  ss (ssget))
  (if ss (foreach a (mapcar 'vlax-ename->vla-object (ST:Ss->lstEnt ss ) ) (vla-put-color a col))(princ)) )

(defun ST:Ss->lstEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l)) ))

     

    • Like 1

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

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

     

     

    @Doan Van Ha Em đã tham khảo link anh gửi nhưng em còn thắc mắc, mong anh giải đáp.

    Hiện em đã có lisp copy đối tượng từ layout hiện hành sang tất cả các layout.

    Code lisp: 

    
(defun c:CTL (/ *error* ss)
(princ "\rCOPYTOLAYOUTS ")
(vl-load-com)
 
(defun *error* (msg)
(if acDoc (vla-endundomark acDoc))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** ")))) ; Fatal error, display it
(princ))
 
(prompt "\nSelect objects to copy to layouts: ")
(if (setq ss (ssget "_:L"))
((lambda (acDoc / oItemList oCurLayout)
(vla-startundomark acDoc)
(vlax-for oItem (setq ss (vla-get-activeselectionset acDoc))
(setq oItemList (cons oItem oItemList)))
(vlax-for oLayout (vla-get-layouts acDoc)
(if (and (/= (cond
(oCurLayout)
((setq oCurLayout (vla-get-activeLayout acDoc))))
oLayout)
(/= "Model" (vla-get-name oLayout)))
(vlax-invoke
acDoc
"copyobjects"
oItemList
(vla-get-block oLayout))))
(vla-delete ss)
(*error* nil))
(vla-get-activedocument (vlax-get-acad-object)))
(prompt "\n** Nothing selected ** "))
(princ))

    Em muốn tìm lisp để xóa đối tượng ở cùng một vị trí (tọa độ) trong tất cả các lay out (Ví dụ: Block khung tên, ghi chú,...) nhưng em tham khảo trên mạng không có lisp như vậy.

    Nếu thay đổi chức năng copy trong lisp như trên thành delete thì có được không ạ?

    Anh có thể hướng dẫn chi tiết thêm được không ? Em cám ơn anh.

    Tham khảo lisp xóa tất cả block có điểm chèn tại (0 , 0 0) trong tất cả layout. 

    (defun c:eraseBlock (/ pt )
  (setq pt (list 0 0 0))
  (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for obj (vla-get-block lay)
      (if (= (vla-get-Objectname obj) "AcDbBlockReference"   )
	(if (< (distance pt (vlax-safearray->list (variant-value(vla-get-InsertionPoint obj)))) 0.00001)
	     (vla-erase obj)
	  )
	)
      )
    )
(princ))

     

×