Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 23 May 2012 - 12:07 AM

Ở đâ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=0&#entry195690
;----- 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!
  • 0

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 23 May 2012 - 07:48 AM

Ở đâ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=0&#entry195690
;----- 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))))))

  • 3

#3 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 23 May 2012 - 08:35 AM

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!
  • 0

#4 Trà Đá

Trà Đá

    biết vẽ line

  • Members
  • PipPip
  • 27 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 04 June 2012 - 10:34 AM

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 ạ?
  • 0

#5 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 04 June 2012 - 12:15 PM

Ở đâ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=0&#entry195690
;----- 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.
  • 0