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

Bee

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

  • Số lượng nội dung

    553

  • Đã tham gia

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

  • Ngày trúng

    37

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

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

    Chào Tất cả anh em

    Mình muốn tạo 1 lisp vẽ thoát khí cho sản phẩm. yêu cầu bài toán mình đã thể hiện trên ảnh

    Rất mong các anh em giúp đỡ.

    Bai%20Toan%203_zpsmkz9p7p0.png

    Uhm thử cái mới nhé. :D

     

    Mình nghịch bằng C# nên load file bằng lệnh NETLOAD chứ ko phải APPLOAD nữa nhé. Tên lệnh VTK (vẽ thoát khí)

     

    https://drive.google.com/file/d/0ByeIZA9K1JEOTnR0US1DZ3Z4VDg/view?usp=sharing

     

    Chúc ngon miệng

    • Vote tăng 1

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

    Lisp trên mình đã thử và ko cho ra kết quả, hơn nữa lúc đến phần nhập chiều dài khuôn mình muốn phần nhập hiện lên màn hình ý. Còn lisp sau thì bạn gửi là lisp mã hóa mà ko nhắc cho mình lệnh tắt là gì nên mình chịu chưa thử đc  :P  :P  :P

    Heizz tập thói quen cẩn thẩn đi chứ. Lúc load lisp thì có hiện thông báo lệnh ở dòng command mà. :(

    • Vote tăng 2

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

    Lỡ mà trước đó đã vẽ 1 đối tượng có diện tích và hatch trong lisp không thành công thì hơi tai hại nhỉ ^^

    Uhm, con mình ngủ mới rảnh sửa.

    Lisp trên mình viết nhanh ko tính hết, chỉ tính trường hợp đúng nhất. Thử lisp này xem thế nào. Nếu error mình sẽ sửa tiếp cho hoàn thiện hơn . Điều kiện là có cài express và vùng cần tính như trong đầu bài là pline nhé. :D

    Download file:

     

    https://www.fshare.vn/file/SATXXM38M7TA

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

    https://drive.google.com/file/d/0B-gIuhLk2Nw1OEI4U0NPLXdVRmM/view?usp=sharing

     

    Xin chào anh em trên diễn đàn

    Mình muốn nhờ anh em viết cho một lisp tính khối lượng khuôn. Yêu cầu cụ thể mình có ghi trong file ảnh đính kèm.

    Mong anh em giúp đỡ.

    Thanks

    Thử lisp này nhé.

    (defun c:test (/ pt d obj area m)
  (if (setq pt (getpoint "\nChon point bat ky: "))
    (progn
      (setq d nil)
      (while (not (setq d (getreal "\nChon chieu dai khuon: "))))
      (command "-hatch" pt "")
      (setq obj (vlax-ename->vla-object (entlast)))
      (setq area (vlax-get Obj "Area"))
      (setq m (rtos (/ (* (* area d) 7.86) 1000000.) 2 2))
      (vla-AddText
	(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
	m
	(vlax-3d-point pt)
	(getvar 'textsize)
	)
      (vla-delete obj)
      )
    (princ "\nBan da khong chon diem bat ky.")
    )
  (princ)
  )

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

    Chào tất cả anh em trong diễn đàn

    mình có một bài toán mong các anh em giúp đỡ

    yêu cầu bài toán:

    1. có một đoạn thẳng mình muốn tạo ra một tam giác cân góc 60 độ chỉ với 2 click . 

          click 1: chọn đường thẳng

          click 2 : chon miền đặt điểm đỉnh của tam giác

    2. tự động tạo ra lỗ khoan bằng cách nhập tọa độ 2 điểm trên màn hinh mà khoảng cách giữa hai điểm đó chính là chiều sâu của mũi khoan sau đó chương chình yêu cầu nhập đường kính mũi khoan

    ......

    mình muốn 2 bài toán trên gộp thành một chương trình với 2 lựa chọn

    mình đã upload hình ảnh mô tả bài toán ở dưới. rất mong các anh em giúp đỡ.

     

    https://drive.google.com/file/d/0Byp-qz2acPIgcF9fV2FPZDc3VUk/view?usp=sharing

    Mềnh chả biết mũi khoan là gì nhưng thấy bài toàn giải hay hay nên nghịch chơi. Thử lisp này nhé. ^_^

    ;;;Found Internet
(defun Point_per (P1 P2 P3 / X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 T4)
  (setq	X1 (car P1)
	X2 (car P2)
	X3 (car P3)
	Y1 (cadr P1)
	Y2 (cadr P2)
	Y3 (cadr P3)
	Z1 (caddr P1)
	Z2 (caddr P2)
	Z3 (caddr P3)
	T4 (/ (+ (* (- X2 X1) (- X3 X1))
		 (* (- Y2 Y1) (- Y3 Y1))
		 (* (- Z2 Z1) (- Z3 Z1))
	      )
	      (+ (* (- X2 X1) (- X2 X1))
		 (* (- Y2 Y1) (- Y2 Y1))
		 (* (- Z2 Z1) (- Z2 Z1))
	      )
	   )
  )
  (list	(+ X1 (* T4 (- X2 X1)))
	(+ Y1 (* T4 (- Y2 Y1)))
	(+ Z1 (* T4 (- Z2 Z1)))
  )
)
;;;My funtions
(defun ve_mui_khoan ( / a p10 p11 pt pt1 pt2 pt_0)
  (setq a (car (entsel "\nChon doan thang: ")))
  (if a
    (progn
      (setq p10 (cdr (assoc 10 (entget a))))
      (setq p11 (cdr (assoc 11 (entget a))))
      (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
      (setq pt1 (getpoint "\nChon diem bat ky: "))
      (setq pt2 (Point_per p10 p11 pt1))
      (setq pt_0 (polar	pt
			(angle pt2 pt1)
			(/ (* (distance p10 p11) (sqrt 3)) 6)
		 )
      )
      (command "_polygon" "3" "_none" pt_0 "I" p10)
    )
  )
)
(defun ve_lo_khoan (/ p1 p2 d p3 p4 p5 p6 p7 ang)
  (setq p1 (getpoint "\nChon diem 1: "))
  (setq p2 (getpoint p1 "\nChon diem 2: "))
  (setq d (getreal "\nChon duong kinh: "))
  (setq p3 (polar p1 (+ (setq ang (angle p1 p2)) (* pi 0.5)) (/ d 2))
	p4 (polar p3 (+ ang (* pi 1.5)) d)
	p5 (polar p4 ang (distance p1 p2))
	p6 (polar p5 (+ ang (* pi 0.5)) d)
	p7 (polar p2 (angle p1 p2) (/ (* d (sqrt 3)) 6))
	)
  (command "line" "_non" p3 "_non" p4 "_non" p5 "_non" p6 "_non" p3 ""
	   "line" "_non" p6 "_non" p7 "_non" p5 "")
  )
(defun c:test ()
  (initget 1 "M L ")
  (setq ob (getkword "\nChon ve mui khoan hoac ve lo khoan [Mui/Lo]: "))
  (cond
    ((= ob "M")
     (ve_mui_khoan)
     )
    ((= ob "L")
     (ve_lo_khoan)
     )
    );#cond
  (princ)
  )

    Lệnh test nhé.

    • Vote tăng 1

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

    Thanks bạn !

    Cái này cũng giống với lệnh torient nhưng sau khi quay đi 1 góc nó cũng bị lệch tâm ah bạn ơi ! 

    Đã test bản vẽ của bạn. Ok nhé ^_^

    (defun c:XOM (/ ss ss1 center n i ent lse)
  (c:torient)
  (setq ss (ssget "_P"))
  (command "_justifytext" ss "" "MC")
  (setq n 0)
  (repeat (sslength ss)
    (command "_explode" (ssname ss n))
    (setq ss1 (ssget "_P"))
    (setq center nil)
    (setq i 0)
    (while (not center)
      (if (or (eq (cdr (assoc 0 (entget (ssname ss1 i)))) "CIRCLE")
	      (eq (cdr (assoc 0 (entget (ssname ss1 i)))) "ELLIPSE")
	  )
	(setq center (cdr (assoc 10 (entget (ssname ss1 i)))))
      )
      (setq i (1+ i))
    )
    (command "undo" "")
    (setq ent (ssname ss n)
	  ent (entnext ent)
	  lse (entget ent)
    )
    (entmod (subst (cons 11 center) (assoc 11 lse) lse))
    (entupd ent)
    (setq n (1+ n))
  )
  (princ)
)
    • Vote tăng 1

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

    không được bác ah, cad nó báo Command: test

    ; error: ActiveX Server returned the error: unknown name: Name

    Command:

    Thay "*TEXT" trong code bằng "AcDbText" là ngon. ^_^

    (defun c:test ()
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blks (vla-get-blocks acdoc)
    (vlax-for obj blks
      (if (wcmatch (vla-get-ObjectName obj) "AcDbLeader")
	(progn
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "")
	    (vla-put-Layer obj "14.Dimhh")
	    )
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "DotBlank")
	    (vla-put-Layer obj "15.Dimct")
	    )
	  )
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "AcDbText")
	       (or (wcmatch (vla-get-StyleName obj) "Text 1.5")
		   (wcmatch (vla-get-StyleName obj) "Text 1.8")
		   )
	       )
	(vla-put-Layer obj "06.Text1.8")
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "AcDbText")
	       (or (wcmatch (vla-get-StyleName obj) "Text 2.5")
		   (wcmatch (vla-get-StyleName obj) "Text 3.0")
		   )
	       )
	(vla-put-Layer obj "07.Text3.0")
	)
      );vlax-for obj
    );vlax-for blks
  (princ)
  )
    • Vote tăng 1

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

    chào các pro , hiện e có 1 vấn đề nhỏ, đó là có thể có cách nào tính tổng các giá trị chiều dài trong Dim ko? thanks all

    Search thôi.

    (defun c:DimSum (/ #SSList)
  (and (setq #SSList (AT:SS->List (ssget '((0 . "DIMENSION"))) T))
       (alert
         (strcat "Total Distance: "
                 (vl-princ-to-string
                   (apply '+ (mapcar 'vla-get-measurement #SSList))
                 ) ;_ vl-princ-to-string
                 "'"
         ) ;_ strcat
       ) ;_ alert
  ) ;_ and
  (princ)
) ;_ defun
;;; Convert selection set to list of ename or vla objects
;;; #Selection - SSGET selection set
;;; #VLAList - T for vla objects, nil for ename
;;; Alan J. Thompson, 04.20.09
(defun AT:SS->List (#Selection #VlaList / #List)
  (and #Selection
       (setq #List (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex #Selection))
                   ) ;_ vl-remove-if
       ) ;_ setq
       #VlaList
       (setq #List (mapcar 'vlax-ename->vla-object #List))
  ) ;_ and
  #List
) ;_ defun

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

    e up load bản vẽ của e lên ạ. mong mọi người viết giúp e 1 lisp mà khi mình sử dụng thì: 

    1. leader hình mũi tên(closed filled) sẽ chuyển hết về layer "14.Dimhh"; 

    2. leader hình tròn (Dot blank) sẽ chuyển hết về layer "15.Dimct". 

    3. các text thuộc text style "Text 1.5" và "Text 1.8" sẽ chuyển về layer "06.Text1.8"; 

    4. text thuộc text style "Text 2.5" và "Text 3.0" sẽ chuyển về layer "07.Text3.0". 

    các layer và các style đã có sẵn trong bản vẽ, nhưng e ko up bản vẽ lên được (cứ báo Đang upload. Xin chờ). e cảm ơn ạ

    Uhm, thử lisp này xem ^_^

    (defun c:test ()
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blks (vla-get-blocks acdoc)
    (vlax-for obj blks
      (if (wcmatch (vla-get-ObjectName obj) "AcDbLeader")
	(progn
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "")
	    (vla-put-Layer obj "14.Dimhh")
	    )
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "DotBlank")
	    (vla-put-Layer obj "15.Dimct")
	    )
	  )
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 1.5")
		   (wcmatch (vla-get-StyleName obj) "Text 1.8")
		   )
	       )
	(vla-put-Layer obj "06.Text1.8")
	)
      (if (and (wcmatch (vla-get-Name obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 2.5")
		   (wcmatch (vla-get-StyleName obj) "Text 3.0")
		   )
	       )
	(vla-put-Layer obj "07.Text3.0")
	)
      );vlax-for obj
    );vlax-for blks
  (princ)
  )
    • Vote tăng 1

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

    Nếu kết hợp vừa move vào tâm và xoay luôn thì còn gì bằng nữa. Tuyệt vời

    Mong tin từ bạn. 

    Trong 1 bản vẽ thì có nhiều att block, lsp nên chọn những đối tượng att block nào cần move và xoay thôi thì hay hơn

    bởi vì có những cái không cần tác đến chúng.

    Uhm, không sửa block gốc thì sài tạm cái này tổng hợp mấy cái cho nhanh vậy ^_^

    (defun c:XOM (/ ss ss1 center n i ent lst lse)
  (c:torient)
  (setq ss (ssget "_P"))
  (setq n 0)
  (repeat (sslength ss)
    (command "_explode" (ssname ss n))
    (setq ss1 (ssget "_P"))
    (setq center nil)
    (setq i 0)
    (while (not center)
      (if (or (eq (cdr (assoc 0 (entget (ssname ss1 i)))) "CIRCLE")
	      (eq (cdr (assoc 0 (entget (ssname ss1 i)))) "ELLIPSE")
	      )
	(setq center (cdr (assoc 10 (entget (ssname ss1 i)))))
      )
      (setq i (1+ i))
    )
    (command "undo" "")
    (setq ent (ssname ss n)
	  ent (entnext ent)
	  lst (list (cons 71 0)
		    (cons 72 1)
		    (cons 11 center)
	      )
	  lse (entget ent)
    )
    (mapcar '(lambda (x) (entmod (subst x (assoc (car x) lse) lse)))
	    lst
    )
    (entupd ent)
    (setq n (1+ n))
  )
  (princ)
) 

    Đúng ý nhé. Chén thôi. ^_^

×