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

Tháng 7 24, 2012

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

Tháng 7 24, 2012

Bạn đổi dòng (setq ss (ssget (list (cons 0 "LINE")))) thành 2 dòng sau :

(setq e (car (entsel "\nDoi tuong chua layer mau :")))

(setq ss (ssget (list (cons 0 "LINE")(assoc 8 (entget e) ))))

Tháng 7 28, 2012

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

Bạn đổi dòng (setq ss (ssget (list (cons 0 "LINE")))) thành 2 dòng sau :

Nếu giờ mình muốn:

I. "nhap khoang cach" thành 2 bước

bước 1: "Dim lan <1, 2, 3, 4, 5>: 1"

bước 2: Nếu nhập 1 thì:

Nhap khoang cach <500>: 500 " với 500 là số gợi nhớ

Nếu nhập 2 thì:

Nhap khoang cach <1000>: 1000 " với 1000 là số gợi nhớ

Nếu nhập 3 thì:

Nhap khoang cach <1500>: 1500 " với 1500 là số gợi nhớ

Nếu nhập 4 thì:

Nhap khoang cach <2000>: 2000 " với 2000 là số gợi nhớ

Nếu nhập 5 thì:

Nhap khoang cach <2500>: 2500 " với 2500 là số gợi nhớ

II. Đo Pline thì tự đo từ đỉnh 1 đến đỉnh 2, từ đỉnh 2 đến đỉnh 3,....

(Mình sửa LINE thành *LINE thì đo được Pline rồi, nhưng Lisp đo từ điểm đầu tiên đến điểm cuối cùng mà bỏ qua các điểm đỉnh trung gian thuộc PLINE)

Nhờ Ketxu sửa giúp mình nhé!

Cẳm ơn Ket trước nhé

Tháng 7 28, 2012

@softvnBin : mong bạn đừng chỉ đích danh mình như vậy, sẽ làm yêu cầu của bạn bị lãng quên nhanh hơn

1. Nếu bạn muốn thế thì ta cứ sửa thôi. Thử sửa k được thì lại tính tiếp

2. Chủ đề này đã có tương tự trên 4room rồi bạn nhé ^^

Tháng 7 28, 2012

Hì hì, mình thấy Ketxu trả lời bài trước thì mình nhờ luôn, thật là sơ xuất quá, lần sau mình sẽ rút kinh nghiệm, hì hì.

1. Mình đã sửa hết gần 1 buổi mà chẳng ăn thua gì, chắc tại hơi kém món chế biến :)

2. Mình sẽ google lại xem thế nào, không ăn thua thì nhờ mọi người ra tay giúp đỡ nhé!!!

Tháng 7 29, 2012

Đã hết ngày chủ nhật, vẫn không ăn thua các bác ạ, thôi đành nhờ các bác ra tay trợ giúp!

Tháng 7 29, 2012

Bạn post cái mà bạn sửa n chưa được lên thì dễ tưởng tượng hơn

Tháng 7 30, 2012

Nếu giờ mình muốn: I. "nhap khoang cach" thành 2 bước bước 1: "Dim lan <1, 2, 3, 4, 5>: 1" bước 2: Nếu nhập 1 thì: Nhap khoang cach <500>: 500 " với 500 là số gợi nhớ Nếu nhập 2 thì: Nhap khoang cach <1000>: 1000 " với 1000 là số gợi nhớ Nếu nhập 3 thì: Nhap khoang cach <1500>: 1500 " với 1500 là số gợi nhớ Nếu nhập 4 thì: Nhap khoang cach <2000>: 2000 " với 2000 là số gợi nhớ Nếu nhập 5 thì: Nhap khoang cach <2500>: 2500 " với 2500 là số gợi nhớ II. Đo Pline thì tự đo từ đỉnh 1 đến đỉnh 2, từ đỉnh 2 đến đỉnh 3,.... (Mình sửa LINE thành *LINE thì đo được Pline rồi, nhưng Lisp đo từ điểm đầu tiên đến điểm cuối cùng mà bỏ qua các điểm đỉnh trung gian thuộc PLINE) Nhờ Ketxu sửa giúp mình nhé! Cẳm ơn Ket trước nhé

Code đây bạn

