Jump to content
InfoFile
Tác giả:
Bài viết gốc: 0
Tên lệnh: dccd

Filename: 13801_dccd.lsp
Tác giả: Tot77
Bài viết gốc: 320420
Tên lệnh: ggt
Gán nhanh giá trị trong Dynamic Block sang Block Att

Bạn thử cái này. Nhưng có 1 điều cần chú ý là cái dyn block phải là "đã qua sử dụng", tức là sau khi insert nó thì bạn phải kéo tới kéo lui nó thì nó mới tạo 1 cái block mới với các entities mới chứ không còn là của block gốc nữa.

Nhấp chọn tại cái cạnh nào muốn copy giá trị, rồi nhấp vào cái att (ở đây là DIM1).

(defun c:ggt (/  pl att )  
 ...
>>

Bạn thử cái này. Nhưng có 1 điều cần chú ý là cái dyn block phải là "đã qua sử dụng", tức là sau khi insert nó thì bạn phải kéo tới kéo lui nó thì nó mới tạo 1 cái block mới với các entities mới chứ không còn là của block gốc nữa.

Nhấp chọn tại cái cạnh nào muốn copy giá trị, rồi nhấp vào cái att (ở đây là DIM1).

(defun c:ggt (/  pl att )  
  (setq pl  (car (nentsel "\nChon Dynamic block theo vi tri de lay gia tri :"))
   att (car (nentsel "\nChon Attribute de gan gia tri :" ))
  )
  (princ (cdr (assoc 2 (entget att)))) (setvar 'cmdecho 0)
  (vla-put-TextString (vlax-ename->vla-object att)
    (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object pl))) ">%).Length \\f \"%lu2%pr0>%"))
  (vl-cmdf "regen") (setvar 'cmdecho 1) (princ)
)

<<

Filename: 320420_ggt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 320459
Tên lệnh: kkp
Đo khoảng cách hai điểm và ghi kết quả ra nơi minh chọn

- ^^ bạn ok thì nhoc up lsp, tính cho bạn xem trước ngộ nhở bạn có mún thêm bớt gì ko ^^

;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 ....
>>

- ^^ bạn ok thì nhoc up lsp, tính cho bạn xem trước ngộ nhở bạn có mún thêm bớt gì ko ^^

