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

cuongtk2

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

    422
  • Đã tham gia

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

  • Ngày trúng

    34

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


  1. Nói rõ về cái để double click trong1. thì mới giúp được.

    - Đang phỏng đoán nó là 1 block có chứa 1 số entity bị tắt layer, hoặc bị ẩn năm ở xa chỗ mình cần nhìn khi editblock.

    - Hoặc điểm chèn của khối nằm rất xa mấy cái viền khung tên (hay gặp khi dùng Paste để tạo khối mà không ấn định basepoint). Bạn thử pick vào block xem nó hiện điểm insert ở nơi nào là rõ.


  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é

    • Like 1

  3. Đâ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")
    
    
    )
    
    
    
    

     


  4. 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))
      )
    
    )
        
    
    

     

    • Like 1

  5. (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)
          )
        )
    )

     

    • Like 2

  6. 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

    Animation.gif

×