Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
Nam2604

đánh dấu những đường tròn có kích thước giống nhau bằng chữ cái.

Bởi Nam2604 , trong AutoLisp

Các bài được khuyến nghị

Nam2604    1

Nam2604
Đã đăng

chào các bác ạ. Trên bản vẽ có nhiều đường tròn như này, em muốn đánh dấu những đường tròn có kích thước giống nhau bằng 1 chữ cái cái nhất định, mà chọn tay thì khá là lâu đối với những bản vẽ có nhiều đường tròn như vậy. các bác cho em xin lisp với mục đích như trên với ạ. nếu kèm theo được xuất tọa độ các lỗ ra bảng thì tuyệt vời. em cảm ơn các bác ạ

image.png

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

CadExTools    104

CadExTools
Đã đăng

Cái này giống khuôn mẫu nhỉ?

Ý tưởng có thể xuất thông tin lỗ ra Excel -> Đánh mã số trên Excel dựa trên đường kính -> cập nhật lại Autocad

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nam2604    1

Nam2604
Đã đăng
1 giờ trước, CadExTools đã nói:

Cái này giống khuôn mẫu nhỉ?

Ý tưởng có thể xuất thông tin lỗ ra Excel -> Đánh mã số trên Excel dựa trên đường kính -> cập nhật lại Autocad

vâng đúng rồi bác ạ, đây là khuôn đột dập, em muốn đánh dấu những đường tròn bằng nhau bằng 1 chữ cái, rồi có thể đưa ra list tọa độ, đường kính vào 1 bảng trong cad. ý tưởng là thế bác ạ.

 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cuongtk2    362

cuongtk2
Đã đăng

Của bạn đây 

;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;;	=> if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;;	=> e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use


