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  
hoavien248

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

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

hoavien248    3

Hiện tại mình đang vẽ bản vẽ cây xanh và gặp vần đề về dim (khoảng cách giũa 2 cây với nhau từ tâm),các đối tượng block nằm không thẳng hàng,dim từng cái thì không biết khi nào mới xong,các bác viết cho em lisp nhé!

http://www.cadviet.com/upfiles/3/10458_cayxanh_2.dwg

-Chọn các đối tượng cần dim

-Chọn khoảng cách từ đối tượng đến đường dim,hoặc click vào 1 điểm bất kỳ.

1 phát ra hết các đường dim nha các bạn.

Thanks các bác đọc tin!

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
ketxu    2.652

À thật ra thì mình hỏi cho vui vậy thôi, chứ block bạn không sắp xếp theo quy luật nào cả, làm sao lisp nó biết dim từ thằng nào đến thằng nào ? (theo x, theo y, hay theo x,y, hay theo kcach gần nhất...)

Còn chưa kể bạn nói chọn điểm đặt, thì cái điểm đặt đâu có cố định cho từng dim??

Làm 1 phát hết k thể tránh khỏi nhầm lẫn, hoặc cái Dim xoay chẳng ra sao, bạn lại phải mần lại còn quá tội ^^

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
hoavien248    3

À thật ra thì mình hỏi cho vui vậy thôi, chứ block bạn không sắp xếp theo quy luật nào cả, làm sao lisp nó biết dim từ thằng nào đến thằng nào ? (theo x, theo y, hay theo x,y, hay theo kcach gần nhất...)

Còn chưa kể bạn nói chọn điểm đặt, thì cái điểm đặt đâu có cố định cho từng dim??

Làm 1 phát hết k thể tránh khỏi nhầm lẫn, hoặc cái Dim xoay chẳng ra sao, bạn lại phải mần lại còn quá tội ^^

vậy là phải có đường dẫn đi qua trọng tân các block ko bạn? lisp mấy lệnh cũng được miễn sao là nhanh hơn cách thủ công là được rùi bác ah!

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
ketxu    2.652

Ví dụ 1 : Theo quy luật trái -> phải

Quick code, k bắt lỗi,không khử biến, vì mình vội quá rồi. Bạn hãy làm từng khoảng 1, khi mà quy luật trái -> phải vẫn đúng với mong muốn của bạn