;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;;ham tao text 2
(defun taotext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 (if layer layer (getvar "clayer")))
							  (cons 7 (if textstyle textstyle (getvar 'textstyle)))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(alert "LSP xuat bang thong ke goc canh , lenh: KKP")
;;----------------------------------------------------------------------------------------------
(defun c:kkp(/ ss ename lst lstcanh lstgoc dem p1 p2 p3 d ang1 ang2 goc kdo dau i k m f j pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 goc270 pt tt ll gg ptt pll pgg old canh kgoc)
  (vl-load-com)
  (setq old (getvar 'osmode))
  (setvar 'osmode 0)
  (prompt "chon PLine:")
  (setq ss (ssget "+.:E:S" '((0 . "*POLYLINE"))))
(if ss
(progn
;--------------------------------------------------------------------
  (setq ename (ssname ss 0))
  (setq lst (acet-geom-vertex-list ename))
  (setq lstcanh nil
	     lstgoc nil)
;================================================
  (setq p1 (car lst)
	dem 1)
;===============================================================
  (while (< dem  (length lst))
    (setq p2 (nth dem lst))
    (setq d (distance p1 p2))
    (setq lstcanh (append lstcanh (list d)))
    (setq p1 p2
	  dem (1+ dem))
    (princ)
    )
(setq bdau 1)
(foreach x lst
 (taotext (polar x (/ pi 2) 0.5) 0.8 (itoa bdau) "M" nil nil 1)
 (setq bdau (1+ bdau))
 )
;==================================================================================
  (setq p1 (car lst)
	dem 1)
;===============================================================================
  (while (< dem  (1- (length lst)))
    (setq p2 (nth  dem lst))
    (setq p3 (nth  (1+ dem) lst))
    (setq ang1 (angle p2 p1)
	  ang2 (angle p2 p3))
    (setq goc (abs (- ang1 ang2)))
    (if (> goc PI)
      (setq goc (- (* 2 pi) goc))
      )
;================================================================================
    (setq kdo (* (/ goc pi) 180.0))
    (setq lstgoc (append lstgoc (list kdo)))
;====================================================================================
    (setq p1 p2
	  dem (1+ dem))
   )
;========================================================================================
(setq pt (getpoint "\nChon diem dat bang:"))
(if (/= pt nil)
(progn
(setq pt1 (mapcar '+ pt (list 45.0 0.0 0.0))
      pt2 (mapcar '+ pt (list 0.0 -4.0 0.0))
      pt3 (mapcar '+ pt (list 45.0 -4.0 0.0))
	  pt4 (mapcar '+ pt (list 5.0 0.0 0.0))
	  pt5 (mapcar '+ pt (list 25.0 0.0 0.0)))
;--------------------------------------------------
(taotext (mapcar '+ pt (list 2.5 -2.0 0.0)) 1.8 "TT" "M" nil nil 3)
(taotext (mapcar '+ pt (list 15.0 -2.0 0.0)) 1.8 "L" "M" nil nil 3)
(taotext (mapcar '+ pt (list 35.0 -2.0 0.0)) 1.8 "GOC" "M" nil nil 3)
(makeline pt2 pt3 nil nil nil nil)
;-----------------------------------------------------
(setq i 1)
(while (<= i (length lst))
(progn
;--------------------------
(setq tt (list 2.5 (- (* -5.0 i) 2.0) 0.0))
(setq ptt (mapcar '+ pt tt))
;--------------------------------
;------------------------------
(taotext ptt 1.8 (itoa i) "M" nil nil 4)
(setq i (1+ i))
)
) ; end while
;===============================================
(setq k 0 m 1)
(repeat (- (length lst) 1)
(setq ll (list 15.0 (- (* -5.0 m) 4.5) 0.0))
(setq pll (mapcar '+ pt ll))
(setq canh (nth k lstcanh))
(taotext pll 1.8 (rtos canh 2 3) "M" nil nil 4)
(setq m (1+ m))
(setq k (1+ k))
)
;==============================================
(setq f 0 j 1)
(repeat (- (length lst) 2)
(setq gg (list 35.0 (- (* -5.0 j) 7.0) 0.0))
(setq pgg (mapcar '+ pt gg))
(setq kgoc (nth f lstgoc))
(taotext pgg 1.8 (rtos kgoc 2 3) "M" nil nil 4)
(setq f (1+ f))
(setq j (1+ j))
)
;----------------------------------------
(setq goc270 (- 0 (/ PI 2)))
(setq pt6 (polar pt goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
      pt7 (polar pt1 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
	  pt8 (polar pt5 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0)))
	  pt9 (polar pt4 goc270 (+ 4 (+ (* 5.0 (length lst)) 3.0))))
(makeline pt4 pt9 nil nil nil nil)
(makeline pt5 pt8 nil nil nil nil)
(makepline (list pt pt1 pt7 pt6) 1 nil nil nil nil)
;=============================================
) ;end progn if
) ; end if pt
); end progn ss
(alert "ban chua chon Pline nao")
) ;end if ss	  
;========================================================================================
(alert "Xong ^^")
(setvar 'osmode old)
(princ)
); end KMP


<<

Filename: 320459_kkp.lsp
Tác giả: thanhduan2407
Bài viết gốc: 320510
Tên lệnh: copy2 paste2
Sử dụng ClipBoard trong LISP : Copy và Paste dữ liệu kiểu Text

Các bác cho em hỏi.

Nếu em quét chọn 1 tập đối tượng Text chẳng hạn. Em muốn lấy tọa độ của Text, nội dung Text ( X Y Z ND) cho vào Clipboard được không ạ?

Sau khi quét chọn Text, kết thúc lệnh thì có thể paste được vào Notepad hoặc Word  hoặc Excel ...

X1 Y1 Z1 MD

X2 Y2 Z2 NHA

................

Lisp trên trình bày hơi rối tý nên em chỉnh sửa lại cho đẹp mắt

>>

Các bác cho em hỏi.

Nếu em quét chọn 1 tập đối tượng Text chẳng hạn. Em muốn lấy tọa độ của Text, nội dung Text ( X Y Z ND) cho vào Clipboard được không ạ?

Sau khi quét chọn Text, kết thúc lệnh thì có thể paste được vào Notepad hoặc Word  hoặc Excel ...

X1 Y1 Z1 MD

X2 Y2 Z2 NHA

................

Lisp trên trình bày hơi rối tý nên em chỉnh sửa lại cho đẹp mắt

(vl-load-com)
(defun c:copy2 (/ ent str); Copy to ClipBoard
(if (and (setq ent (car (entsel (strcat"\nChon Text de luu vao ClipBoard <<" (if (setq str (GetClipBoardText)) (Trim_Str str 15) "nil") ">> :"))))
	 (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")
    )
    (princ (strcat"\nDa luu <<" (SetClipBoardText (cdr (assoc 1 (entget ent)))) ">> vao ClipBoard." ))
    (alert "Chon doi tuong khong hop le.")
)
(princ)
)

(defun c:paste2 (/ obj str ss); Paste from ClipBoard
  (if (setq str (GetClipBoardText))
    (progn
      (princ (strcat "\nChon text de gan gia tri tu ClipBoard <<" (Trim_Str str 15) ">> :"))
      (setq ss (ssget (list (cons 0 "*TEXT")) ))
      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-TextString (vlax-ename->vla-object e) str)
      )
    )
    (alert (strcat "Gia tri ClipBoard hien hanh khong phai kieu String."
		   "\nGoi lenh Copy2 de luu gia tri vao ClipBoard."))
  )
  (princ)
)

(defun Trim_Str(Str len)
  (if (and Str (< len (strlen Str)))
      (strcat(substr Str 1 len)"...")
    Str
  )
)

(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
  (if (= 'STR (type text))
    (progn
      (setq htmlfile (vlax-create-object "htmlfile")
	    result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text )
      )
      (vlax-release-object htmlfile)
      text
    )
    )
  )

(defun GetClipBoardText( / htmlfile result ) ; By Patrick_35
  (setq htmlfile (vlax-create-object "htmlfile")
	result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'GetData "Text" )
  )
  (vlax-release-object htmlfile)
  result
)

Cảm ơn các anh, các bác nhiều


<<

Filename: 320510_copy2_paste2.lsp
Tác giả: Tot77
Bài viết gốc: 320486
Tên lệnh: ggt
Gán nhanh giá trị trong Dynamic Block sang Block Att

Bạn thử cái này xem.

 

(defun c:ggt (/ att cdyn ndyn dyn len as num)  
  (setq cdyn  (car (setq ndyn (nentsel "\nChon Dynamic block theo vi tri de lay gia tri :")))
dyn (car (last ndyn))
len (vla-get-Length (vlax-ename->vla-object cdyn))
   att (car (nentsel "\nChon Attribute de gan gia tri :" ))
l   (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
              (vlax-invoke...
>>

Bạn thử cái này xem.

 

(defun c:ggt (/ att cdyn ndyn dyn len as num)  
  (setq cdyn  (car (setq ndyn (nentsel "\nChon Dynamic block theo vi tri de lay gia tri :")))
dyn (car (last ndyn))
len (vla-get-Length (vlax-ename->vla-object cdyn))
   att (car (nentsel "\nChon Attribute de gan gia tri :" ))
l   (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
              (vlax-invoke (vlax-ename->vla-object dyn) 'GetDynamicBlockProperties))
as  (caar (vl-remove-if-not '(lambda (x) (= len (cdr x))) l))
num (if (= as "Distance1") "1" "8")
  )
  
  (princ (cdr (assoc 2 (entget att))))
  (setvar 'cmdecho 0)
  (vla-put-TextString (vlax-ename->vla-object att)
    (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object dyn)))
   ">%).Parameter(" num ").UpdatedDistance \\f \"%lu6%pr0>%"))
  (vl-cmdf "regen")
  (setvar 'cmdecho 1) (princ)
)

<<

Filename: 320486_ggt.lsp
Tác giả: Tue_NV
Bài viết gốc: 320681
Tên lệnh: copy2
Sử dụng ClipBoard trong LISP : Copy và Paste dữ liệu kiểu Text

Em cảm ơn anh Gia_Bach. Em chưa rõ lắm ạ.

@Tue_NV: Anh có thể cho em 1 đoạn Code hướng dẫn không ạ?

 

1./ Có lẽ anh gia_bach đã nhầm. Đoạn video đó load file *.vlx

2./ Thanhduan thử đoạn code sau :

 

>>

Em cảm ơn anh Gia_Bach. Em chưa rõ lắm ạ.

@Tue_NV: Anh có thể cho em 1 đoạn Code hướng dẫn không ạ?

 

1./ Có lẽ anh gia_bach đã nhầm. Đoạn video đó load file *.vlx

2./ Thanhduan thử đoạn code sau :

 

(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
  (if (= 'STR (type text))
    (progn
      (setq htmlfile (vlax-create-object "htmlfile")
        result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow ) 'ClipBoardData) 'SetData "Text" text )
      )
      (vlax-release-object htmlfile)
      text
    )
    )
  )
(defun c:copy2 (/ ss i ename entg str)
  (setq i -1 str "")
  (if (setq ss (ssget '((0 . "TEXT"))))
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq entg (entget ename))
      (setq str (strcat str "X = " (rtos (cadr (assoc 10 entg))) "\t"
                "Y = " (rtos (caddr (assoc 10 entg))) "\t"


            "Z = " (rtos (caddr (assoc 10 entg))) "\t"
                (cdr(assoc 1 (entget ename))) "\n"
        ))
    )
  )
  (SetClipBoardText str)
)

Cách sử dụng :

Dùng lệnh Copy2 -> Chọn Text -> Mở Excel -> Nhấn Ctrol+V


<<

Filename: 320681_copy2.lsp
Tác giả: gia_bach
Bài viết gốc: 320543
Tên lệnh: setx getx
LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

Ví dụ tham khảo : 

(defun c:setX (/ ent)
  (setq XData_name "DuongOng_Xdata" dg_kinh 52 ch_dai 4500)
  (if (setq ent (entsel "\nSelect Object: "))
    (progn
      (vla-setXData
	(vlax-ename->vla-object (car ent))
	(vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 2)) (list 1001 1070 1040) )
	(vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 2))
	  (list (vlax-make-variant XData_name)
		(vlax-make-variant...
>>

Ví dụ tham khảo : 

(defun c:setX (/ ent)
  (setq XData_name "DuongOng_Xdata" dg_kinh 52 ch_dai 4500)
  (if (setq ent (entsel "\nSelect Object: "))
    (progn
      (vla-setXData
	(vlax-ename->vla-object (car ent))
	(vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 2)) (list 1001 1070 1040) )
	(vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 2))
	  (list (vlax-make-variant XData_name)
		(vlax-make-variant dg_kinh)		
		(vlax-make-variant ch_dai)) ) ) ) )
  (princ))
(defun c:getX (/ ent typ val)
  (if (setq ent (entsel "\nSelect Object: "))
    (progn
      (vla-getXData (vlax-ename->vla-object (car ent)) "" 'typ 'val)
      (if (or (not typ) (not val))
	(princ "\n** No XData Found **")
	(print (apply 'mapcar (cons 'cons (list (vlax-safearray->list typ)
						(mapcar 'vlax-variant-value
							(vlax-safearray->list val)))))))))
  (princ))

<<

Filename: 320543_setx_getx.lsp
Tác giả: anhduccec
Bài viết gốc: 320750
Tên lệnh: fdima fdimb fdimc
"yêu cầu" Lisp thay đổi font dim hàng loạt
Dựa theo lisp của Ketxu trong bài này: http://www.cadviet.com/forum/topic/53208-yeu-cau-lisp-thay-doi-chieu-cao-text-cua-dimstyle-cuc-nhanh/
Xin phép  Ketxu sửa lại giúp chủ thớt:

;;; 1. Change cho toan bo DimStyle trong ban ve :
(defun c:fdima (/ table ts)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(command "undo"...
>>
Dựa theo lisp của Ketxu trong bài này: http://www.cadviet.com/forum/topic/53208-yeu-cau-lisp-thay-doi-chieu-cao-text-cua-dimstyle-cuc-nhanh/
Xin phép  Ketxu sửa lại giúp chủ thớt:

;;; 1. Change cho toan bo DimStyle trong ban ve :
(defun c:fdima (/ table ts)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(command "undo" "be")
(defun table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))))
(setq ts (getstring "\nText Style: "))
(setvar "cmdecho" 0)
(mapcar '(lambda(x)(command "-DIMSTYLE" "R" x)(setvar "DIMTXSTY" ts)(command "-DIMSTYLE" "S" x "Y")) (table "DIMSTYLE"))
(command "undo" "en")(princ))

;;; 2. Pick den dau change den do:
(defun c:fdimb (/ lstDstyle ts ent dstyle)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq ts (getstring "\nText Style: "))
(while (setq ent (car (entsel "\n Pick dim :")))
(if (setq dstyle (cdr (assoc 3 (entget ent))))
(if (not (vl-position dstyle lstDstyle))
(progn
(setq lstDstyle (cons dstyle lstDstyle))
(command "-DIMSTYLE" "R" dstyle)(setvar "DIMTXSTY" ts)(command "-DIMSTYLE" "S" dstyle "Y")
)
(princ "\nAlready Dimension Style Picked")
)
)
)
(command "undo" "en")
(princ))
;;;; 3. Chon 1 loat roi change:
(defun c:fdimc (/ lstDstyle ts i ss ent dstyle)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq ts (getstring "\nText Style: ") i 0 ss (ssget (list (cons 0 "DIMENSION"))))
(while (setq ent (ssname ss i))
(if (setq dstyle (cdr (assoc 3 (entget ent))))
(if (not (vl-position dstyle lstDstyle))
(progn
(setq lstDstyle (cons dstyle lstDstyle))
(command "-DIMSTYLE" "R" dstyle)(setvar "DIMTXSTY" ts)(command "-DIMSTYLE" "S" dstyle "Y")
)
)
)
(setq i (1+ i))
)
(command "undo" "en")
(princ))

<<

Filename: 320750_fdima_fdimb_fdimc.lsp
Tác giả: luhaivinh
Bài viết gốc: 320766
Tên lệnh: ggi
[LI]Chương 6 : Bài Tập

Câu 6.Mọi người cho mình hỏi vì sao mình code thế này lisp  không chạy như ý với.  <_<

 

(defun c:ggi(/ #pt);bai 6
  (start)
  (moment)
  (or #so (setq #so 5.0))
  (setq #so (cond ((getreal (strcat "\nNhap so bat dau <" (rtos #so) "> :")))(#so)))
  (or #gso (setq #gso 2.0))
  (setq #gso (cond ((getreal (strcat "\nNhap gia so <" (rtos #gso) "> :")))(#gso)))
  (or #goc (setq #goc 0.0))
  (setq #goc (cond...
>>

Câu 6.Mọi người cho mình hỏi vì sao mình code thế này lisp  không chạy như ý với.  <_<

 

(defun c:ggi(/ #pt);bai 6
  (start)
  (moment)
  (or #so (setq #so 5.0))
  (setq #so (cond ((getreal (strcat "\nNhap so bat dau <" (rtos #so) "> :")))(#so)))
  (or #gso (setq #gso 2.0))
  (setq #gso (cond ((getreal (strcat "\nNhap gia so <" (rtos #gso) "> :")))(#gso)))
  (or #goc (setq #goc 0.0))
  (setq #goc (cond ((getreal (strcat "\nNhap goc nghieng chu <" (rtos #goc) "> :")))(#goc)))
  (or #gocd (setq #gocd 30.0))
  (setq #gocd (cond ((getreal (strcat "\nNhap goc nghieng chu day so <" (rtos #gocd) "> :")))(#gocd)))
  (or #kcach (setq #kcach 10.0))
  (setq #kcach (cond ((getreal (strcat "\nNhap khoang cach giua hai so <" (rtos #kcach ) "> :")))(#kcach)))
  (or #cao (setq #cao 5.0))
  (setq #cao (cond ((getreal (strcat "\nNhap chieu cao chu <" (rtos #cao) "> :")))(#cao)))
  (or #sl (setq #sl 5))
  (setq #sl (cond ((getint (strcat "\nNhap so luong <" (rtos #sl) "> :")))(#sl)))
  (setq #pt (getpoint  "\nChon diem dat:"))
  (repeat #sl
    ((command "text" #pt #cao #goc (rtos #so))
      (setq #so (+ #so #gso))
      (setq #pt (polar #pt (/ (* pi #gocd) 180) #kcach))))
  (end))


<<

Filename: 320766_ggi.lsp
Tác giả: nhoclangbat
Bài viết gốc: 320827
Tên lệnh: cdt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while (setq ss (ssget "+.:E:S" '((0 . "DIMENSION"))))
(if ss
(progn
(setq ename (entget (ssname ss 0)))
(setq txt (rtos (cdr (assoc 42 ename)) 2 0))
(setq edd (car (entsel "\nchon text mun gan:")))
(princ "\n")
(khoi edd (list (cons 1 txt) (cons 62 1)))
)
)
(prompt "chon dim mun  lay kich thuoc:")
)
)
;=============
(defun khoi (ten lst_new /...
>>

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while (setq ss (ssget "+.:E:S" '((0 . "DIMENSION"))))
(if ss
(progn
(setq ename (entget (ssname ss 0)))
(setq txt (rtos (cdr (assoc 42 ename)) 2 0))
(setq edd (car (entsel "\nchon text mun gan:")))
(princ "\n")
(khoi edd (list (cons 1 txt) (cons 62 1)))
)
)
(prompt "chon dim mun  lay kich thuoc:")
)
)
;=============
(defun khoi (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
;;;;;;;

 


<<

Filename: 320827_cdt.lsp
Tác giả: trinhhoanghieu090
Bài viết gốc: 320883
Tên lệnh: lenn
Tập tành viết lisp mong các bro tư vấn

Dear các bro!

 

Trong lúc rảnh rỗi tập tành viết lisp, sản phẩm của em đây các bác ạ:

 

(defun c:lenn()

(or *dl* (setq *dl* 350))
(setq dl (getreal (strcat "\n Nhap chieu dai moi <"
			  (rtos *dl* 2 2)
			 "> :"
		  )
	 )
)
(if (not dl) (setq dl *dl*) (setq *dl* dl))
 (princ "Chon Day Neo Can Thay Doi Chieu Dai: ")
 (setq ss (ssget))
(command ".LENGTHEN" "T" dl ss )
)

Đây là cái...

>>

Dear các bro!

 

Trong lúc rảnh rỗi tập tành viết lisp, sản phẩm của em đây các bác ạ:

 

(defun c:lenn()

(or *dl* (setq *dl* 350))
(setq dl (getreal (strcat "\n Nhap chieu dai moi <"
			  (rtos *dl* 2 2)
			 "> :"
		  )
	 )
)
(if (not dl) (setq dl *dl*) (setq *dl* dl))
 (princ "Chon Day Neo Can Thay Doi Chieu Dai: ")
 (setq ss (ssget))
(command ".LENGTHEN" "T" dl ss )
)

Đây là cái lisp thay đổi chiều dài một đoạn thẳng bằng cách nhập tổng chiều dài mới vào. Mong các bro chỉ giáo chỉnh sửa chút sao cho chọn đoạn thẳng đến đâu nó thay đổi luôn chiều dài đến đó như lệnh " Lengthen" chứ không đợi mình chọn tất cả các đối tượng bấm enter nó mới thay đổi hàng loạt.

 

 


<<

Filename: 320883_lenn.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 320885
Tên lệnh: lenn
[Autolisp] Tập tành viết lisp mong các bro tư vấn

Sửa lại như thế này:

(defun c:lenn()
 (or *dl* (setq *dl* 350))
 (setq dl (getreal (strcat "\n Nhap chieu dai moi <"(rtos *dl* 2 2) ">: ")))
 (if (not dl) (setq dl *dl*) (setq *dl* dl))
 (while (setq ent (car (entsel "Chon Day Neo Can Thay Doi Chieu Dai: ")))
  (command ".LENGTHEN" "T" dl ent "")))
 


Filename: 320885_lenn.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 320905
Tên lệnh: lenn
Tập tành viết lisp mong các bro tư vấn

Bác @ hieptr nói quá chuẩn đi.
Cho em hỏi các bro thêm chút xíu. Bây giờ em có một đoạn thẳng là line hoặc pline. Gọi biến ta tb là biến tọa độ 2 đầu đoạn thẳng đó. Các bác viết giúp em mấy dòng code sao cho khi chọn vào đoạn thẳng điểm gần vị trí chọn hơn là tb còn đầu còn...

>>

Bác @ hieptr nói quá chuẩn đi.
Cho em hỏi các bro thêm chút xíu. Bây giờ em có một đoạn thẳng là line hoặc pline. Gọi biến ta tb là biến tọa độ 2 đầu đoạn thẳng đó. Các bác viết giúp em mấy dòng code sao cho khi chọn vào đoạn thẳng điểm gần vị trí chọn hơn là tb còn đầu còn lại.

Giả sử bạn thử sửa lại như sau xem sao. Với lại, chịu khó thank bằng nút xanh cho tiện.

(defun c:lenn()
 (or *dl* (setq *dl* 350))
 (setq dl (getreal (strcat "\n Nhap chieu dai moi <"(rtos *dl* 2 2) ">: ")))
 (if (not dl) (setq dl *dl*) (setq *dl* dl))
 (command ".LENGTHEN" "T" dl))
 

<<

Filename: 320905_lenn.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 320925
Tên lệnh: roo
Tập tành viết lisp mong các bro tư vấn

Đây!

(defun c:roo(/ dt ent lst p px pg)
 (vl-load-com)
 (setq dt (entsel "Chon doi tuong can quay: "))
 (setq p (cadr dt)
       ent (car dt)
       lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (or (= (car x) 10) (= (car x) 11))) (entget ent))))
 (if (> (distance p (setq px (car lst))) (distance p (setq pg (cadr lst))))
  (command ".rotate" ent "" px "r" px pg)
  (command ".rotate" ent "" pg "r" pg px)))
 

Filename: 320925_roo.lsp
Tác giả: Tot77
Bài viết gốc: 320927
Tên lệnh: ve
LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

 Sửa lsp ve.lsp theo yêu cầu số 1 của haanh.

 
(defun c:VE(/ lst_va old D ss lst_TC_DUC cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs"...
>>

 Sửa lsp ve.lsp theo yêu cầu số 1 của haanh.

 
(defun c:VE(/ lst_va old D ss lst_TC_DUC cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
)
)
    (setq *error* temperr)
(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(setq lst_TC_DUC '((12 . 26.0) (18 . 35.0) (22 . 40.0) (28 . 50.0) (35 . 55.0) (40 . 60.0) (52 . 70.0) (70 . 80.0)
  (85 . 90.0) (104 . 100.0) (129 . 187.5) (154 . 225.0) (204 . 300.0) (254 . 375.0))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (getdist (strcat "\nNhap duong kinh ong <"
(apply 'strcat (mapcar '(lambda (x) (strcat (itoa (car x)) " ")) lst_TC_DUC)) ">:"))
      Lay (cdr (assoc D lst_fi_tcduc))
      cao_tam_cut (cdr (assoc D lst_TC_DUC))
)
;=================
(prompt "\nChon 3DPOLY: ")
(setq ss (ssget "+.:E:S" '((0 . "POLYLINE"))))
(if (and
D
(member D (mapcar 'car lst_TC_DUC))
ss)
(progn
(or #lan_ve (setq #lan_ve 0))
(setq #lan_ve (1+ #lan_ve))
;ve cut mau:
(setq net (getvar "clayer"))
(if (tblsearch "layer" (strcat "Cut_" lay)) 
(setvar "clayer" (strcat "Cut_" lay)) 
(command "layer" "m" (strcat "Cut_" lay) "c" "t" "45,159,225" "" "")
) ;if
(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
(setq path (entlast))
(command "circle" '(0 0 0) (setq R (/ D 2.0)))
(command "sweep" (entlast) "" path)
(setq cut (entlast))
(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
;== xong cut mau ==
(if (tblsearch "layer" (strcat "Ong_" lay)) 
(setvar "clayer" (strcat "Ong_" lay)) 
(command "layer" "m" (strcat "Ong_" lay) "c" "t" "133,230,244" "" "")
) ;if 
;Luu UCS:
(command "ucs" "na" "s" "save1_ucs")
;(command "-view" "s" "save_v")
;*******************************
(setq lst_ver (acet-geom-vertex-list (setq ename (ssname ss 0)))
 lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
 obj (vlax-ename->vla-object ename))
(setq i 0
 ss_ong (ssadd)
 ss_cut (ssadd)
 )
(repeat (setq n (1- (length lst_w)))
(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
(cond
((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut  
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
) 
(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut))) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut 
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
)
(setq i (1+ i))
) ;repeat
(command ".ERASE" cut "")
(command ".ERASE" path "")
(command ".ERASE" ss "")
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
(setvar "clayer" net)
)
(alert "***** Nhap du lieu chua dung ! *****")
)
(command ".undo" "end")
(setq *error* temperr) ;tra ham erorr nguyen thuy
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
 new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
(setq new (ssadd pre new)
 moc pre)
) ;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
 huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
 huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
 huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
((and 
(equal huong_12_xoy huong_ab_xoy 1e-5) 
(equal huong_12_yoz huong_ab_yoz 1e-5)
(equal huong_12_xoz huong_ab_xoz 1e-5)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ "\nAlign = Copy ! ")
(princ)
)
(t 
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_2)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
)
)
;========================================================
((and 
(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(setq pt_phu2_2d
(polar 
base 
(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
(distance base (list (car anh_c) (cadr anh_c)))
)
pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
)
(t 
(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
)
)
;==================================================================
(t 
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_3)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
(t
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0)
 pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu2_w (trans pt_phu2 1 0))
(command "ucs" "3p" pt_1 pt_2 pt_phu)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1)) 
(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
)
(setq pt_phu_2d 
(polar 
base 
(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
 pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
 pt_phu_w_3d (trans pt_phu_3d 1 0))
(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
)
)
)
)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
;(command "-view" "r" "save_v")
;(command "-view" "d" "save_v")
(mapcar 'setvar lst_va old)
(princ)
)
 

<<

Filename: 320927_ve.lsp
Tác giả: Tot77
Bài viết gốc: 320931
Tên lệnh: tko tkc
LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

Sửa lsp tko_tkc. Tôi thấy k cần group nó lại vì nếu group thì lần sau nhỡ quơ nhầm nó thì nó sẽ tính 2 lần. Vả lại bây giờ các ống cút đã nằm trong các layer khác nhau rồi, nó sẽ phân biệt theo layer.

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va...
>>

Sửa lsp tko_tkc. Tôi thấy k cần group nó lại vì nếu group thì lần sau nhỡ quơ nhầm nó thì nó sẽ tính 2 lần. Vả lại bây giờ các ống cút đã nằm trong các layer khác nhau rồi, nó sẽ phân biệt theo layer.

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
 
(setq sam (assoc 8 (entget (car (entsel "\nChon ong mau: "))))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (caar (vl-remove-if-not '(lambda (x) (vl-string-search (cdr x) (cdr sam))) lst_fi_tcduc))
)
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam))
      lst (ss2lst ss)
      tong 0)
(foreach elem lst
(command ".area" "o" elem)
(setq S (getvar 'area)
     L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
     tong (+ L tong))
) ;for
;;;(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam)))
;;;(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
 i (1+ i)
 lst (cons ename lst))
)
(reverse lst)
)
 

<<

Filename: 320931_tko_tkc.lsp
Tác giả: ketxu
Bài viết gốc: 320558
Tên lệnh: ten lenh cua ban
Đánh cos cao độ tự động

- Lisp vẫn dùng cho Dynamic bình thường đó chứ bạn. Chẳng qua bạn chưa để ý mình note là nó lấy cái Att đâù tiên mà nó lấy được, chứ k phải cái Att đầu tiên / duy nhất mà bạn thấy được. Bạn thử vơí 3 cos thì sẽ hiểu

- Làm được nhảy cả 3, nhưng để mình nghiên cứu có nên cho vào không, vì mình chưa muốn đổ đồng tăng tât cả mọi thứ mà nó thấy được

-...

>>

- Lisp vẫn dùng cho Dynamic bình thường đó chứ bạn. Chẳng qua bạn chưa để ý mình note là nó lấy cái Att đâù tiên mà nó lấy được, chứ k phải cái Att đầu tiên / duy nhất mà bạn thấy được. Bạn thử vơí 3 cos thì sẽ hiểu

- Làm được nhảy cả 3, nhưng để mình nghiên cứu có nên cho vào không, vì mình chưa muốn đổ đồng tăng tât cả mọi thứ mà nó thấy được

- Code mình đã gửi cho mấy bạn rồi, để phát triển thôi. Không biêts các bạn âý có nhã hứng chỉnh theo yêu cầu này không, vào giúp Ket vơí :(. Còn đổi tên lệnh thì k dùng đến code. Bạn chỉ cần viết như thế này :

 

(defun c:ten_lenh_cua_ban()(c:dccd))
 

P/s : nếu là mình, mình sẽ làm cos cao độ của bạn bằng Mtext, hoặc Dynamic Ảrray, chứ k giơí hạn 3 cos vâỵ đâu ^^


<<

Filename: 320558_ten_lenh_cua_ban.lsp
Tác giả: Tot77
Bài viết gốc: 321038
Tên lệnh: tko tkc
LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi...

>>

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi mấy rồi.

2. Về tko_tkc

haanh thích union cũng chẳng có gì, chọn hết 1 loại ống trong bản vẽ rồi union nó lại.Dĩ nhiên khi đó thống kê trên toàn bộ bản vẽ chứ không phải 1 nhóm.

3. Cadviet dạo này cũng có ma rồi sao?  :o  :o

 
(defun c:VE(/ lst_va old ss sss lst_TC_DUC lst_fi_tcduc D1 cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
)
)
    (setq *error* temperr)
(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(setq lst_TC_DUC '((12 . 26.0) (18 . 35.0) (22 . 40.0) (28 . 50.0) (35 . 55.0) (40 . 60.0) (52 . 70.0) (70 . 80.0)
  (85 . 90.0) (104 . 100.0) (129 . 187.5) (154 . 225.0) (204 . 300.0) (254 . 375.0))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D1 (getdist (strcat "\nNhap duong kinh ong <"
 (if D (rtos D) "") ">:"))
)
(if D1 (setq D D1))
(setq  Lay (cdr (assoc D lst_fi_tcduc))
       cao_tam_cut (cdr (assoc D lst_TC_DUC))
)
;=================
(prompt "\nChon 3DPOLY: ")
(setq sss (ssget '((0 . "POLYLINE"))))
(if (and D
(member D (mapcar 'car lst_TC_DUC))
sss)
(foreach ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))) 
(or #lan_ve (setq #lan_ve 0))
(setq #lan_ve (1+ #lan_ve))
;ve cut mau:
(setq net (getvar "clayer"))
(if (tblsearch "layer" (strcat "Cut_" lay)) 
(setvar "clayer" (strcat "Cut_" lay)) 
(command "layer" "m" (strcat "Cut_" lay) "c" "t" "45,159,225" "" "")
) ;if
(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
(setq path (entlast))
(command "circle" '(0 0 0) (setq R (/ D 2.0)))
(command "sweep" (entlast) "" path)
(setq cut (entlast))
(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
;== xong cut mau ==
(if (tblsearch "layer" (strcat "Ong_" lay)) 
(setvar "clayer" (strcat "Ong_" lay)) 
(command "layer" "m" (strcat "Ong_" lay) "c" "t" "133,230,244" "" "")
) ;if 
;Luu UCS:
(command "ucs" "na" "s" "save1_ucs")
;(command "-view" "s" "save_v")
;*******************************
(setq lst_ver (acet-geom-vertex-list (setq ename ss))
 lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
 obj (vlax-ename->vla-object ename))
(setq i 0
 ss_ong (ssadd)
 ss_cut (ssadd)
 )
(repeat (setq n (1- (length lst_w)))
(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
(cond
((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut  
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
) 
(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut))) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut 
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
)
(setq i (1+ i))
) ;repeat
(command ".ERASE" cut "")
(command ".ERASE" path "")
(command ".ERASE" ss "")
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
(setvar "clayer" net)
)
(alert "***** Nhap du lieu chua dung ! *****")
)
(command ".undo" "end")
(setq *error* temperr) ;tra ham erorr nguyen thuy
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
 new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
(setq new (ssadd pre new)
 moc pre)
) ;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
 huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
 huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
 huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
((and 
(equal huong_12_xoy huong_ab_xoy 1e-5) 
(equal huong_12_yoz huong_ab_yoz 1e-5)
(equal huong_12_xoz huong_ab_xoz 1e-5)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ "\nAlign = Copy ! ")
(princ)
)
(t 
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_2)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
)
)
;========================================================
((and 
(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(setq pt_phu2_2d
(polar 
base 
(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
(distance base (list (car anh_c) (cadr anh_c)))
)
pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
)
(t 
(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
)
)
;==================================================================
(t 
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_3)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
(t
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0)
 pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu2_w (trans pt_phu2 1 0))
(command "ucs" "3p" pt_1 pt_2 pt_phu)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1)) 
(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
)
(setq pt_phu_2d 
(polar 
base 
(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
 pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
 pt_phu_w_3d (trans pt_phu_3d 1 0))
(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
)
)
)
)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
(mapcar 'setvar lst_va old)
(princ)
)
 

 

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
 
(setq sam (assoc 8 (entget (car (entsel "\nChon ong mau: "))))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (caar (vl-remove-if-not '(lambda (x) (vl-string-search (cdr x) (cdr sam))) lst_fi_tcduc))
)
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam))
      lst (ss2lst ss)
      tong 0)
(foreach elem lst
(command ".area" "o" elem)
(setq S (getvar 'area)
     L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
     tong (+ L tong))
) ;for
;;;(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(command "union" ss "")
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam)))
;;;(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(command "union" ss "")
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
 i (1+ i)
 lst (cons ename lst))
)
(reverse lst)
)
 

<<

Filename: 321038_tko_tkc.lsp
Tác giả: Tot77
Bài viết gốc: 321038
Tên lệnh: ve
LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi...

>>

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi mấy rồi.

2. Về tko_tkc

haanh thích union cũng chẳng có gì, chọn hết 1 loại ống trong bản vẽ rồi union nó lại.Dĩ nhiên khi đó thống kê trên toàn bộ bản vẽ chứ không phải 1 nhóm.

3. Cadviet dạo này cũng có ma rồi sao?  :o  :o

 
(defun c:VE(/ lst_va old ss sss lst_TC_DUC lst_fi_tcduc D1 cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
)
)
    (setq *error* temperr)
(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(setq lst_TC_DUC '((12 . 26.0) (18 . 35.0) (22 . 40.0) (28 . 50.0) (35 . 55.0) (40 . 60.0) (52 . 70.0) (70 . 80.0)
  (85 . 90.0) (104 . 100.0) (129 . 187.5) (154 . 225.0) (204 . 300.0) (254 . 375.0))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D1 (getdist (strcat "\nNhap duong kinh ong <"
 (if D (rtos D) "") ">:"))
)
(if D1 (setq D D1))
(setq  Lay (cdr (assoc D lst_fi_tcduc))
       cao_tam_cut (cdr (assoc D lst_TC_DUC))
)
;=================
(prompt "\nChon 3DPOLY: ")
(setq sss (ssget '((0 . "POLYLINE"))))
(if (and D
(member D (mapcar 'car lst_TC_DUC))
sss)
(foreach ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))) 
(or #lan_ve (setq #lan_ve 0))
(setq #lan_ve (1+ #lan_ve))
;ve cut mau:
(setq net (getvar "clayer"))
(if (tblsearch "layer" (strcat "Cut_" lay)) 
(setvar "clayer" (strcat "Cut_" lay)) 
(command "layer" "m" (strcat "Cut_" lay) "c" "t" "45,159,225" "" "")
) ;if
(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
(setq path (entlast))
(command "circle" '(0 0 0) (setq R (/ D 2.0)))
(command "sweep" (entlast) "" path)
(setq cut (entlast))
(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
;== xong cut mau ==
(if (tblsearch "layer" (strcat "Ong_" lay)) 
(setvar "clayer" (strcat "Ong_" lay)) 
(command "layer" "m" (strcat "Ong_" lay) "c" "t" "133,230,244" "" "")
) ;if 
;Luu UCS:
(command "ucs" "na" "s" "save1_ucs")
;(command "-view" "s" "save_v")
;*******************************
(setq lst_ver (acet-geom-vertex-list (setq ename ss))
 lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
 obj (vlax-ename->vla-object ename))
(setq i 0
 ss_ong (ssadd)
 ss_cut (ssadd)
 )
(repeat (setq n (1- (length lst_w)))
(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
(cond
((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut  
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
) 
(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut))) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut 
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
)
(setq i (1+ i))
) ;repeat
(command ".ERASE" cut "")
(command ".ERASE" path "")
(command ".ERASE" ss "")
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
(setvar "clayer" net)
)
(alert "***** Nhap du lieu chua dung ! *****")
)
(command ".undo" "end")
(setq *error* temperr) ;tra ham erorr nguyen thuy
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
 new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
(setq new (ssadd pre new)
 moc pre)
) ;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
 huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
 huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
 huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
((and 
(equal huong_12_xoy huong_ab_xoy 1e-5) 
(equal huong_12_yoz huong_ab_yoz 1e-5)
(equal huong_12_xoz huong_ab_xoz 1e-5)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ "\nAlign = Copy ! ")
(princ)
)
(t 
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_2)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
)
)
;========================================================
((and 
(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(setq pt_phu2_2d
(polar 
base 
(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
(distance base (list (car anh_c) (cadr anh_c)))
)
pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
)
(t 
(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
)
)
;==================================================================
(t 
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_3)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
(t
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0)
 pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu2_w (trans pt_phu2 1 0))
(command "ucs" "3p" pt_1 pt_2 pt_phu)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1)) 
(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
)
(setq pt_phu_2d 
(polar 
base 
(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
 pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
 pt_phu_w_3d (trans pt_phu_3d 1 0))
(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
)
)
)
)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
(mapcar 'setvar lst_va old)
(princ)
)
 

 

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
 
(setq sam (assoc 8 (entget (car (entsel "\nChon ong mau: "))))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (caar (vl-remove-if-not '(lambda (x) (vl-string-search (cdr x) (cdr sam))) lst_fi_tcduc))
)
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam))
      lst (ss2lst ss)
      tong 0)
(foreach elem lst
(command ".area" "o" elem)
(setq S (getvar 'area)
     L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
     tong (+ L tong))
) ;for
;;;(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(command "union" ss "")
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam)))
;;;(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(command "union" ss "")
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
 i (1+ i)
 lst (cons ename lst))
)
(reverse lst)
)
 

<<

Filename: 321038_ve.lsp
Tác giả: luhaivinh
Bài viết gốc: 321263
Tên lệnh: vcthan
[LI]Chương 6 : Bài Tập

Mọi người tìm giúp chổ nào sai xót giúp với.

Khi thử từng đoạn code lần lượt thì ok. nhưng khi gõ lệnh thì có vấn đề. :(

 

(defun getvalue1 ( a gtri dongnhac) 
(or a (setq a gtri))
(if (numberp a) (setq a (cond ((getreal (strcat "\n" dongnhac "<" (rtos a 2 0) "> :")))(a)))))
(defun getvalue2 ( a gtri dongnhac)
(or a (setq a gtri))
(if (numberp a) (setq a (cond ((getint (strcat "\n" dongnhac...
>>

Mọi người tìm giúp chổ nào sai xót giúp với.

Khi thử từng đoạn code lần lượt thì ok. nhưng khi gõ lệnh thì có vấn đề. :(

 

(defun getvalue1 ( a gtri dongnhac) 
(or a (setq a gtri))
(if (numberp a) (setq a (cond ((getreal (strcat "\n" dongnhac "<" (rtos a 2 0) "> :")))(a)))))
(defun getvalue2 ( a gtri dongnhac)
(or a (setq a gtri))
(if (numberp a) (setq a (cond ((getint (strcat "\n" dongnhac "<" (rtos a 2 0) "> :")))(a)))))  
(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar "cmdecho" oldcm)
  (setvar "osmode" oldos)
  (setvar "angbase" oldab)
  (setvar "angdir" oldad))
(defun moment()
  (setvar "cmdecho" 0)
  (setvar "osmode" 681)
  (setvar "angbase" 0)
  (setvar "angdir" 0))

(defun c:vcthan(/ ^pt1 ^pt2 ^pt3 n);Ve cau thang
  (start)
  (moment)
  (initget 1 "K B G")
  (setq kieu (getkword (strcat "\nKichthuocbac+sobac Berongbac+sobac+chieucaonha Gocnghieng+sobac+chieucaonha <K B G>:")))
  (setq n 0)
  (if (= kieu "K")(progn
		     (setq ^sluong (getvalue2 ^sluong 10 "Nhap so luong bac thang"))
		     (setq ^cao (getvalue1 ^cao 20 "Nhap chieu cao bac thang"))
		     (setq ^rong (getvalue1 ^rong 25 "Nhap chieu rong bac thang"))	     
		     (setq ^pt1 (getpoint "\nChon diem dat:"))		     
		     (repeat ^sluong
		       (setq ^pt2 (polar ^pt1 (/ pi 2) ^cao))
		       (setq ^pt3 (polar ^pt2 0 ^rong))
		       (setq n (1+ n))
		       (command ".line" ^pt1 ^pt2 ^pt3 "")		       
		       (command ".text" ^pt2 (/ ^cao 2) 0 (itoa n) "")
		     (setq ^pt1 ^pt3))))
  (if (= kieu "B")(progn
		     (setq ^sluong (getvalue2 ^sluong 10 "Nhap so luong bac thang"))
		     (setq ^caon (getvalue1 ^caon 90 "Nhap chieu cao nha")) 
		     (setq ^rong (getvalue1 ^rong 25 "Nhap chieu rong bac thang"))	     
		     (setq ^pt1 (getpoint "\nChon diem dat:"))
		     (repeat ^sluong
		       (setq ^pt2 (polar ^pt1 (/ pi 2) (/ ^caon ^sluong)))
		       (setq ^pt3 (polar ^pt2 0 ^rong))
		       (setq n (1+ n))
		       (command ".line" ^pt1 ^pt2 ^pt3 "")
		       (command ".text" ^pt2 (/ ^caon ^sluong 2) 0 (itoa n) "")
		       (setq ^pt1 ^pt3))))
  (if (= kieu "G")(progn
		     (setq ^sluong (getvalue2 ^sluong 10 "Nhap so luong bac thang"))
		     (setq ^caon (getvalue1 ^caon 90 "Nhap chieu cao nha"))
		     (setq ^nghieng (getvalue1 ^nghieng 30 "Nhap goc nghieng bac thang"))	     
		     (setq ^pt1 (getpoint "\nChon diem dat:"))
		     (repeat ^sluong
		       (setq ^pt2 (polar ^pt1 (/ pi 2) (/ ^caon ^sluong)))
		       (setq ^pt3 (polar ^pt2 0 (/ (/ ^caon ^sluong) (atan (/(* pi ^nghieng) 180)))))
		       (setq n (1+ n))
		       (command ".line" ^pt1 ^pt2 ^pt3 "")
		       (command ".text" ^pt2 (/ ^caon ^sluong 2) 0 (itoa n) "")
		       (setq ^pt1 ^pt3))))

  (end))




<<

Filename: 321263_vcthan.lsp

Trang 181/330

181