Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
whatcholingon

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

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

Ở đâ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.841

Ở đâ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

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

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

Ở đâ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  

×