(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
    (setq ncols (apply 'max (mapcar 'length lst))
	  vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
	  )
    (vla-put-RegenerateTableSuppressed vtable :vlax-true)
    (vla-put-StyleName vtable tblstyle)
    (repeat (setq i (length lst))
	(setq rows (nth (setq i (1- i)) lst))
	(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
	(repeat (setq j (length rows))
	    (setq lens
		     (cons
			 (+
			     (abs
				 (apply '-
					(mapcar 'car
						(textbox
						    (list
							(cons 1 (setq txt (nth (setq j (1- j)) rows)))
							(cons 40 (vlax-invoke vtable 'GetCellTextHeight i j))
							(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
							)
						    )
						)
					)
				 )
			     (vlax-invoke vtable 'GetCellTextHeight i j)
			     )
			 lens
			 )
		  )
	    (if (eq (strcase (substr txt 1 7)) "<BLOCK>")
		(progn
		    (setq blk (substr txt 8))
		    (if (and
			     (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
			     (vlax-method-applicable-p vtable 'setblocktablerecordid32)
			     )
			 (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
			 (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
			 )
		    )
		(vla-SetText vtable i j txt)
		)
	    )
	(setq totlen (cons lens totlen) lens nil)
	)
    (repeat ncols
	(vla-SetColumnWidth vtable (setq ncols (1- ncols))
	    (apply 'max
		   (vl-remove nil
		       (mapcar
			   '(lambda (x)
				(nth ncols x)
				)
			   totlen
			   )
		       )
		   )
	    )
	)
    (vla-put-RegenerateTableSuppressed vtable :vlax-false)
    vtable
    )
;;;;;- tao text-----------------------------------------------------------------
(DEFUN make_text  (p1 style text chieu_cao goc_quay wid canh_le canh_le1 layer / b e_list FONT)
  (SETQ b (TBLSEARCH "style" style))
  (IF (NULL b)
    (SETQ style (GETVAR "TEXTSTYLE")))

  (SETQ e_list nil)
  (IF (= canh_le 0)

    (SETQ e_list (LIST (CONS 0 "TEXT")
                       (CONS 100 "AcDbEntity")
                       (CONS 8 layer)
                       (CONS 100 "AcDbText")
                       (cons 10 p1)
                       (CONS 40 chieu_cao)
                       (CONS 1 text)
                       (CONS 50 goc_quay)
                       (CONS 41 wid)
                       (CONS 7 style)
                       (CONS 72 canh_le)
                       (LIST 11 0.0 0.0 0.0)
                       (CONS 100 "AcDbText")
                       (CONS 39 0.0)
                       (CONS 73 canh_le1)
                       )) ; then

    (SETQ e_list (LIST (CONS 0 "TEXT")
                       (CONS 100 "AcDbEntity")
                       (CONS 8 layer)
                       (CONS 100 "AcDbText")
                       (cons 10 p1)
                       (CONS 40 chieu_cao)
                       (CONS 1 text)
                       (CONS 50 goc_quay)
                       (CONS 41 wid)
                       (CONS 7 style)
                       (CONS 72 canh_le)
                       (cons 11 p1)
                       (CONS 100 "AcDbText")
                       (CONS 39 0.0)
                       (CONS 73 canh_le1)))
    ) ;endif
  (ENTMAKE e_list)
  )


;;; ham chay
;;;;
(defun c:test( / HTEXT I LS LS1 LS2 MINRAD OB POS RAD SS)
  (setq htext (getreal "\nCao text<0.1>"))
  (if (null htext) (setq htext 0.1))



  



(setq ss (ACET-SS-TO-LIST (ssget '((0 . "CIRCLE")))))
(setq ls (mapcar 'vlax-ename->vla-object ss))
(SETQ LS1 (MAPCAR
            '(LAMBDA (OB) (CONS (vla-get-Radius OB)
                                (vlax-safearray->list(vlax-variant-value(vla-get-Center OB))))) LS
            )
      )
(SETQ LS2 (VL-SORT LS1 '(LAMBDA (A B) (<(CAR A) (CAR B)) )))
(SETQ minrad (car (car ls2))
      i 65
      toado (list (list "Thong ke cac Lo") (list "Ky hieu" "Duong kinh" "X" "Y"))
      )

(foreach n ls2
  (progn
  (setq rad (car n)
        pos (cdr n))
  (if (> rad minrad)
    (setq i (1+ i)
          minrad rad)
    )
  (make_text pos "Standards" (chr i) htext 0 1 1 2 "text")
  (setq nls (list
              (chr i) (rtos rad 2 3) (rtos (car pos) 2 3) (rtos (cadr pos) 2 3)
                                    ))
  (setq toado (append toado (list nls)))
  )
  )



  (setq doc (vla-get-activedocument (vlax-get-acad-object))
         space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
   )
   ; don't run the function unless a point is acutally selected
   (if (setq pt1 (getpoint "\nSelect Insertion Point: "))
      (JH:list-to-table space toado pt1 "Standard")
   )
  )

 

  • Like 1
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nam2604    1

Nam2604
Đã đăng
2 giờ trước, cuongtk2 đã nói:

Của bạn đây 


;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;;	=> if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;;	=> e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use


(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
    (setq ncols (apply 'max (mapcar 'length lst))
	  vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
	  )
    (vla-put-RegenerateTableSuppressed vtable :vlax-true)
    (vla-put-StyleName vtable tblstyle)
    (repeat (setq i (length lst))
	(setq rows (nth (setq i (1- i)) lst))
	(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
	(repeat (setq j (length rows))
	    (setq lens
		     (cons
			 (+
			     (abs
				 (apply '-
					(mapcar 'car
						(textbox
						    (list
							(cons 1 (setq txt (nth (setq j (1- j)) rows)))
							(cons 40 (vlax-invoke vtable 'GetCellTextHeight i j))
							(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
							)
						    )
						)
					)
				 )
			     (vlax-invoke vtable 'GetCellTextHeight i j)
			     )
			 lens
			 )
		  )
	    (if (eq (strcase (substr txt 1 7)) "<BLOCK>")
		(progn
		    (setq blk (substr txt 8))
		    (if (and
			     (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
			     (vlax-method-applicable-p vtable 'setblocktablerecordid32)
			     )
			 (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
			 (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
			 )
		    )
		(vla-SetText vtable i j txt)
		)
	    )
	(setq totlen (cons lens totlen) lens nil)
	)
    (repeat ncols
	(vla-SetColumnWidth vtable (setq ncols (1- ncols))
	    (apply 'max
		   (vl-remove nil
		       (mapcar
			   '(lambda (x)
				(nth ncols x)
				)
			   totlen
			   )
		       )
		   )
	    )
	)
    (vla-put-RegenerateTableSuppressed vtable :vlax-false)
    vtable
    )
;;;;;- tao text-----------------------------------------------------------------
(DEFUN make_text  (p1 style text chieu_cao goc_quay wid canh_le canh_le1 layer / b e_list FONT)
  (SETQ b (TBLSEARCH "style" style))
  (IF (NULL b)
    (SETQ style (GETVAR "TEXTSTYLE")))

  (SETQ e_list nil)
  (IF (= canh_le 0)

    (SETQ e_list (LIST (CONS 0 "TEXT")
                       (CONS 100 "AcDbEntity")
                       (CONS 8 layer)
                       (CONS 100 "AcDbText")
                       (cons 10 p1)
                       (CONS 40 chieu_cao)
                       (CONS 1 text)
                       (CONS 50 goc_quay)
                       (CONS 41 wid)
                       (CONS 7 style)
                       (CONS 72 canh_le)
                       (LIST 11 0.0 0.0 0.0)
                       (CONS 100 "AcDbText")
                       (CONS 39 0.0)
                       (CONS 73 canh_le1)
                       )) ; then

    (SETQ e_list (LIST (CONS 0 "TEXT")
                       (CONS 100 "AcDbEntity")
                       (CONS 8 layer)
                       (CONS 100 "AcDbText")
                       (cons 10 p1)
                       (CONS 40 chieu_cao)
                       (CONS 1 text)
                       (CONS 50 goc_quay)
                       (CONS 41 wid)
                       (CONS 7 style)
                       (CONS 72 canh_le)
                       (cons 11 p1)
                       (CONS 100 "AcDbText")
                       (CONS 39 0.0)
                       (CONS 73 canh_le1)))
    ) ;endif
  (ENTMAKE e_list)
  )


;;; ham chay
;;;;
(defun c:test( / HTEXT I LS LS1 LS2 MINRAD OB POS RAD SS)
  (setq htext (getreal "\nCao text<0.1>"))
  (if (null htext) (setq htext 0.1))



  



(setq ss (ACET-SS-TO-LIST (ssget '((0 . "CIRCLE")))))
(setq ls (mapcar 'vlax-ename->vla-object ss))
(SETQ LS1 (MAPCAR
            '(LAMBDA (OB) (CONS (vla-get-Radius OB)
                                (vlax-safearray->list(vlax-variant-value(vla-get-Center OB))))) LS
            )
      )
(SETQ LS2 (VL-SORT LS1 '(LAMBDA (A B) (<(CAR A) (CAR B)) )))
(SETQ minrad (car (car ls2))
      i 65
      toado (list (list "Thong ke cac Lo") (list "Ky hieu" "Duong kinh" "X" "Y"))
      )

(foreach n ls2
  (progn
  (setq rad (car n)
        pos (cdr n))
  (if (> rad minrad)
    (setq i (1+ i)
          minrad rad)
    )
  (make_text pos "Standards" (chr i) htext 0 1 1 2 "text")
  (setq nls (list
              (chr i) (rtos rad 2 3) (rtos (car pos) 2 3) (rtos (cadr pos) 2 3)
                                    ))
  (setq toado (append toado (list nls)))
  )
  )



  (setq doc (vla-get-activedocument (vlax-get-acad-object))
         space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
   )
   ; don't run the function unless a point is acutally selected
   (if (setq pt1 (getpoint "\nSelect Insertion Point: "))
      (JH:list-to-table space toado pt1 "Standard")
   )
  )
  
    

 

em cảm ơn bác, bác có thể cải tiến thêm phần ghi chữ trực tiếp vào đường tròn như ảnh kia được không ạ.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×