Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp dim các block không thẳng hàng!


  • Please log in to reply
22 replies to this topic

#21 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 20 December 2011 - 04:29 PM

Bác PTB xui quá, lần nào up bài thì CV cũng bị lỗi. Tôi sửa giùm cho bác luôn để giúp bạn Hoavien nhé!
@Hoavien: dùng lisp sửa lỗi của bác ấy xem sao.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=61313
(defun c:dimblk (/ bln pln h ssbl i p1 p2)
(vl-load-com)
(command "undo" "be")
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(defun tamblk ( blken / p1 p2)
(setq p1 (car (acet-ent-geomextents blken))
p2 (cadr (acet-ent-geomextents blken))
pt (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2)
)
pt
)
(setq bln (cdr (assoc 2 (entget (car (entsel "\n Chon block mau can dim")))))
pln (vlax-ename->vla-object (car (entsel "\n Chon polyline dan ")))
h (getreal "\n Nhap khoang cach toi duong dat kich thuoc: ")
ssbl (vl-sort (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 2 bln))))
'(lambda (x y) (> (vlax-curve-getparamatpoint pln (vlax-curve-getclosestpointto pln (cdr (assoc 10 (entget x)))))
(vlax-curve-getparamatpoint pln (vlax-curve-getclosestpointto pln (cdr (assoc 10 (entget y)))))
)
)
)
)
(foreach en ssbl
(setq i (vl-position en ssbl)
p1 (tamblk en)
p2 (if (setq en1 (nth (1+ i) ssbl)) (tamblk en1))
)
(if p2
(command "dimaligned" p1 p2 (polar p1 (+ (angle p1 p2) (/ pi 2)) h))
)
)
(acet-sysvar-restore)
(command "undo" "e")
(princ)
)

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#22 hoavien248

hoavien248

    biết vẽ line

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

Đã gửi 20 December 2011 - 04:47 PM

Bác PTB xui quá, lần nào up bài thì CV cũng bị lỗi. Tôi sửa giùm cho bác luôn để giúp bạn Hoavien nhé!
@Hoavien: dùng lisp sửa lỗi của bác ấy xem sao.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=61313
(defun c:dimblk (/ bln pln h ssbl i p1 p2)
(vl-load-com)
(command "undo" "be")
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(defun tamblk ( blken / p1 p2)
(setq p1 (car (acet-ent-geomextents blken))
p2 (cadr (acet-ent-geomextents blken))
pt (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2)
)
pt
)
(setq bln (cdr (assoc 2 (entget (car (entsel "\n Chon block mau can dim")))))
pln (vlax-ename->vla-object (car (entsel "\n Chon polyline dan ")))
h (getreal "\n Nhap khoang cach toi duong dat kich thuoc: ")
ssbl (vl-sort (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 2 bln))))
'(lambda (x y) (> (vlax-curve-getparamatpoint pln (vlax-curve-getclosestpointto pln (cdr (assoc 10 (entget x)))))
(vlax-curve-getparamatpoint pln (vlax-curve-getclosestpointto pln (cdr (assoc 10 (entget y)))))
)
)
)
)
(foreach en ssbl
(setq i (vl-position en ssbl)
p1 (tamblk en)
p2 (if (setq en1 (nth (1+ i) ssbl)) (tamblk en1))
)
(if p2
(command "dimaligned" p1 p2 (polar p1 (+ (angle p1 p2) (/ pi 2)) h))
)
)
(acet-sysvar-restore)
(command "undo" "e")
(princ)
)

Đúng như ý mình,thanks các bác đã nhiệt tình giúp đỡ,chúc tất cả anh em thành công trong công việc.
  • 0

#23 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 20 December 2011 - 10:04 PM

thanks bạn,mình đánh lệnh rùi pick điểm mà ko dc bạn ơi!bạn xem lại dùm mình nha hay là mình gà wa'.

Hề hề hề,
Cái code box của diễn đàn mấy bữa nay bị sao đó mà lỗi liên tục bạn ạ.
Mình đã sửa lại bài post rồi, bạn chịu khó down lại nhé.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.