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

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

    Như vậy mình có thể lưu lại các thông số của cung tròn nhỏ và gán vào thông số mở rộng của cung lớn, khi cần mình lấy ra để dùng được ko Bee. Các thông số cùng tròn cần lưu là 3 điểm trên cung là được nhỉ.

    Mình nghĩ dừng ở đây thôi. Vì nếu convert thêm những cung tròn nhỏ thì tạo ra ccung lớn nhưng không bám theo được cung nhỏ đó. ^_^

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

    xin chào

    nhờ anh em viết dùm mình lsp như vầy : mình có nhiều bản vẽ và muốn đánh dấu từ 01 đến 99 vào 1 khung số thứ tự , mình muốn quét chọn từ trái -> phải thì các số nhảy thứ tự tăng lên được ko ạ, 

    Cám ơn anh em!  :)

    Chung chung thế này thì bạn chờ cao thủ viết nhé. ^_^

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

    Chào Bee buổi sáng nhé!

    Tức là ý Bee muốn vì nhiều cái arc nhỏ tuy mềm mại nhưng sẽ "nặng" hơn nên muốn làm cứng hóa chỉ còn ít arc thôi, như trong Poly nhiều đỉnh mà mình làm ít đỉnh lại nhưng vẫn cố bám sát đường Poly đó.

    Chào Huy

     

    Vấn đề là mịn pline nhưng sẽ định vị nhiều điểm để xác định cung tròn nhỏ trong 1 số trường hợp cần dùng. Mà nghĩ lại thì chỉ convert được với 1 đỉnh, 2 đỉnh hoặc 3 đỉnh là hợp lý. Nói chung là chỉ nên convert như thế này là mình thấy hợp lý rồi. :D

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

    Bác Bee tìm được lisp hay ghê.

     

    Em thử nghiên cứu cái lisp của bác xem.

     

    Cảm ơn Bác Bee nhiều nhé.

     

    Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

     

    1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

    2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

    3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

    4.- Cứ thế cho đến hết v.v....

     

    Em cảm ơn các bác đã quan tâm đến vấn đề của em  :D

    Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

    (defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun
    • Vote tăng 1

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

     

    @Bác Bee :

    Đoạn này tương đối không hợp lý vì entget lại 3 lần, hơn nữa tự hàm assoc đã trả về một assoc list rồi, k cần thiết phải cons lại nó nữa

     

     

    (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
(cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
(cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))

    Uhm, tiện thể copy trên xuống nên ko nghĩ ngợi gì ^_^

     

    Thay 

    (assoc 40 (entget (ssname ss 0))) là ok. :D

     

    Ketxu soi chuẩn đấy ^_^

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

    Nét dim bản vẽ của em tự nhiên bị rỗng như hình 2 :

     

    <img src="http://sv1.upsieutoc.com/2016/10/13/2f2ab1.jpg"alt="2f2ab1.jpg" border="0">

     

    Vài ngày trước thì nét dim vẫn bình thường ạ ( hình 3) ;

     

    <img src="http://sv1.upsieutoc.com/2016/10/13/33c70d.jpg"alt="33c70d.jpg" border="0">

     

    Có ai giúp em chỉnh lại được không ạ . em đội ơn các bác

    Fill / ON

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

    Thank bác.

    Tuy nhiên vẫn chưa đúng ý e lắm :)

    + Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

    + Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

    MTEXT đây ^_^

    (defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOF value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "MTEXT")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbMText") 
          (cons 10 (trans pt 1 0))
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

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

    Nhờ các cao thủ viết giúp mình lisp như tựa đề.

    Ví dụ cụ thể:

    Trên bản vẽ có sẵn 2 hoặc nhiều text (hoặc mtext), chẳng hạn 2(text), 3(mtext) và 4(text).

    Mình gõ lệnh (ví dụ "cộng"), click chọn vào 2, 3, và 4, sẽ được kết quả là 9, và output ra 1 mtext. Mình sẽ click chọn vị trí để output mtext này trên bản vẽ.

    Cảm ơn nhiều! :D

    Test thử tí. ^_^

    (defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOI value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 10 pt)
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum 2 2))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

 ;|«Visual LISP© Format Options»
