Viết lisp theo yêu cầu [phần 2]

[master_worse 88]

....Yêu cầu:

Viết lệnh autolisp có tên là 1,2,3,4,… dùng để thực hiện các lệnh về ghi kích thước trong Autocad.

Ví dụ:

Command: 1

- Chuyển sang lớp KT-Dim (bảo đảm khi thực hiện dù đang ở lớp nào cũng nhảy về Layer KT-Dim)

- Thực hiện lệnh _dimlinear

- Chuyển về Layer trước đó (cái vế này thì tôi bí)

....

 

trừ DIMCONTINUE các dim khác mình có thể làm giúp bạn được

nhưng

....

Bây giờ đến lượt tui có lời yêu cầu “nhỏ như con thỏ” mong được gia_bach giúp đỡ đây (nhờ thật tình và đích danh).

....

đành thôi vậy :(

[duy782006 1.543]

trừ DIMCONTINUE các dim khác mình có thể làm giúp bạn được

Ủa DIMCONTINUE bạn vướng chổ nào à (bàn luận ngoài yêu cầu của trinhvqh). Lựa chọn Select là giải quyết được mà (mình nghỉ thế).

[master_worse 88]

Ủa DIMCONTINUE bạn vướng chổ nào à (bàn luận ngoài yêu cầu của trinhvqh). Lựa chọn Select là giải quyết được mà (mình nghỉ thế).

vấn đề ở chổ không thể điều chỉnh layer như mong muốn.

[tvduc 0]

....

Mình góp ý với bạn 1 tí trong Code của bạn nhé :

-> Không nên sử dụng hàm getdist để nhập góc trong code cụ thể là :

(setq a (getdist "\n Nhap goc xoay cua coc: "))

-> Nên sử dụng hàm getangle để nhập góc -> Kết quả sẽ trả về radian : và trong hàm cos; sin thì bạn không cần phải chuyển sang Radian nữa

(setq a (getangle "\n Nhap goc xoay cua coc: "))

-> Nhập 45 sẽ trả lại kết quả 0.785398 (RAD)

1. Bác Tue_NV ơi! với hàm getangle, lúc nhập giá trị âm thì nó không đúng bác à.

2. Nhờ các bác sửa giùm tùy chọn cọc xiên hay thẳng, sao hàm (if (= xt T) chương trình không hiểu?

 

Cảm ơn các bác.

 

; Doi voi mot so ket cau nhu cau tau, tru neo. Thuong co truong hop coc xien trong khong gian,
; Lisp nay giup ve nhanh mo hinh ket cau 3D ngay tren cua so 2D cua ACAD ma khong can phai biet ve trong 3D.
; (chi ve phan coc va dam ....)
; Lenh ve 	CS
; Huong dan 	HD
(defun c:cs()
(setq oldo (getvar "osmode"))
(setvar "osmode" 33)
(command "layer" "m" "Fram" "c" 2 "" "")
(princ "\n Lisp Ve coc khong gian - ung dung lap mo hinh cho SAP tu ACAD: Tvduc")
 (setq
   Lu (getdist "\n Nhap chieu dai chiu uon:    ")
 )
 ;??? Giup do
 (initget 1 "X T")
 (setq xt (getkword "\n Coc Xien/Thang [X,T]? :"))
 (if (= xt T) ;;;;;;;;;;;;;;Sao khong chuong trinh khong hieu ham nay????????????
   (progn
     (setq x 0 y 0)
     )
   (progn
     (setq m (getdist "\n Nhap do xien cua coc 1/m:    "))
     (while (and (< m 5) (/= m 0))
(alert"Ban oi! Do xien cua coc phai la so duong, va khong duoc xien qua 1/5,lam on nhap lai nhe!")
; Tuy thuoc vao tung cong trinh cu the ma do xien cua coc co the vuot ngoai gia tri tren.
(setq m (getdist "\n Nhap lai do xien cua coc 1/m:    "))
)
     (while (> m 10)
(alert"Ban oi! Do xien cua coc nho hon 1/10 khong co y nghia, xem lai ket cau nhe!")  
(setq m (getdist "\n Nhap lai do xien cua coc 1/m:    "))
);while


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   (if (/= m 0)
     (progn[b][size=5]
;	(setq	a (getangle "\n Nhap goc xoay cua coc:    ")) ; khi nhap gia tri am thi cho ket qua khong dung![/size][/b]
(setq	a (getdist "\n Nhap goc xoay cua coc:    "))
(setq	a (/ (* pi a) 180))
(while (or (< a (- 0 (/ pi 2))) (> a (/ pi 2)))
  (alert"Ban oi! Góc xoay co gia tri tu -45 den +45 do^. thoi!  Lam on nhap lai nhe.")
  (setq a (getdist "\n Coc xoay quan truc:   "))
  ; Tuy thuoc tung bai toan cu the.
  );while
(setq 	aa (getdist "\n Coc xoay quan truc:   "))
(while (and (/= aa 1)(/= aa 2)(/= aa 3)(/= aa 4))
  (alert"Ban oi! Chieu duong truc x la truc 1,   Chieu duong truc y la truc 2,   Chieu am truc x la truc 3,   Chieu am truc y la truc 4!   Lam on nhap lai nhe.")
  (setq aa (getdist "\n Coc xoay quan truc:   "))
  );while
(setq
  a (+ (* (- aa 1) (/ pi 2)) a)
  xy (/ Lu m)
  x (* xy (cos a))
  y (* xy (sin a))
  )
)	
     (progn
(setq x 0 y 0)
); end Eles
     );if
     )
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(while (setq p1 (getpoint "\n Vi tri dinh coc ?"))
	(if p1
		(progn
		(setq p2 (list (+ (car p1) x) (+ (cadr p1) y) (- 0 Lu)))
		(command "_line" p1 p2 "")
		)
	);if
);while
(setvar "osmode" oldo)

(princ "\n Can phai chuyen tat cac cac doi tuong dam ve Layer Fram")
(print)
); defun
(defun c:hd ()
(print "Chieu duong cua goc xoay nguoc chieu voi kim dong ho")
(print "Goc toa do la dinh coc")
(print "Chieu duong truc x la truc 1")
(print "Chieu duong truc y la truc 2")
(print "Chieu am truc x la truc 3")
(print "Chieu am truc y la truc 4")
(princ)
)

[tvduc 0]

Bạn tham khảo Lisp sau :

(defun c:svp(/ ent dz Viewport)
 (if (/= (getvar "cvport") 1)
   (alert "\nChi co the chay tren khong gian giay (LAYOUT).")
   (progn
     (while
(not
  (and
    (setq ent (car (entsel "\nChon Viewport : ")))
    (or
      (= (cdr (assoc 0 (entget ent))) "VIEWPORT")
      (= (cdr (assoc 0 (entget (setq ent (cdr (assoc 330 (entget ent))))))) "VIEWPORT")
      )
    )
  )
(princ "\nkhong phai Viewport. Chon lai : ")
)
     (setq dz (getvar "dimzin"))
     (setvar "dimzin" 8 )
     (setq Viewport (vlax-Ename->Vla-Object ent)
    sc (vla-get-CustomScale Viewport))
     (alert (strcat "\nCustom Scale : " (rtos sc) " or " (strcat "1/" (rtos (/ 1 sc)))))
     (setvar "dimzin" dz )
     )
   )
 (princ)  )

 

Hihi răng nỏ (sao không) chạy được bác!

[dvqkt112 1]

cảm ơn anh gia_bach, cái list của anh đã giúp em rất nhiều.

[gia_bach 1.549]

Hihi răng nỏ (sao không) chạy được bác!

Không chạy đuợc chỗ mô ?

 

Rứa hắn tỏ chi mô ?

[gia_bach 1.549]

Lisp của gia_bach tuy chưa hoàn hảo nhưng cũng đủ làm Fan “tung hô”

(Mà kỳ ghê. Lúc nào gia_bach cũng giải quyết vấn đề không rốt ráo)

 

Theo quan điểm cá nhân: Trước đây tôi thấy có bác Hoành (đụng độ rồi), bây giờ có thêm gia_bach là 02 cao thủ “Ô tô líp”.

 

Bây giờ đến lượt tui có lời yêu cầu “nhỏ như con thỏ” mong được gia_bach giúp đỡ đây (nhờ thật tình và đích danh).

 

Yêu cầu:

Viết lệnh autolisp có tên là 1,2,3,4,… dùng để thực hiện các lệnh về ghi kích thước trong Autocad.

Ví dụ:

Command: 1

- Chuyển sang lớp KT-Dim (bảo đảm khi thực hiện dù đang ở lớp nào cũng nhảy về Layer KT-Dim)

- Thực hiện lệnh _dimlinear

- Chuyển về Layer trước đó (cái vế này thì tôi bí)

 

Hy vọng gia_bach giải quyết vấn đề thuyết phục nhé.

Xin cảm ơn!

Hẹn hậu tạ nếu có dịp :(

Chào trinhvqh

Đầu tuần hơi bị bận, giờ mới hầu chuyện bác đuợc.

 

Trước tiên về cái chuyện nhờ đích danh :

- chắc bác đã thấy đuợc tai hại của việc nhờ đích danh 1 ai đó trong diễn đàn.

- theo nhận xét của cá nhân tui : trên CadViet có trên 10 thành viên có thể đáp ứng đuợc yêu cầu của bác. Và thực tế thì đã có 2 member lên tiếng.

Nếu bác không nhờ đích danh thì có lẽ Bác đã có đuợc LISP cách đây vài ngày. (hi : cũng đỡ cho tui phải trả lời bác )

 

Kế đến : "giải quyết vấn đề thuyết phục nhé" và "Lúc nào gia_bach cũng giải quyết vấn đề không rốt ráo)"

Có thể đã từng có nhiều vấn đề đã không đuợc giải quyết rốt ráo, nhưng tui chỉ nhắc lại 2 vấn đề gần đây nhất (cũng là đại diện cho các vấn đề khác) :

1./ Lập bảng tọa độ điểm

2./ Trim tất cả các đoạn ống đi ngang qua block hố ga

Vấn đề thứ 1 tui đã trả lời, không tiện nhắc lại ở đây. Tham khảo : http://www.cadviet.com/forum/index.php?sho...ost&p=81408

Vấn đề thứ 2 : Trim tất cả các đoạn ống đi ngang qua block hố ga

Đôi dòng về Quan điểm viết LISP của tui là :

- LISP viết ra có giảm đuợc thời gian của CadMan không ? Nếu không giảm đuợc thời gian thì không nên sử dụng (viết) LISP

- Sẽ có bao nhiêu nguời sử dụng LISP đó ? Nếu chỉ có 1 hoặc 2 nguời dùng thì hiệu quả không cao -> không nên đầu tư (viết LISP).

- Vấn đề đã đuợc nói đến (giải quyết) trên CADVIET chưa ? Nếu vấn đề chưa đuợc nói đến (giải quyết) trên CADVIET, có thể là các member không quan tâm hay chưa biết cách giải quyết (hoặc tệ hơn là không muốn share). Dù thế nào đi nữa thì tui cũng chỉ muốn chia sẽ kinh nghiệm học mót đuợc từ Cộng đồng mã nguồn mở mà LISP là 1 trong những thành viên.

 

Yêu cầu : Trim tất cả các đoạn ống đi ngang qua block hố ga không đáp ứng đuợc 2 tiêu chí đầu, nhưng với tiêu chí : chưa đuợc nói đến (giải quyết) trên CADVIET thì OK (yêu cầu Lập bảng tọa độ điểm cũng đáp ứng đuợc tiêu chí này).

 

Với tiêu chí chia sẽ kinh nghiệm viết LISP thì mức độ đáp ứng yêu cầu của bài toán sẽ không đuợc xem trọng hay "giải quyết không rốt ráo", LISP chủ yếu là thể hiện giải thuật, giới thiệu môt số hàm mới ... (và điều này chỉ hữu ích cho các "Programer").

Nhưng thực tế hiệu quả của LISP Trim tất cả các đoạn ống đi ngang qua block hố ga cũng rất cao : (1000- 2 đầu mút)/ 1000 ~ 99.99 %

...(cái này của em có tới 1000 hố ga, em muốn cắt đường cống đi qua hố ga)

Gửi bạn LISP : Chuyển sang lớp KT-Dim, Thực hiện lệnh _dimlinear, Chuyển về Layer trước đó

các lệnh khác thực hiện tương tự (thay thế tên lệnh dimlinear).

(defun c:1(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimlinear" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )

[trinhvqh 226]

Tôi vừa Test thử Lisp của gia_bach

Phải nói chạy rất OK

Xin cảm ơn rất nhiều!

……

Việc tôi nhờ đích danh quả thật sáng suốt (01 người cho chín còn hơn 9 người)

Chờ đợi một chút để có kết quả tốt rất thích đáng, p k?

….

Còn cái việc gia_bach biện hộ cho 02 cái Lisp trước đây thật không thuyết phục chút nào

------

À, xin cảm ơn duy782006 và master_worse

[dvqkt112 1]

Đúng là chưa hoàn hảo thật, nhưng đối với em nó cũng rất tốt rồi, không có thì Trim mỏi ca tay mất, cảm ơn anh nhiều nhé.

[dvqkt112 1]

Em làm xong rồi, nhưng vẫn thấy cái TRIMBL này thật hữu hiệu, nếu các anh có thời gian thì giúp em hoàn thiện nó nhé. List của anh Gia_bach chỉ Tr trên 1 đoạn cống trong 1 lệnh, nếu có thể làm 1 lệnh mà tr được nhiều đoạn cống khác nhau thì tuyệt biết bao.

[gia_bach 1.549]

Em làm xong rồi, nhưng vẫn thấy cái TRIMBL này thật hữu hiệu, nếu các anh có thời gian thì giúp em hoàn thiện nó nhé. List của anh Gia_bach chỉ Tr trên 1 đoạn cống trong 1 lệnh, nếu có thể làm 1 lệnh mà tr được nhiều đoạn cống khác nhau thì tuyệt biết bao.

LISP làm 1 lệnh mà trim được nhiều đoạn cống khác nhau.

Chú ý : Lisp chỉ sử lý trường hợp block hố ga giao với đường ống (Line, Arc, PLine) tại 2 điểm.

Do đó trong file của bạn, lisp không sử lý điểm ngoài cùng.

(vl-load-com)
(defun C:TRIMBLK (/ ent ipts lstblk lstpts lstptspa obj ss)
;; By : Gia Bach, Copyrightc December 2009 ;;
;; Contact : gia_bach @ www.CadViet.com ;;
(defun BlockIntersObj (Blk Obj / iPts pt_lst)
 (foreach memb (vlax-invoke Blk 'Explode)
   (if (eq (vla-get-ObjectName memb) "AcDbPolyline")
     (setq iPts (vlax-invoke memb 'IntersectWith Obj 0)) )
   (vla-delete memb)
   )
 (if iPts
   (repeat (/ (length iPts) 3)
     (setq pt_lst (cons (list (car iPts)(cadr iPts)(caddr iPts)) pt_lst)
    iPts (cdddr iPts) ) ) )
 (if pt_lst (reverse pt_lst))
 )
;--------------- main -------------------
 (command "undo" "be")
 (princ "\nChon doi tuong can Trim : ")
 (if (setq ss (ssget (list (cons 0 "*LINE,ARC"))))
   (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (setq lst_pt (TraceObject obj)
    ssBlk (ssget "f" lst_pt(list (cons 0 "INSERT") (cons 8 "Hoga"))))
     (foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssBlk))))
(if (and (setq iPts (BlockIntersObj e obj)) (=(vl-list-length iPts)2))
  (foreach pt iPts
    (setq lstPtsPa (cons (cons (vlax-curve-getParamAtPoint obj pt) pt) lstPtsPa) ) ))
);foreach
     (if lstPtsPa
(setq lstPtsPa (vl-sort lstPtsPa '(lambda (x y) (> (car x) (car y))))
      lstPts (mapcar 'cdr lstPtsPa) ))
     (setq ent (vlax-vla-object->ename obj)
    lstPtsPa nil)
     (repeat (/ (length lstPts) 2)
(command "._break" ent "_non" (car lstPts) "_non" (cadr lstPts))
(setq lstPts (cddr lstPts)) )
     )
   )
 (command "undo" "e")
 (princ)
 )


(defun TraceObject (obj	     /		    typlst
	      typ	     TracePline	    TraceACE
	      TraceLine	     TraceSpline    TraceType1Pline
	      TraceType23Pline
	     )
   (defun ZClosed (lst)
     (if (and (vlax-curve-isClosed obj)
       (not (equal (car lst) (last lst) 1e-6))
  )
(append lst (list (car lst)))
lst
     )
   )
   (defun TracePline (obj     /       param   endparam	       anginc
	       tparam  pt      blg     ptlst   delta   inc
	       arcparam	       flag
	      )
     (setq param    (vlax-curve-getStartParam obj)
    endparam (vlax-curve-getEndParam obj)
    anginc   (* pi (/ 7.5 180.0))
     )
     (setq tparam param)
     (while (<= param endparam)
(setq pt (vlax-curve-getPointAtParam obj param))
(if (not (equal pt (car ptlst) 1e-12))
  (setq ptlst (cons pt ptlst))
)
(if (and (/= param endparam)
	 (setq blg (abs (vlax-invoke obj 'GetBulge param)))
	 (/= 0 blg)
    )
  (progn
    (setq delta	   (* 4 (atan blg)) ;included angle
	  inc	   (/ 1.0 (1+ (fix (/ delta anginc))))
	  arcparam (+ param inc)
    )
    (while (< arcparam (1+ param))
      (setq pt	     (vlax-curve-getPointAtParam obj arcparam)
	    ptlst    (cons pt ptlst)
	    arcparam (+ inc arcparam)
      )
    )
  )
)
(setq param (1+ param))
     )
     (if (and (apply 'and ptlst)
       (> (length ptlst) 1)
  )
(ZClosed (reverse ptlst))
     )
   )					;end
   (defun TraceACE (obj      /	       startparam	 endparam
	     anginc   delta    div	inc	 pt
	     ptlst
	    )
     (setq startparam (vlax-curve-getStartParam obj)
    endparam   (vlax-curve-getEndParam obj)
    anginc     (* pi (/ 5.0 180.0))
     )
     (if (equal endparam (* pi 2) 1e-12)
(setq delta endparam)
(setq delta (NormalAngle (- endparam startparam)))
     )
     (setq div	(1+ (fix (/ delta anginc)))
    inc	(/ delta div)
     )
     (while (or
       (< startparam endparam)
       (equal startparam endparam 1e-12)
     )
(setq pt	 (vlax-curve-getPointAtParam obj startparam)
      ptlst	 (cons pt ptlst)
      startparam (+ inc startparam)
)
     )
     (reverse ptlst)
   );end defun
   (defun TraceLine (obj)
     (list (vlax-get obj 'StartPoint)
    (vlax-get obj 'EndPoint)
     )
   )
   (defun TraceSpline (obj	/	startparam	endparam
		ncpts	inc	param	fd	ptlst	pt1
		pt2	ang1	ang2	a
	       )
     (setq startparam (vlax-curve-getStartParam obj)
    endparam   (vlax-curve-getEndParam obj)
    ncpts      (vlax-get obj 'NumberOfControlPoints)
    inc	       (/ (- endparam startparam) (* ncpts 7))
    param      (+ inc startparam)
    fd	       (vlax-curve-getfirstderiv obj param)
    ptlst      (cons (vlax-curve-getStartPoint obj) ptlst)
     )
     (while (< param endparam)
(setq pt1   (vlax-curve-getPointAtParam obj param)
      ang1  fd
      param (+ param inc)
      pt2   (vlax-curve-getPointAtParam obj param)
      fd    (vlax-curve-getfirstderiv obj param)
      ang2  fd
      a	    (abs (3d_angw1w2 ang1 ang2))
)
(if (> a 0.00218166)
  (setq ptlst (cons pt1 ptlst))
)
     )
     (if (not (equal
	 (setq pt1 (vlax-curve-getEndPoint obj))
	 (car ptlst)
	 1e-8
       )
  )
(setq ptlst (cons pt1 ptlst))
     )
     (reverse ptlst)
   );end defun
   (defun TraceType1Pline (obj / ptlst objlst lst)
     (setq ptlst  (list (vlax-curve-getStartPoint obj))
    objlst (vlax-invoke obj 'Explode)
     )
     (foreach x objlst
(setq lst (TraceACE x))
(if (not (equal (car lst) (last ptlst) 1e-8))
  (setq lst (reverse lst))
)
(setq ptlst (append ptlst (cdr lst)))
(vla-delete x)
     )
     (ZClosed ptlst)
   );end defun
   (defun TraceType23Pline (obj / objlst ptlst lastpt)
     (setq objlst (vlax-invoke obj 'Explode)
    lastpt (vlax-get (last objlst) 'EndPoint)
     )
     (foreach x objlst
(setq ptlst (cons (vlax-get x 'StartPoint) ptlst))
(vla-delete x)
     )
     (ZClosed (reverse (cons lastpt ptlst)))
   );end defun
   (defun Trace3DPline	(obj / coord ptlst)
     (setq coord (vlax-get obj 'Coordinates))
     (repeat (/ (length coord) 3)
(setq
  ptlst	(cons (list (car coord) (cadr coord) (caddr coord))
	      ptlst
	)
)
(setq coord (cdddr coord))
     )
     (ZClosed (reverse ptlst))
   );end defun
   (defun NormalAngle (a)
     (if (numberp a)
(angtof (angtos a 0 14) 0)
     )
   )
   (defun 3d_angw1w2 (Wekt1 Wekt2 / CosA)
     (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2))
		       (distance '(0 0 0) Wekt1)
		       (distance '(0 0 0) Wekt2)
		    )
	 )
	 -1.0
	 1e-6
  )
Pi
(if (equal CosA 0.0 1e-6)
  (* 0.5 PI)
  (atan (sqrt (- 1 (* CosA CosA))) CosA)
)
     )
   )
   (setq typlst '("AcDb2dPolyline"    "AcDbPolyline"
	   "AcDb3dPolyline"    "AcDbCircle"
	   "AcDbArc"	       "AcDbEllipse"
	   "AcDbSpline"	       "AcDbLine"
	  )
   )
   (or	(eq (type obj) 'VLA-OBJECT)
(setq obj (vlax-ename->vla-object obj))
   )
   (setq typ (vlax-get obj 'ObjectName))
   (if	(vl-position typ typlst)
     (cond
((or (eq typ "AcDb2dPolyline") (eq typ "AcDbPolyline"))
 (cond
   ((or
      (not (vlax-property-available-p obj 'Type))
      (= 0 (vlax-get obj 'Type))
    )
    (TracePline obj)
   )
   ((or (= 3 (vlax-get obj 'Type)) (= 2 (vlax-get obj 'Type)))
    (TraceType23Pline obj)
   )
   ((= 1 (vlax-get obj 'Type))
    (TraceType1Pline obj)
   )
 )
)
((eq typ "AcDbLine") (TraceLine obj))
((or (eq typ "AcDbCircle")
     (eq typ "AcDbArc")
     (eq typ "AcDbEllipse")
 )
 (TraceACE obj)
)
((eq typ "AcDbSpline") (TraceSpline obj))
((eq typ "AcDb3dPolyline") (Trace3DPline obj))
     )
   )
 )

[trinhvqh 226]

@gia_bach

Lại có chút trục trặc khi làm tương tự cho các lệnh khác (Lệnh 4,5,6,7 và qd)

 

Nhờ gia_bach kiểm tra và sửa lỗi giúp mình

Xin cảm ơn!!

 

http://www.cadviet.com/upfiles/2/03dimmension.rar

[master_worse 88]

@gia_bach

Lại có chút trục trặc khi làm tương tự cho các lệnh khác (Lệnh 4,5,6,7 và qd)

 

Nhờ gia_bach kiểm tra và sửa lỗi giúp mình

Xin cảm ơn!!

 

http://www.cadviet.com/upfiles/2/03dimmension.rar

 

thiếu ( trước các defun c:4(5,6,7 và qd)

 

ý quên! :(

Chỉnh sửa Tháng 12 14, 2009 theo master_worse

[dvqkt112 1]

Anh ơi, sau khi emchọn các đối tượng xong rồi thì không làm gì được nữa, nó báo là:

Command:

Chon doi tuong can Trim :

Select objects: Specify opposite corner: 3 found

Select objects: ; error: bad point argument.

Anh chỉ em cách sử dụng với.

[gia_bach 1.549]

thiếu ( trước các defun c:4(5,6,7 và qd)

ý quên! :(

to master_worse : quên cái gì ? :rolleyes:

 

@gia_bach

Lại có chút trục trặc khi làm tương tự cho các lệnh khác (Lệnh 4,5,6,7 và qd)

 

Nhờ gia_bach kiểm tra và sửa lỗi giúp mình

Xin cảm ơn!!

 

http://www.cadviet.com/upfiles/2/03dimmension.rar

;CAC LENH VE DIMENSION
(defun c:1(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimlinear" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;------
(defun c:2(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_DIMALIGNED" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:3(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_DIMCONTINUE" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:4(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimbaseline" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:5(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimradius" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:6(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimdiameter" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:7(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "_dimangular" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;-----
(defun c:qd(/ ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 1) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "CLAYER" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )

 (command "QDIM" )
 (while (= (getvar "CMDACTIVE") 1 ) (command pause) )
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )

 

Một cách khác : dùng hàm con (Code ngắn hơn)

;CAC LENH VE DIMENSION
(defun c:1() (VeDim "1"))
(defun c:2() (VeDim "2"))
(defun c:3() (VeDim "3"))
(defun c:4() (VeDim "4"))
(defun c:5() (VeDim "5"))
(defun c:6() (VeDim "6"))
(defun c:7() (VeDim "7"))
(defun c:qd() (VeDim "qd"))

(defun VeDim(input / ov vl)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov)); reset Sys Vars
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))  ; Get Old values
 (setvar "cmdecho" 0) 
 (if (tblsearch "layer" "KT-Dim")
   (setvar "clayer" "KT-Dim")
   (command "-layer" "M" "KT-Dim" "" ) )
 (setvar "cmdecho" 1)
 (cond
   ((= input "1")(command "_dimlinear"))
   ((= input "2")(command "_dimaligned"))
   ((= input "3")(command "_dimcontinue"))
   ((= input "4")(command "_dimbaseline"))
   ((= input "5")(command "_dimradius"))
   ((= input "6")(command "_dimdiameter"))
   ((= input "7")(command "_dimangular"))
   ((= input "qd")(command "qdim"))
   )
 (while (= (getvar "CMDACTIVE") 1) (command pause))
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (princ)
 )
;---------------------------------

Chỉnh sửa Tháng 12 15, 2009 theo gia_bach

[gia_bach 1.549]

Anh ơi, sau khi emchọn các đối tượng xong rồi thì không làm gì được nữa, nó báo là:

Command:

Chon doi tuong can Trim :

Select objects: Specify opposite corner: 3 found

Select objects: ; error: bad point argument.

Anh chỉ em cách sử dụng với.

Lỗi do CODE quá dài ?!

 

Huớng dẫn sử dụng : http://www.cadviet.com/forum/index.php?sho...ost&p=81489

[master_worse 88]

to master_worse : quên cái gì ? :(

....

cái dzụ đích danh

-------------------

P/S:

sẵn đây ai biết cho mình hỏi làm sao xóa cái mình đã trả lời. ví dụ như mình đã trả lời ở trên giờ tiền bối gia_bạch trả lời cụ thể hơn thì xóa bài của mình đi cho thông thoáng. hay phải nhờ admin.

[tieu_ngu_nhi_43 0]

Chào anh Nguyen Hoanh!

Anh có lisp nào mà có thể copy hoặc move nhiểu đối tượng theo nhiều phương với cùng một khoảng cách được không ạ?

Cụ thể em move 1 đối tượng theo 1 phương với khoảng cách là 200. Em muốn move đối tượng khác theo phương khác cũng với khoảng cách là 200. Nhưng cứ phải nhập lại khoảng cách thì lâu quá. Em muốn xin lisp nào có thể move mà ko cần nhập lại khoảng cách.

Thanks anh nhiều!!! Chúc Cadviet ngày càng lớn mạnh.

[phamthanhbinh 3.146]

Chào anh Nguyen Hoanh!

Anh có lisp nào mà có thể copy hoặc move nhiểu đối tượng theo nhiều phương với cùng một khoảng cách được không ạ?

Cụ thể em move 1 đối tượng theo 1 phương với khoảng cách là 200. Em muốn move đối tượng khác theo phương khác cũng với khoảng cách là 200. Nhưng cứ phải nhập lại khoảng cách thì lâu quá. Em muốn xin lisp nào có thể move mà ko cần nhập lại khoảng cách.

Thanks anh nhiều!!! Chúc Cadviet ngày càng lớn mạnh.

Chào bạn tieu_ngu_nhi_43,

Theo cái yêu cầu của bạn thì thực ra không nhất thiết phải dùng lisp đâu. Tuy nhiên nếu bạn vẫn thấy thích dùng lisp thì nó đây:

(defun c:mmo ()
(setq ss (ssget)
     n (sslength ss)
     i 0
     d (getreal "\n Nhap khoang cach muon di chuyen: ")
)
(repeat n
(setq ent (ssname ss i)
     ang (getangle "\n Nhap goc muon di chuyen: ")
)
(command "move" ent "" (setq p1 (getpoint "\n Chon diem tuy y ")) (polar p1 ang d))
(setq i (1+ i))
)
(princ)
)

 

Tuy nhiên khi dùng lisp này, bạn cần lưu ý như sau:

1/- Khi lisp nhắc bạn chọn đối tượng, bạn nên chọn bằng cách pick từng chú một nhé. Bởi vì như vậy may ra bạn còn nhớ được trật tự của các đối tượng để khi di chuyển khỏi nhầm lẫn. Nếu bạn sử dụng phương pháp chọn khác e rằng lisp này sẽ chạy không đúng ý bạn đâu.

2/- Khi lisp yêu cầu nhập góc muốn di chuyển của từng đối tượng, bạn hãy nhập góc theo hướng bạn muốn di chuyển với đơn vị đo là độ.

3/- Khi lisp nhắc bạn chọn điểm tùy ý, bạn có thể pick bất cứ điểm nào trên bản vẽ mà kết quả của chúng vẫn như nhau.

4/- Khoảng cách di chuyển của tất cả các đối tượng được yêu cầu nhập một lần khi bắt đầu chạy lisp.

5/- Không nên chạy lisp với quá nhiều đối tượng được lựa chọn vì như vậy có thể bạn sẽ chẳng nhớ nổi cái trật tự chọn ban đầu của bạn và thế là bạn sẽ di chuyển các đối tượng không đúng theo ý muốn của bạn.

6/-Bạn hãy dựa vào cái lisp này để tự mình điều chỉnh sao cho phù hợp nhất với yêu cầu của bạn.

 

Thú thực là mình chưa hoàn toàn hài lòng với cái lisp này, nhưng hy vọng bạn cũng như mọi người sẽ bổ sung cho hoàn thiện hơn.

Chúc bạn thành công.

 

PS: Mình bổ sung thêm một lisp khác với cùng chức năng như trên nhưng tránh được cái lỗi phải nhớ trật tự các đối tượng trong bộ chọn. Sau mỗi lần di chuyển một đối tượng lisp sẽ hỏi bạn có muốn tiếp tục hay không. Nếu bạn trả lời "y" lisp sẽ cho bạn di chuyển tiếp đối tượng khác, nếu bạn trả lời "n" lisp sẽ dừng chạy.

Lisp này có nhược điểm là nếu bạn muốn chuyển nhiều đối tượng theo cùng một hướng thì bạn phải làm nhiều lần.

Bạn hãy thử xem nhé.

(defun c:mmn ()
(setq d (getreal "\n Nhap khoang cach muon di chuyen: ")
     ans (getstring "\n Ban muon di chuyen cac doi tuong ??? : "))
(while (= ans "y")
(setq ent (car(entsel))
     ang (getangle "\n Nhap goc muon di chuyen: "))
(command "move" ent "" (setq p1 (getpoint "\n Chon diem tuy y ")) (polar p1 ang d))
(setq ans (getstring "\n Ban co muon tiep tuc di chuyen??? : "))
)
(princ)
)

[duy782006 1.543]

Em thấy cái lisp này chưa ổn bác Bình ạ.

Theo em nên làm như này.

-Hỏi chọn đối tượng (1 hay 1 đống gì thì tùy). Kết thúc chọn bằng enter.

-Chọn điểm chuẩn.

-Hỏi khoảng cách. (Lưu khoảng cách)

-Chỉ hướng.

Thực hiện move các đối tượng hồi nảy đi.

-Lại hỏi chọn đối tượng (cũng như hồi nảy)

-Chọn điểm chuẩn.

-Chỉ hướng.

Thực hiệm move các đối tượng này khoảng cách hồi nãy, hướng bây giờ.

Cừ thế lặp lại.

[gia_bach 1.549]

Em thấy cái lisp này chưa ổn bác Bình ạ.

Theo em nên làm như này.

-Hỏi chọn đối tượng (1 hay 1 đống gì thì tùy). Kết thúc chọn bằng enter.

-Chọn điểm chuẩn.

-Hỏi khoảng cách. (Lưu khoảng cách)

-Chỉ hướng.

Thực hiện move các đối tượng hồi nảy đi.

-Lại hỏi chọn đối tượng (cũng như hồi nảy)

-Chọn điểm chuẩn.

-Chỉ hướng.

Thực hiệm move các đối tượng này khoảng cách hồi nãy, hướng bây giờ.

Cừ thế lặp lại.

LISP triển khai theo ý bác duy782006

(defun c:mmo(/ ang dis pt ss)
 (or *dis* (setq *dis* 200))
 (or *ang* (setq *ang* 0))

 (princ "\nChon doi tuong muon di chuyen :")
 (while (setq ss (ssget))
   (setq ang (getangle (strcat "\nNhap goc muon di chuyen <" (angtos *ang*) ">: ")))
   (if ang (setq *ang* ang))

   (initget 2)
   (setq dis (getreal (strcat "\nNhap khoang cach <" (rtos *dis*) ">: ")))
   (if dis (setq *dis* dis))

   (command "move" ss "" (setq pt (getvar "lastpoint")) (polar pt *ang* *dis*))
   (princ "\nChon doi tuong muon di chuyen :")
   )
 (princ)
 )

[duy782006 1.543]

Cái chổ nhập khoảng cách bác dùng getdist thì ok hơn á!

[Tue_NV 3.912]

LISP triển khai theo ý bác duy782006

(defun c:mmo(/ ang dis pt ss)
 (or *dis* (setq *dis* 200))
 (or *ang* (setq *ang* 0))

 (princ "\nChon doi tuong muon di chuyen :")
 (while (setq ss (ssget))
   (setq ang (getangle (strcat "\nNhap goc muon di chuyen : ")))
   (if ang (setq *ang* ang))

   (initget 2)
   (setq dis (getreal (strcat "\nNhap khoang cach : ")))
   (if dis (setq *dis* dis))

   (command "move" ss "" (setq pt (getvar "lastpoint")) (polar pt *ang* *dis*))
   (princ "\nChon doi tuong muon di chuyen :")
   )
 (princ)
 )

Em thấy tốc độ của Lisp này ngang bằng với lệnh Mutiple -> Move chứ chẳng nhanh hơn là mấy. Trong khi đó, lệnh Mutiple -> Move lại có thể hiện được cả hình ảnh động và di chuyển đối tượng theo hướng của dây tóc chuột, có điều cái này không lưu được khoảng cách

Nếu Lisp thể hiện được hình được hình ảnh động và di chuyển theo phương dây tóc của chuột (khỏi cần nhập góc) thì nó mới thật sự nhanh hơn đấy anh gia_bach à.

 

Lisp tối ưu phải là Lisp khắc phục được nhược điểm của lệnh Mutiple -> Move (lưu lại khoảng cách cho việc sử dụng lần sau mà thôi (không có giá trị góc), thể hiện được hình ảnh động theo phương di chuyển của đối tượng

[gia_bach 1.549]

Cái chổ nhập khoảng cách bác dùng getdist thì ok hơn á!

Bổ sung phần Highlight đối tuợng đuợc chọn và dùng getdist để nhập kh/cách.

Thanks to duy782006.

 

(defun c:mmo(/ ang dis pt ss)
 (defun *error* (msg)
   (if ss (ssredraw ss 4))
   (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))
 (defun ssredraw (ss mode / i ename)
   (setq i -1)
   (while (setq ename (ssname ss (setq i (1+ i))))
     (redraw (ssname ss i) mode)
   )
 )

 (or *dis* (setq *dis* 200))
 (or *ang* (setq *ang* 0))

 (princ "\nChon doi tuong muon di chuyen :")
 (while (setq ss (ssget))
   (ssredraw ss 3)
   (setq ang (getangle (strcat "\nNhap goc muon di chuyen <" (angtos *ang*) ">: ")))
   (if ang (setq *ang* ang))

   (initget 2)
   (setq dis (getdist (strcat "\nNhap khoang cach <" (rtos *dis*) ">: ")))
   (if dis (setq *dis* dis))

   (ssredraw ss 4)
   (command "move" ss "" (setq pt (getvar "lastpoint")) (polar pt *ang* *dis*))
   (princ "\nChon doi tuong muon di chuyen :")
   )
 (princ)
 )