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

[Nhờ chỉnh sửa] LISP tạo đường viền cho text

Bởi whatcholingon , trong AutoLisp

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

whatcholingon    45

whatcholingon
Đã đăng

Ở đây mình có lisp tạo đường viền cho text ( không biết tác giả)

ở Lsp này khi đánh lệnh nó chỉ chọn được một text

Mọi người chỉnh giúp mình là chọn được nhiều đối tượng text một lúc không ah.

Đây là lisp đó:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63121&pid=195690&st=0entry195690
;----- Example Calling Function: This example will create an LWPolyline describing the bounding box of the selected object.
(defun c:test ( / e ) (vl-load-com)
 (if (setq e (car (entsel)))
(entmakex
  (append
(list
  	(cons 0 "LWPOLYLINE")
  	(cons 100 "AcDbEntity")
  	(cons 100 "AcDbPolyline")
  	(cons 90 4)
  	(cons 70 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
(mapcar
  	(function
		(lambda ( _functionlist )
  		(mapcar
    		(function
      		(lambda ( _function ) ((eval _function) boundingbox)))
    		_functionlist)))
  '((caar   cadar) (caadr  cadar)
		(caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
(progn
  	(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

 

Thanks!

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

Tue_NV    3.912

Tue_NV
Đã đăng

Ở đây mình có lisp tạo đường viền cho text ( không biết tác giả)

ở Lsp này khi đánh lệnh nó chỉ chọn được một text

Mọi người chỉnh giúp mình là chọn được nhiều đối tượng text một lúc không ah.

Đây là lisp đó:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63121&pid=195690&st=0entry195690
;----- Example Calling Function: This example will create an LWPolyline describing the bounding box of the selected object.
(defun c:test ( / e ) (vl-load-com)
 (if (setq e (car (entsel)))
(entmakex
  (append
(list
  	(cons 0 "LWPOLYLINE")
  	(cons 100 "AcDbEntity")
  	(cons 100 "AcDbPolyline")
  	(cons 90 4)
  	(cons 70 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
(mapcar
  	(function
	(lambda ( _functionlist )
  		(mapcar
			(function
  			(lambda ( _function ) ((eval _function) boundingbox)))
			_functionlist)))
  '((caar   cadar) (caadr  cadar)
	(caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
(progn
  	(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

 

Thanks!

Sửa lại cho bạn đây :

(defun c:test ( / e ss) (vl-load-com)
(setq i -1)
(if (setq ss (ssget '((0 . "*TEXT"))))
(while (setq e (ssname ss (setq i (1+ i))))
(entmakex
  (append
   (list
 	 (cons 0 "LWPOLYLINE")
 	 (cons 100 "AcDbEntity")
 	 (cons 100 "AcDbPolyline")
 	 (cons 90 4)
 	 (cons 70 1))
   (mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e)))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
   (mapcar
 	 (function
	 (lambda ( _functionlist )
 		 (mapcar
		 (function
 			 (lambda ( _function ) ((eval _function) boundingbox)))
		 _functionlist)))
  '((caar   cadar) (caadr  cadar)
	 (caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
   (progn
 	 (vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

  • Vote tăng 3

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

whatcholingon    45

whatcholingon
Đã đăng

Sửa lại cho bạn đây :

(defun c:test ( / e ss) (vl-load-com)
(setq i -1)
(if (setq ss (ssget '((0 . "*TEXT"))))
(while (setq e (ssname ss (setq i (1+ i))))
(entmakex
  (append
   (list
  	(cons 0 "LWPOLYLINE")
  	(cons 100 "AcDbEntity")
  	(cons 100 "AcDbPolyline")
  	(cons 90 4)
  	(cons 70 1))
   (mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e)))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
   (mapcar
  	(function
        (lambda ( _functionlist )
          (mapcar
         (function
 	         (lambda ( _function ) ((eval _function) boundingbox)))
         _functionlist)))
  '((caar   cadar) (caadr  cadar)
        (caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
   (progn
  	(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

 

Thanks ban nhieu!

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

Trà Đá    4

Trà Đá
Đã đăng

Sửa lại cho bạn đây :

(defun c:test ( / e ss) (vl-load-com)
(setq i -1)
(if (setq ss (ssget '((0 . "*TEXT"))))
(while (setq e (ssname ss (setq i (1+ i))))
(entmakex
  (append
   (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 1))
   (mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e)))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
   (mapcar
      (function
     (lambda ( _functionlist )
 	     (mapcar
	     (function
 		     (lambda ( _function ) ((eval _function) boundingbox)))
	     _functionlist)))
  '((caar   cadar) (caadr  cadar)
     (caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
   (progn
      (vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

Em muốn lisp thêm một dòng lệnh cho phép hỏi : Hình bao đường viền là hình Elip, Hình tròn , hình chữ nhật , hình đa giác và thực hiện các chức năng trên đượ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

gia_bach    1.551

gia_bach
Đã đăng

Ở đây mình có lisp tạo đường viền cho text ( không biết tác giả)

ở Lsp này khi đánh lệnh nó chỉ chọn được một text

Mọi người chỉnh giúp mình là chọn được nhiều đối tượng text một lúc không ah.

Đây là lisp đó:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63121&pid=195690&st=0entry195690
;----- Example Calling Function: This example will create an LWPolyline describing the bounding box of the selected object.
(defun c:test ( / e ) (vl-load-com)
 (if (setq e (car (entsel)))
(entmakex
  (append
(list
  	(cons 0 "LWPOLYLINE")
  	(cons 100 "AcDbEntity")
  	(cons 100 "AcDbPolyline")
  	(cons 90 4)
  	(cons 70 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
(mapcar
  	(function
	(lambda ( _functionlist )
  		(mapcar
			(function
  			(lambda ( _function ) ((eval _function) boundingbox)))
			_functionlist)))
  '((caar   cadar) (caadr  cadar)
	(caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
(progn
  	(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

 

Thanks!

Lisp này chỉ dùng cho các Text nằm ngang hoặc thẳng đứng, với các Text nằm xiên đuờng viền không xiên theo phuơng của Text. (nhưng có lẽ đã đáp ứng đuợc yêu cầu của chủ topic).

 

gợi ý : nếu dùng hàm textbox thì đuờng viền sẽ theo phuơng của Text.

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
×