(defun c:test ()
(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(defun ST:SS->List-Vla (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
 )
)
(defun CV:Geom-Midpoint (p1 p2 )(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(defun block_base (block)(vlax-get block 'InsertionPoint))
(setq ss (vl-sort (ST:SS->List-Vla(ssget (list (cons 0 "INSERT")(cons 2 "BT 06")))) '(lambda(x y)(< (car (block_base x))(car (block_base y))))))
(setq obj (car ss) obj1 (cadr ss) disBase (distance (setq p1 (block_base obj)) (setq p2 (block_base obj1))) p (CV:Geom-Midpoint p1 p2))
(setq uv (mapcar '- (getpoint p "\nDiem dat text : ") p) i 0 3d vlax-3d-point)
(repeat (length ss)
(setq obj (nth i ss) obj1 (nth (setq i (1+ i)) ss) p1 (block_base obj) p2 (block_base obj1) p (CV:Geom-Midpoint p1 p2) p (mapcar '+ p uv))
(vla-AddDimAligned mspace (3d p1)(3d p2) (3d p))
)
)

Ngoài ra bạn tự sửa "BT 06" thành tên gì đó khác theo tên Block bạn xử lý

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
Doan Van Ha    2.677

Thử cái này xem. Có gì y/c sẽ sửa lại. Code nhanh nên thông cảm.

;Doan Van Ha - CADViet.com - Ngay 20/12/2011
;Muc dich: Dim lien tuc tung cap Block.
(defun C:HA( / ss1 p1 name ss entlst i)
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(while (not (progn (princ "\rChon Block dau hoac cuoi cua day cac Block de lam Block mau...") (setq ss1 (ssget ":s" '((0 . "INSERT")))))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq name (cdr (assoc 2 (entget (ssname ss1 0)))))
(princ "\nChon cac Block nam tren day...")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2  name))))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq entlst (vl-sort entlst '(lambda (e1 e2) (< (distance p1 (cdr (assoc 10 (entget e1)))) (distance p1 (cdr (assoc 10 (entget e2))))))))
(setq i 0)
(repeat (- (length entlst) 1)
 (command "dim" "ali" (cdr (assoc 10 (entget (nth i entlst))))
                                     	(cdr (assoc 10 (entget (nth (1+ i) entlst))))
                                     	(polar (cdr (assoc 10 (entget (nth i entlst))))
                                                	(+ (/ pi 2) (angle (cdr (assoc 10 (entget (nth i entlst))))
                                                                              	(cdr (assoc 10 (entget (nth (1+ i) entlst))))))
                                                	10) "" "e")
 (setq i (+ 1 i)))
(KET_THUC)
(princ))
(defun BAT_DAU()
(vl-load-com)
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

  • Vote tăng 2

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
ketxu    2.652

Sử dụng vl-sort theo distance ngay sẽ không ổn trong trường hợp cái dãy nó... quay lại gần block bắt đầu

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
phamthanhbinh    3.123

Để mình nghĩ phương án!

Hề hề hề,

Phương án không phải là không có, song không biết có đúng ý chủ thớt hay không thôi bác ạ. Mình thấy trên bản vẽ này thì cái cây xanh chỉ là block phụ còn cái chính cần uýnh dim lại là cái block CM1.

Bởi thế nếu có thể vẽ trước một polyline theo cái hướng mà chủ thớt muốn đim thông qua các insert point của các block này thì chuyện còn lại sẽ không quá khó. Tuy nhiên cũng phải lưu ý tới cái dim kẻo mà text nó lộn tu thôi bác ạ.

Việc vẽ cái polyline nếu chủ thớt cho cái quy luật xác định thì sẽ không quá khó. song nếu không có quy luật thì việc vẽ sẽ hơi khoai.

Vậy nên để chờ ý kiến chủ thớt coi sao đã bác hỉ????

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
ketxu    2.652

Ví dụ 2, sử dụng Angbase + duyệt Block gần nhau. Với cái này bạn có thể chọn hết Block loại BT 06 và thử sẽ thaaysDim chạy vòng ntn

(defun c:test (/ ss estart dump i ang dis pt mspace p1 p2 tmp)
(grtext -1 "Free lisp from CadViet @Ketxu")
(defun ST:Ent-Dxf (dxfCode Ent)(if (= (type Ent) 'ENAME)(cdr (assoc dxfCode (entget Ent))) nil))
(defun ST:Ss->ListBasePoint (ss / n l)
;31-7-2011 @Ketxu
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (ST:Ent-Dxf 10 e) l))
 )
)
(defun ST:List-Sort-ByDistance (lst start / lstRT 1st item lstDis tmp)
;31-7-2011 @Ketxu
(setq 1st (nth start lst) lstRT (list 1st) lst (append lstRT (vl-remove 1st lst)))
(while (> (length lst) 1)
(setq lst (vl-remove (setq item (nth (1+ (vl-position (setq mindis (apply 'min (setq lstDis (cdr (mapcar '(lambda(x) (distance 1st x)) lst))))) lstDis)) lst)) lst))
(setq lstRT (cons item lstRt))
(setq 1st (car lstRT))
)
(reverse lstRT)
)
(defun CV:Geom-Midpoint (p1 p2 )(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(setvar "nomutt" 1)(prompt "Ch\U+1ECDn c\U+00E1c Block mu\U+1ED1n k\U+1EBB Pline :")
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 "BT 06")))
   	dump (setvar "nomutt" 0)
   	estart (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EA7u :"))
   	)
(setq lstPnt (ST:List-Sort-ByDistance
   	(setq tmp (ST:Ss->ListBasePoint ss))
   	(vl-position (ST:Ent-Dxf 10 estart) tmp)
))
(setq p1 (car lstPnt) p2 (cadr lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))
(setq pt (getpoint mid "\nPoint to Put text :" ) ang (angle mid pt) dis (distance mid pt) i 0)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 3d vlax-3d-point)
(repeat (1- (length lstPnt))
(setq p1 (nth i lstPnt) p2 (nth (setq i (1+ i)) lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))(setq p (polar mid ang dis))
(vla-AddDimAligned mspace (3d p1)(3d p2) (3d p))
)
(setvar "ANGBASE" 0)
)

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
hoavien248    3

Thử cái này xem. Có gì y/c sẽ sửa lại. Code nhanh nên thông cảm.

;Doan Van Ha - CADViet.com - Ngay 20/12/2011
;Muc dich: Dim lien tuc tung cap Block.
(defun C:HA( / ss1 p1 name ss entlst i)
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(while (not (progn (princ "\rChon Block dau hoac cuoi cua day cac Block de lam Block mau...") (setq ss1 (ssget ":s" '((0 . "INSERT")))))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq name (cdr (assoc 2 (entget (ssname ss1 0)))))
(princ "\nChon cac Block nam tren day...")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2  name))))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq entlst (vl-sort entlst '(lambda (e1 e2) (< (distance p1 (cdr (assoc 10 (entget e1)))) (distance p1 (cdr (assoc 10 (entget e2))))))))
(setq i 0)
(repeat (- (length entlst) 1)
 (command "dim" "ali" (cdr (assoc 10 (entget (nth i entlst))))
                                     	(cdr (assoc 10 (entget (nth (1+ i) entlst))))
                                     	(polar (cdr (assoc 10 (entget (nth i entlst))))
                                            		(+ (/ pi 2) (angle (cdr (assoc 10 (entget (nth i entlst))))
                                                                          		(cdr (assoc 10 (entget (nth (1+ i) entlst))))))
                                            		10) "" "e")
 (setq i (+ 1 i)))
(KET_THUC)
(princ))
(defun BAT_DAU()
(vl-load-com)
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

Mình upload lại file có đường dẫn rùi bác,lisp bác tạm ok vì chọn đối tượng lần 1 ko được,phải chọn 2 lần!thanks 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
hoavien248    3

Ví dụ 2, sử dụng Angbase + duyệt Block gần nhau. Với cái này bạn có thể chọn hết Block loại BT 06 và thử sẽ thaaysDim chạy vòng ntn

(defun c:test (/ ss estart dump i ang dis pt mspace p1 p2 tmp)
(grtext -1 "Free lisp from CadViet @Ketxu")
(defun ST:Ent-Dxf (dxfCode Ent)(if (= (type Ent) 'ENAME)(cdr (assoc dxfCode (entget Ent))) nil))
(defun ST:Ss->ListBasePoint (ss / n l)
;31-7-2011 @Ketxu
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (ST:Ent-Dxf 10 e) l))
 )
)
(defun ST:List-Sort-ByDistance (lst start / lstRT 1st item lstDis tmp)
;31-7-2011 @Ketxu
(setq 1st (nth start lst) lstRT (list 1st) lst (append lstRT (vl-remove 1st lst)))
(while (> (length lst) 1)
(setq lst (vl-remove (setq item (nth (1+ (vl-position (setq mindis (apply 'min (setq lstDis (cdr (mapcar '(lambda(x) (distance 1st x)) lst))))) lstDis)) lst)) lst))
(setq lstRT (cons item lstRt))
(setq 1st (car lstRT))
)
(reverse lstRT)
)
(defun CV:Geom-Midpoint (p1 p2 )(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(setvar "nomutt" 1)(prompt "Ch\U+1ECDn c\U+00E1c Block mu\U+1ED1n k\U+1EBB Pline :")
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 "BT 06")))
   	dump (setvar "nomutt" 0)
   	estart (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EA7u :"))
   	)
(setq lstPnt (ST:List-Sort-ByDistance
   	(setq tmp (ST:Ss->ListBasePoint ss))
   	(vl-position (ST:Ent-Dxf 10 estart) tmp)
))
(setq p1 (car lstPnt) p2 (cadr lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))
(setq pt (getpoint mid "\nPoint to Put text :" ) ang (angle mid pt) dis (distance mid pt) i 0)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 3d vlax-3d-point)
(repeat (1- (length lstPnt))
(setq p1 (nth i lstPnt) p2 (nth (setq i (1+ i)) lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))(setq p (polar mid ang dis))
(vla-AddDimAligned mspace (3d p1)(3d p2) (3d p))
)
(setvar "ANGBASE" 0)
)

Mình upload lại file có đường dẫn rùi bác,lisp của bác ra 1 phát rùi đó,nhưng mà đường dim nó không về 1 phía bác ah!thanks bác

cái thứ 1 làm tửng đoạn nhỏ bác ah thì ok

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
ketxu    2.652

:)

Mất đến mấy bài mới hiểu bạn nói j. Thank thì bạn nhấn Like This là được r

Hướng mình đưa ra như vậy thôi, hoàn hảo theo ý bạn thì cố gắng sử dụng cho mềm dẻo, hoặc bạn chờ mọi người fix th.

Tốt nhất đừng làm cả 1 đoạn ngoằn nghèo đủ hướng dễ gây hiểu lầm của Lisp

Yêu cầu nằm cùng về 1 hướng bị bỏ qua do k nằm trong yêu cầu và cũng k hiểu định nghĩa hướng của bạn là ntn.( bạn đọc lại các bài yêu cầu của mình nhé :) )

Ngoài ra trên diễn đàn mình có viết 1 lisp kẻ Pline nối các đỉnh Block theo thứ tự đầu -> cuối, cũng đã có lisp dim toàn bộ các cạnh của 1 Pline. Nếu bạn search thì có lẽ đã không cần topic này

  • Vote tăng 2

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
Doan Van Ha    2.677

Bạn Hoavien248 ạ!

Thiết nghĩ, nếu thẳng thừng ra thì không ai code cho bạn đâu. Bạn ra 1 đề toán nhưng thiếu rất nhiều dữ liệu. Tôi và Ketxu, hoặc ai nữa, chỉ viết theo nhận định dựa vào bản vẽ bạn post, vì vậy mà không thể nào đáp ứng những y/c mà sau khi đã giải toán rồi thì bạn mới chịu nêu lên.

Riêng với lisp của tôi, nếu chỉ vì chọn đến những... 2 lần mà bạn mệt mõi, thì tôi cũng mệt mõi với bạn luôn. Hơn nữa, định có vài khuyến cáo khi sử dụng lisp để tránh nhầm lẫn, nhưng bạn đã không thích thì thôi vậy.

Hy vọng sẽ có ai đó giúp bạn có 1 cái lisp thật vạn năng! Bởi tôi rất ngại viết lisp kiểu vạn nă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
hoavien248    3

Bạn Hoavien248 ạ!

Thiết nghĩ, nếu thẳng thừng ra thì không ai code cho bạn đâu. Bạn ra 1 đề toán nhưng thiếu rất nhiều dữ liệu. Tôi và Ketxu, hoặc ai nữa, chỉ viết theo nhận định dựa vào bản vẽ bạn post, vì vậy mà không thể nào đáp ứng những y/c mà sau khi đã giải toán rồi thì bạn mới chịu nêu lên.

Riêng với lisp của tôi, nếu chỉ vì chọn đến những... 2 lần mà bạn mệt mõi, thì tôi cũng mệt mõi với bạn luôn. Hơn nữa, định có vài khuyến cáo khi sử dụng lisp để tránh nhầm lẫn, nhưng bạn đã không thích thì thôi vậy.

Hy vọng sẽ có ai đó giúp bạn có 1 cái lisp thật vạn năng! Bởi tôi rất ngại viết lisp kiểu vạn năng.

 

Mình cám ơn các bác đã viết dùm,mình ko hiểu nhiều về lisp và cũng ko hiểu hết các yêu cầu của lisp,các bác thông cảm.

Riêng lisp của bạn Doan Van Ha thì mình thử sao mình nói vậy thui,đồng ý là mình ko biết nêu lên các yêu cầu sao cho các bác viết hoàn hảo,nhưng mình ko nói đến mệt mõi nha bác với lại bác có lời khuyên gì đến tôi đâu mà nói tôi không thích!Có vè bác không tôn trọng lắm những người ko hiểu lisp rành như 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
phamthanhbinh    3.123
Mình upload lại file có đường dẫn rùi bác,lisp của bác ra 1 phát rùi đó,nhưng mà đường dim nó không về 1 phía bác ah!thanks bác cái thứ 1 làm tửng đoạn nhỏ bác ah thì ok

Hề hề hề,

Nếu đã có đường dẫn thì bạn thử dùng cái này coi có ổn không nhé.



(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)
)

Chúc bạn vui.

  • Vote tăng 2

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
hoavien248    3

<p></p>

<p>Hề hề hề,</p>

<p>Nếu đã có đường dẫn thì bạn thử dùng cái này coi có ổn kho6ngf nhé.</p>

<p>

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

</div>

<div>Chúc bạn vui.</div>

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

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
Doan Van Ha    2.677

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)
)

  • Vote tăng 2

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
hoavien248    3

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.

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
phamthanhbinh    3.123

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

  • 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

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  

×