Đế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

#1 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 - 10:33 AM

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.c...8_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!
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 11:00 AM

Yêu cầu làm tất cả 1 phát hay làm từng cặp 2 block 1 đây bạn ??
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 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 - 11:11 AM

Yêu cầu làm tất cả 1 phát hay làm từng cặp 2 block 1 đây bạn ??

tất cả 1 phát lun bạn,hihi
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 11:13 AM

À 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 ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 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 - 11:21 AM

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

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 11:24 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 11:52 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 20 December 2011 - 11:52 AM

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

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


#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 12:03 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 20 December 2011 - 12:35 PM

Để 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ỉ????
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 12:36 PM

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

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 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 - 01:48 PM

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

#13 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 - 01:49 PM

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

#14 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 - 01:56 PM

Mỗi người đều có cái hay riêng,nếu gom lại thành1 cái hoàn chỉnh thì ok!
  • 0

#15 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 December 2011 - 02:08 PM

:)
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
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#16 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 20 December 2011 - 02:31 PM

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

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


#17 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 - 03:19 PM

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

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 20 December 2011 - 03:37 PM

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.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 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:03 PM

<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 &quot;undo&quot; &quot;be&quot;)</div>
<div>(acet-sysvar-set (list &quot;osmode&quot; 0 &quot;cmdecho&quot; 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 &quot;\n Chon block mau can dim&quot;)))))</div>
<div> pln (vlax-ename-&gt;vla-object (car (entsel &quot;\n Chon polyline dan &quot;)))</div>
<div> h (getreal &quot;\n Nhap khoang cach toi duong dat kich thuoc: &quot;)</div>
<div> ssbl (vl-sort (acet-ss-to-list (ssget (list (cons 0 &quot;insert&quot;) (cons 2 bln))))</div>
<div> '(lambda (x y) (&lt; (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 &quot;dimaligned&quot; p1 p2 (polar p1 (+ (angle p1 p2) (/ pi 2)) h))</div>
<div> )</div>
<div>)</div>
<div>(acet-sysvar-restore)</div>
<div>(command &quot;undo&quot; &quot;e&quot;)</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'.
  • 0

#20 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:28 PM

Mình tìm dc rùi,thanks các bạn.
  • 0