(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
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
 (setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
 (setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
   d3 (polar d1 (+ (/ pi 2.0)(angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0))
 )
  (command "dimaligned" d1 d2 d3)
  (setq i (1+ i))
)
)
)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

Tháng 7 30, 2012

Cảm ơn Tue_NV đã giúp mình nhưng mình thấy có mấy vấn đề sau:

1. Chia khoảng cách nhập Dim thành 2 bước

I. "nhap khoang cach" thành 2 bước

bước 1: "Dim lan <1, 2, 3, 4, 5>: 1"

bước 2: Nếu nhập 1 thì:

Nhap khoang cach <500>: 500 " với 500 là số gợi nhớ

Nếu nhập 2 thì:

Nhap khoang cach <1000>: 1000 " với 1000 là số gợi nhớ

Nếu nhập 3 thì:

Nhap khoang cach <1500>: 1500 " với 1500 là số gợi nhớ

Nếu nhập 4 thì:

Nhap khoang cach <2000>: 2000 " với 2000 là số gợi nhớ

Nếu nhập 5 thì:

Nhap khoang cach <2500>: 2500 " với 2500 là số gợi nhớ

Cái này thì lisp mới đi được 1/3 chặng đường :)

2. Lisp mất chế độ chọn hướng ghi kích thước :(

3. Với *line (cái này quá ổn rồi)

Các bro giúp mình nốt nhé!!!

Tháng 7 30, 2012

Cảm ơn Tue_NV đã giúp mình nhưng mình thấy có mấy vấn đề sau:

1. Chia khoảng cách nhập Dim thành 2 bước

I. "nhap khoang cach" thành 2 bước

bước 1: "Dim lan <1, 2, 3, 4, 5>: 1"

bước 2: Nếu nhập 1 thì:

Nhap khoang cach <500>: 500 " với 500 là số gợi nhớ

Nếu nhập 2 thì:

Nhap khoang cach <1000>: 1000 " với 1000 là số gợi nhớ

Nếu nhập 3 thì:

Nhap khoang cach <1500>: 1500 " với 1500 là số gợi nhớ

Nếu nhập 4 thì:

Nhap khoang cach <2000>: 2000 " với 2000 là số gợi nhớ

Nếu nhập 5 thì:

Nhap khoang cach <2500>: 2500 " với 2500 là số gợi nhớ

Cái này thì lisp mới đi được 1/3 chặng đường :)

2. Lisp mất chế độ chọn hướng ghi kích thước :(

3. Với *line (cái này quá ổn rồi)

Các bro giúp mình nốt nhé!!!

Bổ sung thêm hướng đặt dim

Còn huong dat dim <500>: Nhập 1 thì chương trình hiểu là 500, nhập 2 thì chương trình hiểu là 1000......

Cón các ý khác của bạn bạn tự xử, đã sẵn code của Tue_NV viết cả rồi đấy, xào nấu 1 chút là xong thôi


(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 ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
 (Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nhuong dat dim :"))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
 (setq i 0)
(setq Lpoints (Tue-ent-Lpoint ent))
(setq gocss (angle (car Lpoints) d4))
(while (> gocss pi) (setq gocss (- gocss pi)))
(if (> (angle (car Lpoints) (cadr Lpoints)) gocss) (setq goc (/ pi -2.0)) (setq goc (/ pi 2.0)))
(Repeat (1- (length Lpoints))
 (setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints))
 (setq d3 (polar d1 (+ goc (angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0))
 )
  (command "dimaligned" d1 d2 d3)
  (setq i (1+ i))
)
)
)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

Edit: mã bổ sung hướng đặt dim chưa thật sự tốt. Sẽ sửa sau

Tháng 7 30, 2012

Cảm ơn bạn nhiều, lúc nào có thời gian bạn giúp mình hoàn chỉnh nốt hướng đặt dim nhé, các cái khác mình sẽ mày mò edit :)

Tháng 8 29, 2012

Code đây bạn

(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
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
 (setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
 (setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
   d3 (polar d1 (+ (/ pi 2.0)(angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0))
 )
  (command "dimaligned" d1 d2 d3)
  (setq i (1+ i))
)
)
)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

