Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa]: Lisp ghi kích thước


  • Please log in to reply
27 replies to this topic

#21 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 September 2012 - 09:24 PM


(defun c:dkt(/ a lst p e kc)(vl-load-com)
(setq a (car(entsel "\nChon Pline :")) lst (acet-geom-vertex-list a) p (getpoint "\nHuong dat dim :")
kc 0.01)
(command "offset" kc a p "")
(setq e (entlast))
(mapcar '(lambda(x y)(command "dimaligned" "_non" x "_non" y "_non"
(vlax-curve-getClosestPointTo e (mapcar '(lambda (x y) (* (+ x y) 0.5)) x y) T))) (cdr lst) lst)
(if e (entdel e))
(princ)
)
Bạn tự sửa số kc 0.01 thành số nào cho phù hợp thì sửa, hoặc để yên cũng được :)
nhưng tuyệt đối k được để bằng 0, vì lisp phải dùng lệnh offset để định hướng "trong" hay "ngoài" (lỗi CAD nó báo bên trên, bạn chú ý đọc)
  • 1

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


#22 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 04 September 2012 - 09:32 PM

có thể bác Tue_NV bận khổng thể giải quyết được việc của em, có anh nào trên diễn đàn có thể giúp em với! cảm ơn các anh rất nhiều.
nội dung em cần:
gõ lệnh KT2 -> chọn đường cần đo -> chọn hướng đặt kthuoc ( trong hoặc ngoài khung kín được tạo bằng đường Poline) vậy là xong.

Nội dung của bạn cần đây :

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc gocss)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))

)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))

)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ent (car(entsel "\n Pick Chon LINE, PLINE :")))
(Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos *kc* 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nPick huong dat dim :"))
(setq i 0 el (entlast))
(setq Lpoints (Tue-ent-Lpoint ent))
(if (> kc 0.0) (vl-cmdf "offset" kc ent d4 "e")
(entmakex (entget ent))
)
(if (null (eq el (entlast))) (progn
(setq Lpoints-o (Tue-ent-Lpoint (entlast)))
(entdel (entlast))
(Repeat (1- (length Lpoints))
(setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
d3 (nth i Lpoints-o)
)
(command "dimaligned" d1 d2 d3)
(setq i (1+ i))
)
) (alert "\n Khong dim duoc vi khoang cach qua lon"))
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)

  • 1

#23 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 05 September 2012 - 03:32 AM

Nội dung của bạn cần đây :


(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc gocss)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))

)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))

)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ent (car(entsel "\n Pick Chon LINE, PLINE :")))
(Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos *kc* 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nPick huong dat dim :"))
(setq i 0 el (entlast))
(setq Lpoints (Tue-ent-Lpoint ent))
(if (> kc 0.0) (vl-cmdf "offset" kc ent d4 "e")
(entmakex (entget ent))
)
(if (null (eq el (entlast))) (progn
(setq Lpoints-o (Tue-ent-Lpoint (entlast)))
(entdel (entlast))
(Repeat (1- (length Lpoints))
(setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
d3 (nth i Lpoints-o)
)
(command "dimaligned" d1 d2 d3)
(setq i (1+ i))
)
) (alert "\n Khong dim duoc vi khoang cach qua lon"))
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)


em dùng đoạn code mới của anh thì gặp 1 chút sự cố như sau:
không chọn được Line (muốn chọn được Line để ghi kthuoc, còn trọn hướng cần ghi của Line khó quá thì không cần hướng)
nhập khoảng cách ghi kthuoc (để mặc định là 0 và không hỏi lại lần sau!)
pick hướng cần ghi kthuoc không đúng hướng đối với đường Poline khép kín!
đây là hình của em:Hình đã gửi

đây là file bản vẽ :
http://www.cadviet.c...04547_banve.dwg
  • 0

#24 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 September 2012 - 06:25 AM

đây là file bản vẽ : http://www.cadviet.c...04547_banve.dwg