;*** DO NOT add text below the comment! ***|;
    • Vote tăng 2

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

    @Bee : Ket dùng 2008 và 2017. Lỗi UCS là code biểu diễn của bác Mạnh, vì chắc chưa trans vector, k phải ở code bác. Các bác toàn đóng vào nên ket cũng k học được nhiều :D

     

    - Bài này với đường biên các bác dùng vla-boolean union với Region bên ngoài (nếu n >1) sẽ thuận tiện hơn ạ

    Có tí code nghịch vui. Bác nào rảnh hoàn thiện nốt cho ra kết quả ^_^

    (DEFUN c:test  (/ *error* cen d gr loop p1 foo foo_1 line circle1 circle2 lst_1 lst_2)
  (DEFUN *error*  (msg)
    (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
    (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
    (AND line
         (ENTDEL line)
         (SETQ line nil)
         ) ;and
    (OR (= msg "function cancelled")
        (PRINC (STRCAT "\nerror: " msg))
        )
    (PRINC)
    )
  (SETQ cen  (GETPOINT "\nChon diem 1: ")
        loop T
        )
  (SETQ d (GETREAL "\nChon duong kinh: "))
  (IF (NOT d)
    (SETQ d 6)
    )
  (WHILE (AND (SETQ gr (GRREAD T 12 0)) loop)
    (COND
      ((= (CAR gr) 5)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
       (SETQ lst_1 nil
             lst_2 nil)
       (AND line
            (ENTDEL line)
            (SETQ line nil)
            ) ;and
       (SETQ p1 (CADR gr))
       (SETQ foo (/ (DISTANCE p1 cen) d))
       (SETQ foo_1 (ATOI (RTOS foo 2 2)))
       (IF (> foo_1 1)
         (PROGN
           (SETQ lst_1 nil
                 lst_2 nil)

           (SETQ line (ENTMAKEX
                        (LIST
                          '(0 . "LINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbLine")
                          '(62 . 6)
                          (CONS 11 p1)
                          (CONS 10 cen)
                          )
                        ) ;entmakex_line
                 )

           (SETQ circle1 (ENTMAKEX
                           (LIST
                             '(0 . "CIRCLE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbCircle")
                             '(62 . 6)
                             (CONS 40 (/ d 2))
                             (CONS 10 cen)
                             )
                           ) ;entmakex_circle1
                 circle2 (ENTMAKEX
                           (LIST
                             '(0 . "CIRCLE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbCircle")
                             '(62 . 6)
                             (CONS 40 (+ (/ d 2) 1))
                             (CONS 10 cen)
                             )
                           ) ;entmakex_circle2
                 ) ;setq
           (SETQ lst_1 (CONS circle1 lst_1))
           (SETQ lst_2 (CONS circle2 lst_2))

           (SETQ p1a (POLAR cen (ANGLE cen p1) (+ d 1)))
           (REPEAT (- foo_1 3)
             (SETQ circle1 (ENTMAKEX
                             (LIST
                               '(0 . "CIRCLE")
                               '(100 . "AcDbEntity")
                               '(100 . "AcDbCircle")
                               '(62 . 6)
                               (CONS 40 (/ d 2))
                               (CONS 10 p1a)
                               )
                             ) ;entmakex_circle1
                   circle2 (ENTMAKEX
                             (LIST
                               '(0 . "CIRCLE")
                               '(100 . "AcDbEntity")
                               '(100 . "AcDbCircle")
                               '(62 . 6)
                               (CONS 40 (+ (/ d 2) 1))
                               (CONS 10 p1a)
                               )
                             ) ;entmakex_circle2
                   ) ;setq
             (SETQ p1a (POLAR p1a (ANGLE cen p1) (+ d 1)))

             (SETQ lst_1 (CONS circle1 lst_1))
             (SETQ lst_2 (CONS circle2 lst_2))
             ) ;repeat
           )
         ) ;if
       )
      ((= (CAR gr) 3) (SETQ loop nil))
      (T
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_1)
       (MAPCAR '(LAMBDA (o) (VLA-DELETE (VLAX-ENAME->VLA-OBJECT o))) lst_2)
       (SETQ lst_1 nil
             lst_2 nil)
       (AND line
            (ENTDEL line)
            (SETQ line nil)
            ) ;and
       (SETQ loop nil))
      )
    )
  (PRINC)
  )

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

    Có thể cách này được không bạn.

    1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

    2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

    3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

    4.- Cứ thế cho đến hết v.v....

    Bạn xem file của chủ thớt gửi chưa ?

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

    Cảm ơn bác đã trả lời. 

     

    Vậy thì đen thật bác ạ. :ph34r:

     

    Em có thể phá các pline đó sau đó lấy các tập hợp điểm trùng nhau, dựa vào các tập hợp điểm đó vẽ các đoạn acr ngắn được không bác.

    Mong được bác tư vấn tiếp :)

     

    Cảm ơn Bee rất nhiều.

    Explode pline thì không cần. Code này của 1 đồng chí Russia :D

    Thử nghịch xem nhé. Chuyển các segment là line thành arc segment. Nhớ di chuột ít thôi nhé ^_^

    (defun c:hehehe ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

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

    Sao của bác Mạnh ket thấy chỉ có preview thôi nhỉ ^^ Ấn j để ra kết quả ta

    Chưa hợp lý với n = 1 và UCS khác world 

    Ps : code 28k chắc bác ôm LM osnap của Grread + LM:Grtext vào hén :)

     

    - Của bác Bee thì test thấy chỉ tạo được nửa dưới đường bao ngoài. Hay cad của ket có vấn đề nhỉ @@

    Bai%204%20-8-22-2014-12.22.50%20PM11-10-

    CAD ketxu bao nhiêu vậy. Mình test file vlx thì vẫn đúng khi xoay usc và một số kiểu khác. Load lại và test lại xem nào ketxu.!

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

    Mình luôn có ông bạn tên Google. Hỏi gì cũng trả lời. :D Hỏi được vài trang web: trong đó có http://www.afralisp.net/visual-lisp/tutorials/là ví dụ tìm hiểu tốt. Có thể seach thêm.

     

    Đây là cách ACAD tổ chức quản lý đối tượng :

     

    https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files/GUID-A809CD71-4655-44E2-B674-1FE200B9FE30-htm.html

     

    Và hỏi thêm mọi người. ^_^ Good luck.

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

    Nếu không nhầm thì mình hiểu ý bạn thế này:

    Bạn có khung tên dưới dạng một Block bao gồm cả đối tượng Line, Circle,Polyline... và Attributes, bây giờ có thay đổi ở khung tên (chỉ xóa một vài đối tượng Line/Polyline hoặc gì đó) chứ không liên quan gì đến việc thay đổi attributes, và việc này dẫn đến phải update cho rất nhiều bản vẽ nên bạn cần một lisp hoặc một tool để làm cái này.

    Hy vọng mình hiểu đúng ý bạn. hehe

    Khung tên chỉ là một ví dụ dễ hình dung nhất. Thường thì là sử dụng xref. Thay đổi khung cũng đơn giản.

     

    Ví dụ phức tạp hơn 1 chút: đó là tag cửa. Công trình nhiều tầng chẳng hạn.

    Block tag cửa thường là chỉ có 2 tag: tag tên cửa và tag kích thước cửa. Các bản vẽ đều có hết tag cửa rồi.  Bây giờ CDT yêu cầu thêm thông tin bậu cửa sổ cách sàn bao nhiêu (thường là 900 chẳng hạn) và cửa đi sẽ là 0. Rồi bây giờ sẽ phải sửa toàn bộ tag cửa thêm 1 att và thay lại block mới 3 att vào toàn bộ block cũ 2att. Không tính trâu bò sửa tay ^_^. Có cách nào nhanh không ?

×