Chuyển đến nội dung
Diễn đàn CADViet

nokia

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    9

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi nokia

  1. Đã đăng · Trả lời báo cáo

    Em đã làm thử bằng cách vẽ khối hộp chữ nhật đặc bằng lệnh BOX >> EXPLODE phá vỡ khối solid >> EXPLODE phá vỡ tiếp faces >>> Vẽ loằng ngoằng các đường thẳng có cao độ Z khác 0 >>> Thực hiện lệnh Flatten ngon lành.

    Anh nên cài CAD2011 dùng cho sướng, tội gì phải dùng CAD đời cũ cho khổ ra!

    Command: Flatten

    Select objects to convert to 2d...

    Select objects: Specify opposite corner: 42 found

    Select objects:

    Remove hidden lines? <No>:

    Command:

    Flatten là dùng để convert 3D => 2D còn ý của bạn Hnam1210 yêu cầu là chuyển Start Z và elevation về 0. 2 cái khác nhau

  3. Đã đăng · Trả lời báo cáo

    Cần phải thêm dòng

    (or *z1* (setq *z1* 10.0))

    Vào trên dòng

    (setq z1...

    Tương tự với z2

    ;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
 (setq temperr *error*)
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :") L '())
 ;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(or *z1* (setq *z1* 10.0))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(or *z2* (setq *z2* 10.0))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
 (setq dis (distance p1 p2)
ang (angle p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))

(setq m (getint "\n So phan tu nam giua A va B :") i 0) ; => em khong biet bo sung luu gia tri, vì là getint ?
(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string cao) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :"))  ;
 (Setq oldos (getvar "OSMODE"))
 (SETVAR "OSMODE" 0)
 (Repeat (+ m 2)
 (setq p (polar p1 ang (* i (/ dis (1+ m)))))
 (setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)    
(progn (setq Z (+ Z1 (* tana (- a) )))
 (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z1 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)    
(progn (setq Z (+ Z2 (* tana (- a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z2 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
(command "point" p)
(setq i (1+ i))
 );while
(COMMAND "LINE" P1 P2 "")
  (if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
 (vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
  (SETVAR "OSMODE" oldos)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq  ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
 (cons 72 1) (cons 73 1)
 )
)
)

     

    hihi. Được 80% rùi ạ. Còn cái lưu giá trị số phần tử nằm giữa AB thì e thua rùi. vì nó là getint ? help me !

  4. Đã đăng · Trả lời báo cáo

    Trong những lisp viết theo yêu cầu của bạn đã có hàng đống cái có lưu giá trị nhập lần trước, bạn hãy vẫn động đi :) Bạn không rút ra được điều gì sau topic gần đây sao ??

    http://www.cadviet.c...opic=56841&st=0

    hi. Bác mắng em cũng đúng. Quả thật thì e đã bê cái lưu giá trị lần trước vào rồi nhưng nó không chạy nên e phải nhờ bác. hức hức. Tang chứng vật chứng vẫn còn đây ạ , chú ý rằng e chỉ copy paste và đổi tên biến chứ e ko hiểu nhìu về lisp đâu ạ.

    ;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
 (setq temperr *error*)
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :") L '())
 ;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
 (setq dis (distance p1 p2)
ang (angle p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
 (setq m (getint "\n So phan tu nam giua A va B :") i 0) ; => em khong biet bo sung luu gia tri, vì là getint ?
(or cao (setq cao 10)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string #dist) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :"))  ;
 (Setq oldos (getvar "OSMODE"))
 (SETVAR "OSMODE" 0)
 (Repeat (+ m 2)
 (setq p (polar p1 ang (* i (/ dis (1+ m)))))
 (setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)      
  	(progn (setq Z (+ Z1 (* tana (- a) )))
		(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
 	(progn (setq Z (+ Z1 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)      
  	(progn (setq Z (+ Z2 (* tana (- a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
 	(progn (setq Z (+ Z2 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
(command "point" p)
(setq i (1+ i))
 );while
(COMMAND "LINE" P1 P2 "")
  (if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
		(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
  	) L (reverse L) )))
  (SETVAR "OSMODE" oldos)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq  ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
 (cons 72 1) (cons 73 1)
 )
)
)

  5. Đã đăng · Trả lời báo cáo

    Lisp quá tuyệt vời bác. Thanks bác nhiều lắm. Nhờ lisp này mà mình đỡ tốn một khoản thời gian chuyển cad-> pdf. Mình cũng đã viết một lisp về in nhưng khá thủ công và không thể Multiple như của bác đựơc. Sao mình không thấy nút "Thanks" chỗ nào nhĩ. Một lần nữa xin cảm ơn nhuyentuyen

    Các bác PRO sửa giúp cái mục Preview của lisp này với ạ ? Lisp rất hay nhưng lỗi chức năng đó

  6. Đã đăng · Trả lời báo cáo

    Hề hề hề,

    Vì thế nên mới (command "insert" new p 1 "" "") cho khỏi scale hay xoay xiếc chi nữa. Các cái linh tinh khác thì hậu xét ạ.

    Hề hề hề,...

    @ bác Doanvanha: Cái thằng osnap này thế mà hay bị quên lắm. Thank bác đã nhắc nhở.....

    úi chết. Cái lisp của bác KETXU xấu xí kia em ko bit dùng nên kết luận oan. hí hí. Xin lỗi bác nhé.

    Cảm ơn các đại ca khác đã tham gia xử vụ rắc rối này. Tiện thể em comment luôn, cái lisp CHBL không đổi tên được, ko bit là e ko bit dùng hay thế nào. Lisp CTB thì đổi ngon lành nhưng mà chỉ được 1 đối tượng, nếu để phát triển lên thì em nghĩ dùng tính năng lưu tên mới vừa nhập thì là ngon. Lisp mabt thì có cái hay riêng. hềhề. Thui hnay 20/10 các bác nghỉ sớm rùi đưa người iu đi nhà nghỉ cho mát. hí hí. cái anh có nick name xấu xí KETXU giải thick rõ và lisp của anh ý viết chuẩn theo yêu cầu rùi. hí hí. Chúc các anh trên diễn đàn mạnh khỏe và có nhìu sáng kiến mới. hí hí. Em có lisp rùi. mang về dùng thui. hề hề

  8. Đã đăng · Trả lời báo cáo

    Mình đã viết 1 cái rồi nhưng chưa nhớ link, post lại cho bạn. Có thể dùng cho cả Anon Block

    ;| Change Anonymous Block to normal with new Name
@ Ketxu 27 - 9 - 2011
|;
(defun c:nb( / blkObj blkName blkNew_Name fn pt)
(vl-load-com)
(defun ST:SS->List-Vla (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
 )
)
(defun change_block(old new)
(foreach blkObj (setq ss (ST:SS->List-Vla (ssget (list (cons 0 "INSERT")(cons 2 old)))))
(vla-put-name blkObj new);;change the name
(vla-update blkObj)
)
)
(grtext -1 "Free Lisp From Cadviet @Ketxu")
(setvar "cmdecho" 0)
(setq
blkObj (vlax-ename->vla-object (car(entsel "\nBlock Source :")))
blkName (vlax-get-property blkObj
(if (vlax-property-available-p blkObj 'EffectiveName) 'EffectiveName 'Name)
 )
blkNew_Name (getstring "\n New Name :")
 fn (strcat (getenv "TEMP") "\\" blkNew_Name ".dwg")
)
(command ".-wblock" fn "_Y" blkName "")
(command "._insert" (strcat blkNew_Name "=" fn) nil )
(if (wcmatch "`*" (substr blkName 1 1))(setq blkName (strcat "`*" (substr blkName 2))))
(change_block blkName blkNew_Name)
(vl-file-delete  fn)
)

    Hề hề. Thick cái điệu cười của cái anh có cái nick xấu như con gấu KETXU này. Nhưng mà lisp a viết a chưa chạy thử rùi ?

    Chẳng may chạy lisp 100 lần thì mới có lần nó đổi được tên. Và cái thứ 2 là em cần chọn 1 lúc nhiều đối tượng để đổi tên ý. Như thế cho nhanh ạ ? E đã post rõ trong yêu cầu rùi ạ. anh kiểm tra lại giúp em nhé. hí hí. CAD ko làm được mà lisp làm được thì thật là cao siêu.hè hè

  9. Đã đăng · Trả lời báo cáo

    Do nhu cầu công việc, em rất cần một lisp đổi tên block cục bộ chứ ko phải giống lệnh rename trong cad, cụ thể em xin diễn đạt như sau:

    Giả sử có 100 đối tượng block, tên của block là CADVIET nếu ta dùng rename của CAD thì 100 đối tượng block đó đều bị đổi tên, nhưng ở đây em chỉ muốn đổi tên 10 block trong số 100 block đó thôi. Như thế sẽ có 10 đối tượng thuộc block có tên mới là LISP chẳng hạn.

    Command: Doiten

    select object: Chọn vào 10 block muốn đổi tên

    new name: LISP

    => kết quả là 10 đối tượng block được chọn đó được đổi tên từ CADVIET Sang LISP.

    Rất mong các anh trên diễn đàn quan tâm giúp đỡ. Em xin chân thành cảm ơn !

×