Code đây bạn :

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc dl dxf11 )
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
dvg
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))

)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ent (car(entsel "\n Pick Chon LINE, PLINE :")))
(Progn
(or *kc* (setq *kc* 0))
(setq kc (getreal (strcat "\nNhap khoang cach <" (rtos *kc* 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nPick huong dat dim :"))
(setq i 0 el (entlast))
(setq Lpoints (Tue-ent-Lpoint ent))
(if (> kc 0.0) (vl-cmdf "offset" kc ent d4 "e")
(entmakex (entget ent))
)
(if (null (eq el (entlast))) (progn
(setq Lpoints-o (Tue-ent-Lpoint (entlast)))
(entdel (entlast))
(Repeat (1- (length Lpoints))
(setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
d3 (nth i Lpoints-o)
)
(command "dimaligned" d1 d2 d3)(setq dl (entlast))
(setq dxf11 (cdr(assoc 11 (entget (entlast)))))
(setq dvg (inters (polar dxf11 (+ (angle d1 d2) (/ pi 2.0)) 5.0) dxf11 d1 d2 nil))
(if (null (zerop
(rem (length
(vlax-invoke (vlax-ename->vla-object (entmakex (list (cons 0 "LINE")
(cons 10 dxf11)
(cons 11 d4))))
'intersectwith (vlax-ename->vla-object ent) 0)
)
2)))
(command "dimtedit" dl (polar dvg (angle dxf11 dvg) (* (getvar "dimgap") 2.0)) )

)
(entdel (entlast))
(setq i (1+ i))
)
) (alert "\n Khong dim duoc vi khoang cach qua lon"))
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)

  • 1

#25 tien2005

tien2005

    biết lệnh properties

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

Đã gửi 05 September 2012 - 10:29 AM


đây là file bản vẽ :
http://www.cadviet.c...04547_banve.dwg


Đây code của Bạn theo như yêu cầu:
Bạn chỉ cần 2 bước thực hiện: chọn đối tượng và pick điểm bên trong hay ngoài (trái, phải)
Lưu ý: vị trí đặt text của dim cách đối tượng 1 khoảng bằng chiều cao text của dim mặc định. Muốn thay đổi k/c này thì Bạn thay giá trị màu xanh là được
(setq kc (* 1 (cdr (assoc 140 (tblsearch "DIMSTYLE" (getvar "dimstyle"))))))

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(vl-load-com)
(command "_.undo" "_begin")
(setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)
) ; Get Old values
(mapcar 'setvar vl '(0 0 0))
(princ "\nChon duong thang can ghi kich thuoc : ")
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
(Progn

(setq kc (* 1 (cdr (assoc 140 (tblsearch "DIMSTYLE" (getvar "dimstyle"))))));k/cach bang chieu cao text cua DIM mac dinh
(setq d4 (getpoint "\nHuong dat kich thuoc ? ") )
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(command "_.offset" kc ent d4 "")
(setq d5 (Tue-ent-Lpoint (entlast)))
(entdel (entlast))
(setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
(setq d1 (nth i Lpoints)
d2 (nth (1+ i) Lpoints)
)
(command "dimaligned" d1 d2 d2)
(setq dl (entget(entlast)))
(setq d11 (cdr(assoc 11 dl))
d11n (inters d11 (polar d11 (+ (angle d1 d2) (/ pi 2.0)) kc) (nth i d5) (nth (1+ i) d5) nil)
)
(command "dimtedit" (entlast) d11n )
(setq i (1+ i))
)
)
)
)
(mapcar 'setvar vl ov) ; reset Sys Vars
(command "_.undo" "_end")
(princ)
)

  • 0

#26 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 05 September 2012 - 03:16 PM

cảm ơn 3 anh nhiều nhé vì cả 3 đều giải được bài toán mà từ lâu em đang cần. trân thành cảm ơn các anh!
  • 0

#27 PrettyBoy_231988

PrettyBoy_231988

    biết zoom

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

Đã gửi 09 August 2013 - 03:29 PM

Hi ! các bác

Em thấy kt2.lisp rất hay. các bác có thể viết thêm là nó ghi kích thước của những đường cong và đường tròn nữa được không

Thank !


  • 0

#28 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 09 September 2013 - 10:07 PM

Em có cái lisp ghi kích thước sưu tầm được của 1 bác trên diễn đàn. Xin các bác giúp em chỉnh sửa lisp này để có thể chọn đường thằng cần ghi kích thước theo một layer nào đó. Thanks!

 

;----kich thuoc duong thang --------
(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc)
  (vl-load-com)
  (command "_.undo" "_begin")
  (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
	ov (mapcar 'getvar vl))   		; Get Old values
  (mapcar 'setvar vl '(0 0 0))
  (princ "\nChon duong thang can ghi kich thuoc : ")
  (if (and
(setq ss (ssget (list (cons 0 "LINE")) ))
(setq kc (getdist "\nNhap khoang cach : "))
(setq d4 (getpoint "\nHuong dat kich thuoc ? ") ) )
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq d1 (vlax-curve-getStartPoint ent)
  d2 (vlax-curve-getEndPoint ent)
  d5 (vlax-curve-getClosestPointTo ent d4 T)
  d3 (polar d5 (angle d5 d4) kc))
   (command "dimaligned" d1 d2 d3)
   )
)
  (mapcar 'setvar vl ov) ; reset Sys Vars
  (command "_.undo" "_end")
  (princ)
  )
 

hihi chào các bác, e thấy lisp trên khá hay nhưng chỉ dùng để đo đoạn thẳng nên bị hạn chế rất nhiều, em muốn nhờ các bác giúp chỉnh sửa lisp này thành như sau: dim khoảng cách giữa 2 điểm A, B bất kì

1) Chia ra 2 lệnh: KT1 = dimlinear, KT2= dimAlign

2) Em muốn pick điểm A, rồi điểm B

3) Mặc định đường dim cách điểm A là 700 (khi dimlinear 1 đường chéo) ,chỉ cần Chọn hướng đặt, chân dim được cắt bằng( hình minh họa)

thanks các bác trước ^.^112169_screenhunter_001_1.jpg


  • 0