bác Tue_NV ơi, em nhờ bên phần post bài của em bên kia không được, nhưng em thấy cái này cũng gần giống cái mà em cần. nhờ bác bớt phần hỏi nhập khoảng cách này đi hoặc mặc định là 0 và không hỏi ở dưới dòng command đoạn này được không a! vì em có kích thước mẫu của cơ quan theo quy định chung rồi nên trước khi gõ lệnh KT2 thì em chọn kích thước mẫu trước trên style sau đó thực hiện lệnh là ok. giúp em với nhé, cảm ơn anh nhiều!

sửa đoạn:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))</pre>

thành:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 0) 2 2) "> :" )))</pre>

Tháng 8 31, 2012

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.

Tháng 8 31, 2012

Thật sự không biết các đối tượng Bạn cần dim là pline hở, đa giác lồi lỏm , ... nên xác định hướng đặt dim theo point rất khó. Do đó hướng giải quyết đơn giản và dễ làm là đặt dim bên trái hay phải của đối tượng (theo thứ tự point tạo nên line pline), nếu bên trái chưa đúng thì có thể chọn bên phải :-)

Và đây là code của TUE mình sửa lại . Bạn dùng tạm vậy

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc vec)
 (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
 	(or *kc* (setq *kc* 1))
 	(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
 	(if kc (setq *kc* kc) (setq kc *kc* ))
 	;(setq d4 (getpoint "\nhuong dat dim :"))
 	(initget "T P")
 	(setq vec (getkword"\nDim dat ben trai hay phai [T/P] <T>: "))

 	(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq i 0)
(setq Lpoints (Tue-ent-Lpoint ent))
;(setq gocss (angle (car Lpoints) d4))
; (while (> gocss pi)
;   (setq gocss (- gocss pi))
;   )
; (if (> (angle (car Lpoints) (cadr Lpoints)) gocss) (setq goc (/ pi -2.0)) (setq goc (/ pi 2.0)))
(Repeat (1- (length Lpoints))
  (setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints))
  (setq goc (angle d1 d2))
  (setq d3 (polar d1 (if (= vec "T")(+ goc (* pi 0.5))(- goc (* pi 0.5))) (* kc 500.0)))
  ;(setq d3 (polar d1 (+ goc (angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0)))
  (command "dimaligned" d1 d2 d3)
  (setq i (1+ i))
  )
)
 	)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

Tháng 8 31, 2012

cảm ơn anh rất nhiều, nhưng quả thật yêu cầu của em có lẽ là không thể. vì lô đất là hình bất kỳ, mà em muốn là hướng đặt dim là pick ra ngoài poline đã khép kin hay trong thì dim sẽ ra ngoài hoặc vào trong.

nếu không thể thì có thể giúp em đơn gian hơn là bớt dòng nhắc trong đoạn lisp của bác Tue đoạn nhập khoảng cách dim và hướng đặt dim không cần nữa.

cảm ơn các anh rất nhiều

Tháng 9 4, 2012

có ai biết và có thể giúp được em vấn đề trên với không a? cảm ơn các anh nhiều. em sợ nội dung bị ngủ quên mất!

Tháng 9 4, 2012

cảm ơn anh rất nhiều, nhưng quả thật yêu cầu của em có lẽ là không thể. vì lô đất là hình bất kỳ, mà em muốn là hướng đặt dim là pick ra ngoài poline đã khép kin hay trong thì dim sẽ ra ngoài hoặc vào trong.

nếu không thể thì có thể giúp em đơn gian hơn là bớt dòng nhắc trong đoạn lisp của bác Tue đoạn nhập khoảng cách dim và hướng đặt dim không cần nữa.

cảm ơn các anh rất nhiều

Thực ra yêu cầu của Bạn không rõ ràng nên mọi người không muốn sửa đi rồi sửa lại nhiêu lần.

Nếu không nhập k/cách thì có k/cách cố định là bao nhiêu?

Không có hướng đặt dim thì sẽ đặt dim trên line, pline, nếu như vậy thì quá dễ. chỉ ngại là làm xong rồi lại sửa

Tháng 9 4, 2012

