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

#1 erikce

erikce

    Chưa sử dụng CAD

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

Đã gửi 24 July 2012 - 10:59 AM

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


  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 July 2012 - 03:57 PM

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


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

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 28 July 2012 - 06:13 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)
)

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

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 July 2012 - 06:25 PM

@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é ^^
  • 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 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 28 July 2012 - 08:47 PM

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

#6 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 30 July 2012 - 01:27 AM

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

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 July 2012 - 01:56 AM

Bạn post cái mà bạn sửa n chưa được lên thì dễ tưởng tượng hơ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


#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 July 2012 - 07:45 AM

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

  • 2

#9 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 30 July 2012 - 01:55 PM

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

#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 July 2012 - 02:58 PM

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

#11 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 30 July 2012 - 06:19 PM

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

#12 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 29 August 2012 - 11:02 PM

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

#13 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 31 August 2012 - 11:55 AM

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

#14 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 31 August 2012 - 11:17 PM

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

  • 1

#15 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 01 September 2012 - 12:48 AM

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 dimhướng đặt dim không cần nữa.
cảm ơn các anh rất nhiều
  • 0

#16 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 04 September 2012 - 11:45 AM

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

#17 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 04 September 2012 - 11:59 AM

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 dimhướ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
  • 1

#18 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 04 September 2012 - 02:26 PM

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

#19 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 04 September 2012 - 02:58 PM


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

#20 vuminhchau

vuminhchau

    biết vẽ polygon

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

Đã gửi 04 September 2012 - 05:35 PM

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