khi em để mặc định (* *kc* 500) là (* *kc* 0) thì thực hiện lệnh nó mặc định 0 có khoảng cách và nó sẽ để khoảng cách theo Dim mẫu trên Styles do mình chọn và em không muốn nó hỏi (có thể giúp em có dấu Enter "" luôn để mình không phai Enter nữa mà em thử thêm vào sau dòng nhắc Nhập khoảng cách mà không được (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 0) 2 2) "> :" "")))</pre>

).

sửa đoạn:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))</pre>

thành:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 0) 2 2) "> :" )))</pre>

Còn trọn hướng Dim thì em không thực hiện được vì nó chỉ hiểu trên đường Poline không khép kín còn đường Poline khép kín thì nó không có tác dụng

Tháng 9 4, 2012

2. Lisp mất chế độ chọn hướng ghi kích thước :(

khi em để mặc định (* *kc* 500) là (* *kc* 0) thì thực hiện lệnh nó mặc định 0 có khoảng cách và nó sẽ để khoảng cách theo Dim mẫu trên Styles do mình chọn và em không muốn nó hỏi (có thể giúp em có dấu Enter "" luôn để mình không phai Enter nữa mà em thử thêm vào sau dòng nhắc Nhập khoảng cách mà không được (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 0) 2 2) "> :" "")))</pre>

).

Còn trọn hướng Dim thì em không thực hiện được vì nó chỉ hiểu trên đường Poline không khép kín còn đường Poline khép kín thì nó không có tác dụng

Đã bổ sung hướng đặt DIM vào code của Tue_NV

(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
     (or *kc* (setq *kc* 1))
 	(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
 	(if kc (setq *kc* kc) (setq kc *kc* ))
 	(setq d4 (getpoint "\nHuong dat kich thuoc ? ") )
 	(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(command "_.offset" (* kc 500.0) ent d4 "")
(setq d5 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (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 (nth i d5))
  (setq i (1+ i))
  )
)
 	)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

Muốn đặt DIM cách đối tượng 1 k/cách cố định thì Bạn xóa bỏ 3 dòng màu đỏ :

(or *kc* (setq *kc* 1))

(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))

(if kc (setq *kc* kc) (setq kc *kc* ))

Rồi thêm dòng lệnh (setq kc a) tại vị trí vừa xóa, lúc này k/c từ DIM đến đối tượng là a*500 (a là 1 số thực)

edit: trong thẻ code không cho format color

Tháng 9 4, 2012

hướng ghi kthuoc nó toàn báo lỗi này là sao anh nhỉ:

Command: KT2

Chon duong thang can ghi kich thuoc :

Select objects: Specify opposite corner: 6 found

Select objects:

Nhap khoang cach <0.00> :

Huong dat kich thuoc ?

Value must be positive and nonzero.

; error: Function cancelled

em bỏ đoạn

(or *kc* (setq *kc* 1))

(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))

(if kc (setq *kc* kc) (setq kc *kc* ))

Rồi thêm dòng lệnh (setq kc a) tại vị trí vừa xóa, lúc này k/c từ DIM đến đối tượng là a*500 (a là 1 số thực)

cũng không được nó báo lỗi:

Command: kt2

Chon duong thang can ghi kich thuoc :

Select objects: 1 found

Select objects:

Huong dat kich thuoc ? ; error: bad argument type: numberp: nil

em muốn gửi file vẽ lên trên này cho các anh dễ hiểu nhưng sao lúc này không có chữ updoad ở dưới nên em không gửi được

em vẽ ở tỉ lệ 1/1, các hình thửa đất hoặc nhà đều khép kín bởi đường Poline!

Tháng 9 4, 2012

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

Tháng 9 4, 2012

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

Tháng 9 4, 2012

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:

đây là file bản vẽ :

http://www.cadviet.com/upfiles/3/104547_banve.dwg

Tháng 9 4, 2012

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

Tháng 9 5, 2012

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

Đăng nhập

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

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

erikce 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

ketxu 2.983

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

SoftvnBin 4

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

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

SoftvnBin 4

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

SoftvnBin 4

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

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

Tue_NV 3.912

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

SoftvnBin 4

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

Tue_NV 3.912

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

SoftvnBin 4

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

vuminhchau 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

vuminhchau 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

tien2005 241

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

vuminhchau 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

vuminhchau 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

tien2005 241

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

vuminhchau 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

tien2005 241

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

vuminhchau 1