| Info | File |
Tác giả: mr.nguyen08ql
Bài viết gốc: 169214
Tên lệnh: hcn |
Vẽ hình chữ nhật
Đầy mình gửi bạn lisp này,nó gán layer thep làm layer để vẽ hình chữ nhật
(defun c:hcn ()
(setq luubatdiem (getvar...
>>
Đầy mình gửi bạn lisp này,nó gán layer thep làm layer để vẽ hình chữ nhật
(defun c:hcn ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "begin")
(command "-layer" "m" "thep" "c" "1" "" "l" "" "" "")
(setq W (getreal "\n nhap chieu rong(mm):")
H (getreal "\n nhap chieu cao(mm):")
P1 (getpoint "\n chon diem chuan:")
P2 (polar P1 0.00 W)
P3 (polar P2 (/ pi 2) H)
P4 (polar P3 pi W)
p5 (polar p4 (/ pi 2) 21)
p6 (polar p5 (* pi 1.75) 66)
p7 (polar p4 pi 21)
p8 (polar p7 (* pi 1.75) 66)
)
(command "pline" p8 p7 p4 p3 p2 p1 p4 p5 p6 "")
(setvar "osmode" luubatdiem)
(command "undo" "end")
(princ)
)
khi mình tạo ra 3 layer thì mình muốn gán 1 trong 1 la đó vào đối tượng thì làm thế nào đc ahm, hihihi Dã tâm của em là đang tập gán layer và Dim cho đối tượng.
<<
|
Tác giả: hhhhgggg
Bài viết gốc: 122441
Tên lệnh: xap |
Nhờ cao thủ sửa giúp em đoạn list Explode !
Chào bạn hhhhgggg, Dùng cái ni coi đã vừa ý bạn chưa hỉ.
(defun c:xap ( )
(command "undo" "be")
(setq ssa (ssget (list (cons 0...
>>
Chào bạn hhhhgggg, Dùng cái ni coi đã vừa ý bạn chưa hỉ.
(defun c:xap ( )
(command "undo" "be")
(setq ssa (ssget (list (cons 0 "ACAD_PROXY_ENTITY")))
i 0
n (sslength ssa)
)
(while (< i n)
(setq en (ssname ssa i))
(command "explode" en)
(setq ssl (acet-ss-to-list (ssget "p")))
(foreach x ssl
(command "explode" x "")
)
(setq i (1+ i))
)
(command "undo" "e")
)
PS: khi test với cái bản vẽ bạn gửi thì sau khi chạy lisp nó không ra đúng như cái hình bạn gửi đâu nhé. Việc chỉnh sửa lại nhường cho bạn hỉ.
ok ! chuẩn không cần chỉnh. Cảm ơn bác nhìu nhìu nhé !
<<
|
Tác giả: Ar_Chanwoo
Bài viết gốc: 16324
Tên lệnh: dcl |
Giao diện hộp thoại trong AutoLisp
Cái này cực hay mà lâu quá sao không thấy ai hết. Xin phép bác Hòanh lên tiếng trước nhé
Đây là file layer.DCL
LAYER:dialog...
>>
Cái này cực hay mà lâu quá sao không thấy ai hết. Xin phép bác Hòanh lên tiếng trước nhé
Đây là file layer.DCL
LAYER:dialog {
label="www.cadviet.Dialog000";
spacer_1;
:boxed_radio_column{
label="Cai dat Layer";
:radio_button{
label="Su dung Layer hien huu";
key="IsCuLA";
}
:radio_button{
label="Cai dat Layer";
key="IsSetLA";
}
:popup_list{
key="La";
}
}
ok_cancel;
}
Còn đâ là file LISP
(DEFUN DIALOG000 ()
(setq DCL_ID_DIALOG (load_dialog "layer.DCL"))
(if (not(new_dialog "LAYER" DCL_ID_DIALOG)) (exit))
(action_tile "IsCuLA" "(Is_Chk)")
(action_tile "IsSetLA" "(Is_Chk)")
(mode_tile "La" (atoi IsCuLa))
(action_tile "accept" "(GETOPTVALUE) (done_dialog 1)")
(action_tile "cancel" "(GETOPTVALUE) (done_dialog 2)")
(start_list "La")
(mapcar 'add_list LiLa)
(end_list)
(SETOPTVALUE)
(setq RES(start_dialog))
(if (= 1 RES)
(DOSOMETHING)
(DONOTHING)
)
(unload_dialog DCL_ID_DIALOG)
)
(DEFUN DOSOMETHING(/ msg)
(if (= IsSetLa "1")
(setq la la_temp)
)
(setq msg (strcat "Ban dang lam viec tren layer " (nth (atoi la) LiLa)))
(alert msg)
)
(DEFUN DONOTHING()
(alert "Khong lam gi ca!")
)
(DEFUN INIT()
(CREALILA)
(if (Null IsCuLa)
(setq IsCuLa "1")
)
(if (Null IsSetLa)
(setq IsSetLa "0")
)
(if (Null la)
(setq la "0")
)
)
(DEFUN Is_Chk ()
(if (= (get_tile "IsSetLA") "1")
(mode_tile "La" 0)
(mode_tile "La" 1)
)
)
(DEFUN SETOPTVALUE()
(set_tile "IsCuLA" IsCuLa)
(set_tile "IsSetLA" IsSetLa)
(set_tile "La" la)
)
(DEFUN GETOPTVALUE()
(setq IsCuLa (get_tile "IsCuLA"))
(setq IsSetLa (get_tile "IsSetLA"))
(setq la_temp (get_tile "La"))
)
(DEFUN CREALILA (/ NL)
(setq LiLa (List))
(setq NL (tblnext "LAYER" T))
(while NL
(setq LiLa (append LiLa (list (cdr (assoc 2 NL)))))
(setq NL (tblnext "LAYER"))
)
(setq LiLa (Acad_strlsort LiLa))
)
(DEFUN EXCUTE()
(INIT)
(DIALOG000)
)
(DEFUN C:DCL()
(EXCUTE)
)
Các bạn lấy về chạy với lệnh DCL, đọan code này có chức năng lấy layer hiện hữu
Cách viết của tôi có vẽ hơi dài dòng, tôi cố gắng chia ra thật nhỏ function code để hi vọng các bạn dễ hiểu.
Các câu hỏi các bạn cứ POST lên và tôi sẽ cố gắng trả lời.
E không thể sư dụng đc chức năng cài đặt layer trong lisp của anh đc ! Khi e chuyển đến layer mà e muốn làm việc thì lisp dcl không thể chuyển đc băndf chúc năng cài đặt layer ! Mạc dù lisp có bào là bạn đang làm việc tren lisp mà e vừa chọn !
E có 1 câu hỏi muốn nhò a giúp đỡ : Ví dụ như e có 1 chương trình viết bằng lisp ! Làm thế nào để hạn chế số người dùng vậy anh ! kiểu như ai muốn cài đặt và sử dụng thì phải phone cho mình ấy ! Theo dạng như khi cài lisp vào cad, nó sẽ ăn vào registry và trả ra 1 giá trị nào đó cho người sử dụng biết ! Từ giá tri dó người sử dụng liên hệ với tác giả để có số mã cuối cùng và sử dụng số mã đó để đăng kí sử dụng !
Rất mong anh giúp đỡ !
<<
|
Tác giả: truongthanh
Bài viết gốc: 135197
Tên lệnh: gl |
Cho em hỏi về TOLERANCE!
Mình vẫn chưa hiểu ý bạn nói " cái cần là cái đó " tức là sao ? Tức là bạn cần link để lúc bạn thay đổi nó sẽ đổi theo , hay cần...
>>
Mình vẫn chưa hiểu ý bạn nói " cái cần là cái đó " tức là sao ? Tức là bạn cần link để lúc bạn thay đổi nó sẽ đổi theo , hay cần lấy cái đoạn text ra thôi ?? Nếu cần, có thể tạo lại toàn bộ các TOL này bằng text và HCN bao quanh, rồi link nội dung, e là lâu ^^
Trước hết bạn dùng thử cái này để copy nội dung TOL vào sau đoạn text bạn cần đã
;free lisp from Cadviet.com @ketxu
(defun c:gl ()
(defun chDXF (dxf val ent) (entmod (subst (cons dxf val) (assoc dxf (entget ent)) (entget ent))))
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(princ "\n Chon Tolerance : ")
(while (setq tol (ssname (ssget ":S" '((0 . "TOLERANCE"))) 0))
(setq txt (car(entsel "\n Chon text can ghep ")))
(chdxf 1 (strcat (dxf 1 txt) (vl-string-trim "%%v" (dxf 1 tol))) txt)
))
Do bài trước bạn hỏi có cần link ko nên mình mới nói " cái cần là cái đó ", mình muốn link 2 cái đó chắc là ko dc hả bạn?Hy vọng bạn giúp dùm mình! Lisp kia chỉ lấy text chứ chưa link! Làm phiền bạn nhiều quá!
<<
|
Tác giả: namgiangduy89
Bài viết gốc: 386549
Tên lệnh: ec |
Nhờ Viết Lisp Tọa Độ Theo File Đính Kem
Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D
>>> Xử lý: Bạn Cut đoạn code định...
>>
Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D
>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
(setq point p)
(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
(setq p (list i (car p) (cadr p))
i (1+ i)
lst (cons p lst)))
(if (> (length lst) 2)
(progn
(initget "Cad Excel cadAndexcel")
(setq key (NGT key "Cad" getkword "Enter an option "))
(cond
((wcmatch key "Cad")
(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
(setq base_pnt (getpoint "\nDiem chen: "))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
;;Xong tieu de
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
(setq last_pnt (cdr (last lst)))
;;Xong dong 1
(foreach p (cdr (reverse lst))
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
)
;;Xong cac diem giua
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
;;Xong lap lai dong 1 + k/cach khep
)
((wcmatch key "Excel")
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,X,Y,K/cach (m)" pw)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
(setq last_pnt (cdr (last lst)))
(foreach p (cdr (reverse lst))
(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
(close pw)
)
(t
(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
(setq base_pnt (getpoint "\nDiem chen: "))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
;;Xong tieu de
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
(setq last_pnt (cdr (last lst)))
;;Xong dong 1
(foreach p (cdr (reverse lst))
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
)
;;Xong cac diem giua
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
;;Xong lap lai dong 1 + k/cach khep
;;Xong chen bang trong cad
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,X,Y,K/cach (m)" pw)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
(setq last_pnt (cdr (last lst)))
(foreach p (cdr (reverse lst))
(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
(close pw)
)
)
)
(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
(modul)
(a)
)
)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))
(cons 10 PT1) (cons 11 PT2)
(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq pnt2 (polar base_pnt 0 celwidth)
pnt3 (polar pnt2 (* 1.5 pi) celheight)
pnt4 (polar pnt3 pi celwidth)
)
(if justify (setq justify (strcase justify)))
(cond
((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
((wcmatch justify "TL") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
((wcmatch justify "TC") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
((wcmatch justify "TR") (setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
((wcmatch justify "ML") (setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
((wcmatch justify "MR") (setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)
;===================================
(defun MakeText (string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(cons 50 (if Ang Ang 0))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
;justify (strcase justify)
)
(cond ((= 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)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
)
(entmakex Lst)
);end
;=================================
p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.
Phải chăng là do mình đã để ngõ tham số point trong đó.
Cảm ơn bác hiepttr nhiều cơ bản lisp đã gần đúng ý em, em đã text và nhờ bác chỉnh lại cho em tí.
1. Khoảng cách các cột Tọa độ X,Y , K/CÁCH hơi rộng
2. Các Text chưa được canh giữa.
3. Phần câu lệnh xuất bảng kết quả sang Cad thì đã Ok, còn xuất sang Excel em đã làm nhưng xuất sang excel nhìn rất rối( các số gộp lại chung một cột) bác có cách nào khắc phục không, nếu không bác chuyển qua định dạng TXT luôn để e chuyển vào máy toàn đạt cắm mốc luôn.
4. Câu lênh xuất kết quả trên Cad và excel thì chỉ thấy kết quả trên cad còn trên Excel không thấy dấu hiệu gì.
Tiện thể mình gỡi Bác File cad mình bố trí bảng kết quả để bác chỉnh lại kích thước cho phù hợp
http://www.cadviet.com/upfiles/5/133575_b2_03.dwg
<<
|
Tác giả: Doan Van Ha
Bài viết gốc: 386450
Tên lệnh: ec |
Nhờ Viết Lisp Tọa Độ Theo File Đính Kem
Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D
>>> Xử lý: Bạn Cut đoạn code định...
>>
Lỗi là do hàm MakeText chưa được load _ mình cũng không hiểu vì sao :D :D :D
>>> Xử lý: Bạn Cut đoạn code định nghĩa hàm MakeText >>> paste xuống cuối cùng nhé !
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/154743-nha-via-t-lisp-ta-a-a-theo-file-a-nh-kem/
(defun c:EC( / i p point lst key base_pnt last_pnt fn pw)
;Export Coordinates
(setq i 1)
(while (setq p (getpoint "\nPick Point: "))
(setq point p)
(MakeText (itoa i) 2.5 0 "L" nil nil 1 nil)
(setq p (list i (car p) (cadr p))
i (1+ i)
lst (cons p lst)))
(if (> (length lst) 2)
(progn
(initget "Cad Excel cadAndexcel")
(setq key (NGT key "Cad" getkword "Enter an option "))
(cond
((wcmatch key "Cad")
(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
(setq base_pnt (getpoint "\nDiem chen: "))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
;;Xong tieu de
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
(setq last_pnt (cdr (last lst)))
;;Xong dong 1
(foreach p (cdr (reverse lst))
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
)
;;Xong cac diem giua
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
;;Xong lap lai dong 1 + k/cach khep
)
((wcmatch key "Excel")
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,X,Y,K/cach (m)" pw)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
(setq last_pnt (cdr (last lst)))
(foreach p (cdr (reverse lst))
(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
(close pw)
)
(t
(setq #textheight (NGT #textheight 2 getint "Chieu cao chu"))
(setq base_pnt (getpoint "\nDiem chen: "))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" "STT" nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "X" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MC" "Y" nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 'L3 nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" "K/CACH (m)" nil)
;;Xong tieu de
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "MC" nil nil)
(setq last_pnt (cdr (last lst)))
;;Xong dong 1
(foreach p (cdr (reverse lst))
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car p)) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last p) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt nil 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3) nil)
)
;;Xong cac diem giua
(setq base_pnt (polar (polar base_pnt pi (* 35 #textheight)) (* 1.5 pi) (* 2 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil 'L4 nil (* 5 #textheight) (* 0.5 #textheight) #textheight "MC" (itoa (car (last lst))) nil)
(setq base_pnt (polar base_pnt 0 (* 5 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (cadr (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 15 #textheight) (* 0.5 #textheight) #textheight "MR" (rtos (last (last lst)) 2 3) nil)
(setq base_pnt (polar base_pnt 0 (* 15 #textheight)))
(H:Creat_Cel+Data base_pnt 'L1 'L2 nil nil nil (* 10 #textheight) (* 0.5 #textheight) #textheight "M" (rtos (distance last_pnt (cdr (last lst))) 2 3) nil)
;;Xong lap lai dong 1 + k/cach khep
;;Xong chen bang trong cad
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,X,Y,K/cach (m)" pw)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3)) pw)
(setq last_pnt (cdr (last lst)))
(foreach p (cdr (reverse lst))
(write-line (strcat (itoa (car p)) "," (rtos (cadr p) 2 3) "," (rtos (last p) 2 3) "," (rtos (distance last_pnt (setq last_pnt (cdr p))) 2 3)) pw)
)
(write-line (strcat (itoa (car (last lst))) "," (rtos (cadr (last lst)) 2 3) "," (rtos (last (last lst)) 2 3) "," (rtos (distance last_pnt (cdr (last lst))) 2 3)) pw)
(close pw)
)
)
)
(princ "\n***** Phai pick >2 diem ! ***")
)
(princ)
)
;;;End main
;===============================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
(modul)
(a)
)
)
)
;=====================
(defun H:Creat_Cel+Data (base_pnt L1 L2 L3 L4 celheight celwidth offset textheight justify string Ang / pnt2 pnt3 pnt4 justify point)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))
(cons 10 PT1) (cons 11 PT2)
(cons -3 (if xdata (list xdata) nil))))
);end
;=================================
(if (null celheight) (setq celheight (+ textheight (* 2 offset))))
(setq pnt2 (polar base_pnt 0 celwidth)
pnt3 (polar pnt2 (* 1.5 pi) celheight)
pnt4 (polar pnt3 pi celwidth)
)
(if justify (setq justify (strcase justify)))
(cond
((wcmatch justify "C,BC") (setq point (polar (polar pnt4 (* 0.5 pi) offset) 0 (* 0.5 celwidth))))
((wcmatch justify "R,BR") (setq point (polar pnt3 (* 0.75 pi) (* offset (sqrt 2)))))
((wcmatch justify "M") (setq point (polar base_pnt 0 (* 0.5 celwidth))))
((wcmatch justify "MC") (setq point (polar (polar pnt4 (* 0.5 pi) (* 0.5 celheight)) 0 (* 0.5 celwidth))))
((wcmatch justify "TL") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 offset)))
((wcmatch justify "TC") (setq point (polar (polar base_pnt (* 1.5 pi) offset) 0 (* 0.5 celheight))))
((wcmatch justify "TR") (setq point (polar pnt2 (* 1.25 pi) (* offset (sqrt 2)))))
((wcmatch justify "ML") (setq point (polar (polar base_pnt (* 1.5 pi) (* 0.5 celheight)) 0 offset)))
((wcmatch justify "MR") (setq point (polar (polar pnt2 (* 1.5 pi) (* 0.5 celheight)) pi offset)))
(t (setq point (polar pnt4 (* 0.25 pi) (* offset (sqrt 2)))))
)
(if L1 (MakeLine pnt4 pnt3 nil nil nil nil nil))
(if L2 (MakeLine pnt3 pnt2 nil nil nil nil nil))
(if L3 (MakeLine base_pnt pnt2 nil nil nil nil nil))
(if L4 (MakeLine pnt4 base_pnt nil nil nil nil nil))
(if string (MakeText string textheight Ang justify nil nil nil nil))
)
;===================================
(defun MakeText (string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(cons 50 (if Ang Ang 0))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
;justify (strcase justify)
)
(cond ((= 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)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
)
(entmakex Lst)
);end
;=================================
p/s: Tiện thể, có bác nào ngang qua cho em hỏi: Vì sao khi "bỏ" hàm MakeText vào trong hàm H:Creat_Cel+Data (mục đích để định nghĩa lại nó mỗi khi gọi hàm H:Creat_Cel+Data tránh sai sót) và đã không thiết lập nó là biến cục bộ thì cad không load được hàm MakeText.
Phải chăng là do mình đã để ngõ tham số point trong đó.
Hàm MakeText nằm trong hàm H:Creat... Vì vậy, chỉ khi hàm H:Creat... được sử dụng thì hàm MakeText mới được load. Trong lisp này thì hàm MakeText được gọi trước hàm H:Creat... nên nó chưa được load >> lỗi.
<<
|
Tác giả: tranloi12c
Bài viết gốc: 452629
Tên lệnh: a1 |
Nhờ chỉnh sửa Lisp
Chào các bác, anh chị trên diễn đàn. Các bác cho e hỏi lỗi của đoạn mã sau ở đâu thế ạ, khi e copy từ model sang layout nó luôn chỉ chọn đối tượng đầu tiên và nhân lên vs số lần lặp mà k chọn sang đối tượng thứ N, nếu k dùng vòng lặp "while" hoặc copy và past trên cùng model hoặc layout thì k thấy lỗi ạ. E cảm ơn cả nhà
>>
Chào các bác, anh chị trên diễn đàn. Các bác cho e hỏi lỗi của đoạn mã sau ở đâu thế ạ, khi e copy từ model sang layout nó luôn chỉ chọn đối tượng đầu tiên và nhân lên vs số lần lặp mà k chọn sang đối tượng thứ N, nếu k dùng vòng lặp "while" hoặc copy và past trên cùng model hoặc layout thì k thấy lỗi ạ. E cảm ơn cả nhà
(defun C:a1( / taphop soluong index)
(setq taphop (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
(setq soluong (sslength taphop))
(setq index 0)
(while (< index soluong)
(vl-cmdf "_.copybase" "_none" '(0 0 0) (ssname taphop index) "")
(vl-cmdf "layout" "S" "Layout1")
(vl-cmdf "_.pasteclip" "_none" '(0 0 0))
(setq index (+ index 1))
)
(princ)
)
test.dwg << |
Tác giả: thanhtungvnn
Bài viết gốc: 220195
Tên lệnh: mm+nil |
Lỗi đặt lệnh tắt
Có đúng hok bạn nhỉ :D
(defun c:MM nil (initdia) (command "_.MLEDIT")) ;mo hop thoai...
>>
Có đúng hok bạn nhỉ :D
(defun c:MM nil (initdia) (command "_.MLEDIT")) ;mo hop thoai MLedit
Thank bác nhé :). Dân ngoại đạo nên mấy cái code mù tịt :D
Vậy mấy lỗi còn lại có thể giải thích cho em không ạ :D
<<
|
|
Filename: 220195_mm+nil.lsp
|
|
Tác giả: ghost256
Bài viết gốc: 344347
Tên lệnh: tl |
Đo chiều dài và ghi ra text
Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp...
>>
Em search được trên CV thấy có lisp dùng để đo chiều dài và ghi ra text.Nhờ các bác chỉnh sửa lại giúp e tí cho phù hợp cv.Khi chạy lisp yêu cầu chọn phương án nhập kết quả:
1-Chọn điểm để nhập kết quả thì e muốn text ra là Style hiện hành, chiều cao là 200 và text ghi ra sẽ có dạng L= ???
2-Chọn text để gán kết quả thì cũng có dạng như trên
Két thúc lệnh.
Thanhks các Pro nhiều!!
Lisp đó đây ạh!
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=9681
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------
Các bác giúp em với. Em đang cần một lip tương tự thế này. Em cần đo một đoạn thẳng rồi thay thế text đã có sẵn là được. chứ không phải đánh lệnh "tl" rồi seclet opjec... để chọn cả một đoạn thẳng. Đoạn thẳng hay Plyline của em gồm nhiều đoạn nhỏ khác. Em muốn đo các đoạn nhỏ đó. Nói dài dòng vì không biết diễn tả thế nào.
Nghĩa là em có một PL giao với các đoạn thẳng khác tại các điểm a,b,c,d,e..... Giờ em muốn đánh lệnh tl xong => pick vào điểm a => b => c => d.....enter => chọn text cần thay thế độ dài đoạn ab, bc, cd... là xong. Không cần phương án 1 , 2 gì cả.
Trong hình em muốn đánh lệnh xong pick vào các điểm khoanh tròn màu xanh. và thay thế lần lượt số 6.52, 1.38, 1.60, 6.03...
Cảm ơn các bác rất nhiều.
<<
|
Tác giả: tien2005
Bài viết gốc: 447925
Tên lệnh: pagesetups |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
1 giờ} trướ}c, Duong Nhat Duy đã nói:
Cảm ơn bạn nhé, nhưng...
>>
1 giờ} trướ}c, Duong Nhat Duy đã nói:
Cảm ơn bạn nhé, nhưng vẫn không phải ý mình :((
Hàm addPageSetup là hàm thêm 1 pagesetup mới.
Hàm sát với ý mình nhất là hàm SetCurrentPageSetup, ví dụ:
-
cadvietlisp.lsp
-
(SetCurrentPageSetup (vla-get-activedocument (vlax-get-acad-object)) "Setup2"
Hàm này chuyển Page setup về "Setup2", ý mình muốn chuyển về None, mình đã thử đổi số thành None, "", nil nhưng vẫn ko đc :((
Bạn chỉ cần tạo pagesetup trên layout (cài đặt máy in, giấy, ....) sau đó coupyform cho các layout khác thì tất cả là None. Bạn tham khảo code sau
;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-and-characters-in-vla-put-canonicalmedianame/td-p/4842089
(defun c:pagesetups()
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq plotCfgs (vla-get-ActiveLayout doc))
(vla-RefreshPlotDeviceInfo plotCfg)
;; Set the plot device
(vla-put-ConfigName plotCfg "DWG To PDG.pc3")
;; Set the paper size
(vla-put-CanonicalMediaName plotCfg "ANSI B \(11.00 x 17.00 Inches\)")
(vla-put-PaperUnits plotCfg acMillimeters)
(setq PLOT_BL (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(-53.540381 -6.990000))
PLOT_TR (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(814.00000000 537.00000000))
)
(vla-SetWindowToPlot plotCfg PLOT_BL PLOT_TR)
(vla-put-PlotType plotCfg acWindow)
(vla-put-UseStandardScale plotCfg :vlax-true)
(vla-put-StandardScale plotCfg ac1_2)
(vla-put-CenterPlot plotCfg :vlax-false)
;; Hide paperspace objects
(vla-put-PlotHidden plotCfg :vlax-false)
;; Set the plot offset
(setq origin (vlax-make-safearray vlax-vbDouble '(0 . 1)))
(vlax-safearray-fill origin (list 0.0 0.0))
(vla-put-PlotOrigin plotCfg origin)
(vla-put-PlotRotation plotCfg ac90degrees)
(vla-put-PlotViewportBorders plotCfg :vlax-false)
(vla-put-PlotViewportsFirst plotCfg :vlax-false)
(vla-put-PlotWithLineweights plotCfg :vlax-true)
(vla-put-ScaleLineweights plotCfg :vlax-false)
(vla-put-PlotWithPlotStyles plotCfg :vlax-true)
(vla-put-ShowPlotStyles plotCfg :vlax-true)
(vla-put-StyleSheet plotCfg "MTO_monochrome_Half_Size.ctb")
(vla-RefreshPlotDeviceInfo plotCfg)
;http://forums.augi.com/showthread.php?44555-Apply-page-setup-to-multiple-layouts
(vlax-map-collection
(vla-get-layouts doc)
'(lambda (x)
(if (eq (vla-get-modeltype x) :vlax-false)
(vl-catch-all-error-p (vl-catch-all-apply 'vla-copyfrom (list x plotCfgs)))
)
)
)
(princ)
)
<<
|
|
Filename: 447925_pagesetups.lsp
|
|
Tác giả: nguyenkhoadung98
Bài viết gốc: 54477
Tên lệnh: idc |
Viết Lisp theo yêu cầu
Chào bạn nguyenkhoadung98, Bạn xài thử lisp này xem nhé. Có gì chưa được bạn hãy post lên để mình kiểm tra và sửa lại.
(defun C:idc...
>>
Chào bạn nguyenkhoadung98, Bạn xài thử lisp này xem nhé. Có gì chưa được bạn hãy post lên để mình kiểm tra và sửa lại.
(defun C:idc ()
(setq dt (entsel "/n Chon doi tuong goc")
dc (entsel "/n Chon duong chuan")
txt (entsel "/n Chon text goc")
kc (getreal "/n Chon khoang cach giua cac đoi tuong")
pg (getpoint " Chon diem goc copy")
elst (entget (car txt))
text (cdr (assoc 1 elst))
t1 (substr text 1 6)
t2 (substr text 7 1)
t3 (substr text 8 1)
gt (cdr (assoc 50 elst))
h (cdr (assoc 40 elst))
)
(command "measure" dc kc)
(setq ss (ssget "p")
i 0
n (sslength ss)
)
(if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0))
(setq pt (cdr (assoc 10 elst)))
(setq pt (cdr (assoc 11 elst)))
)
(while (< i n)
(setq p0 (cdr (assoc 10 (entget (ssname ss i)))))
(if (/= nil (ssname ss (1+ i)))
(setq p1 (cdr (assoc 10 (entget (ssname ss (1+ i))))))
(setq p1 (cdr (assoc 10 (entget (ssname ss (1- i))))))
)
(setq gr (angle p0 p1)
gd (/ (* gr 180) pi)
)
(if (and (> gd 90) (< gd 270))
(setq gd (+ gd 180))
)
(if (/= (atoi t2) nil)
(setq t4 (+ i (atoi t2) 1))
(setq t4 100)
)
(if (or (> (ascii t3) 67) (< (ascii t3) 65))
(setq t5 (chr 65))
(setq t5 t3)
)
(if (= 0 (rem i 3))
(setq t5 (chr (+ (ascii t5) 1)))
(if (= 1 (rem i 3))
(setq t5 (chr (+ (ascii t5) 2)))
)
)
(command "copy" dt "" pg p0)
(command "text" (list (car p0) (+ (cadr p0) 20)) h gd (strcase (strcat t1 (itoa t4) t5) nil))
(setq i (1+ i))
)
)
Lệnh chạy lisp là idc bạn nhé. Lisp này có thể đành số cột dọc theo line, polyline, spline bạn ạ.
Chúc bạn vui.
Cảm ơn bạn Bình và các bạn tue,ndtnv nhiều, lisp của bạn về cơ bản đúng như ý mình nhưng như bác ndtnv nói mình còn 1 số điểm như sau :
1- nó chưa làm được với đường pl,spline và đường cong (vì lúc rải block nó kô vuông góc với đường như khi mình me ) mà mình dùng chủ yếu là loại đường này
2- text sau khi dùng lisp nó kô đứng cạnh cái block như text gốc ( nó đứng xa hơn ) và nó kô có cùng đặc tính như text gốc ( cái này kô wa cần thiết bạn bỏ wa cũng đc)
3- thứ tự đánh nó lại là T2/L1-1A sau lại đến T2/L1-13A,T2/L1-12C...trong khi mình muốn là T2/L1-1A,T2/L1-2B,T2/L1-3C....T2/L1-13A
ngoài ra trả lời bạn Tue_NV là đúng là mình cần khoảng cách giữa các block là bằng nhau bạn ạ. cảm ơn các bạn đã quan tâm
mình gửi kèm bản vẽ miêu tả :cry:
http://www.cadviet.com/upfiles/Drawing11_1.dwg
<<
|
Tác giả: troggarf
Bài viết gốc: 453388
Tên lệnh: fakedims |
lisp fake dim
;;; Find Dimension Overrides
;;; Lucas3
;;; http://www.cadtutor.net/forum/showthread.php?83532-How-to-filter-Edited-Dimensions
;;; Will turn dim overrides Red. If there are no overrides, an alert box will display saying that no overrides were found.
;;; I edited the alert text for grammar
(defun C:FakeDims(/ i ss)
(vl-load-com)
(setvar "cmdecho" 0)
(if (setq ss (ssget "X" '((0 . "DIMENSION") (-3 ("ACAD")))))
...
>>
;;; Find Dimension Overrides
;;; Lucas3
;;; http://www.cadtutor.net/forum/showthread.php?83532-How-to-filter-Edited-Dimensions
;;; Will turn dim overrides Red. If there are no overrides, an alert box will display saying that no overrides were found.
;;; I edited the alert text for grammar
(defun C:FakeDims(/ i ss)
(vl-load-com)
(setvar "cmdecho" 0)
(if (setq ss (ssget "X" '((0 . "DIMENSION") (-3 ("ACAD")))))
(repeat (setq i (sslength ss))
(entmod (list (cons -1 (ssname ss (setq i (1- i)))) (list -3 (list "ACAD"))))
)
(if (setq ss (ssget "X" '((0 . "DIMENSION") (-4 . "<AND")(-4 . "<NOT")(1 . "")(-4 . "NOT>")(-4 . "<NOT")(1 . "*<>*")(-4 . "NOT>")(-4 . "AND>"))))
(repeat (setq i (sslength ss))
(vlax-put-property (vlax-ename->vla-object (ssname ss (setq i (1- i)))) "textcolor" 1)
)
(alert "No Edited Dimensions Found!")
)
)
(princ)
)
<<
|
|
Filename: 453388_fakedims.lsp
|
|
Tác giả: Bee
Bài viết gốc: 453421
Tên lệnh: gt1 |
Nhờ vả. Xin lisp đo độ dài line xuất ra text (đơn giản)
10 giờ trước, 888x888x888 đã nói:
Mình tìm nhiều nhưng toàn...
>>
10 giờ trước, 888x888x888 đã nói:
Mình tìm nhiều nhưng toàn lisp kiểu này mà toàn cái phức tạp quá mức mình cần thiết
Mình muốn nhờ các bác làm hộ mình 1 cái lisp thật đơn giản thế này, pick vào line rồi xuất vào text có sẵn, chỉ vậy thôi, như cái lisp mình đang dùng mà ko phải pick điểm đầu, điểm cuối nữa mà pick vào line luôn (cả pline thì tốt)
Cảm ơn các bác
Lisp mình đang dùng đây:
(defun c:gt (/ p1 p2 txt etxt d)
(setq p1 (getpoint "\n Chon diem thu nhat")
p2 (getpoint "\n Chon diem thu hai ")
txt (car (entsel "\n Chon text can thay" ))
d (distance p1 p2)
etxt (entget txt)
etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)
)
(entmod etxt)
(princ)
)
Lisp đây chủ thớt nhé:
(defun c:gt1 (/ line txt etxt d)
(setq line (car (entsel "\Chon line: ")))
(setq d (distance (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line)))))
(setq txt (car (entsel "\n Chon text can thay"))
etxt (entget txt)
etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)
)
(entmod etxt)
(princ)
)
<<
|
Tác giả: Nguyen Hoanh
Bài viết gốc: 13366
Tên lệnh: ct |
Viết Lisp theo yêu cầu
à, với các hình đơn giản mình có thể dùng trọng tâm của nó để thay đổi vị trí. còn với các hình phức tạp có thể thay đổi bằng cách pick điểm trên màn... >>
à, với các hình đơn giản mình có thể dùng trọng tâm của nó để thay đổi vị trí. còn với các hình phức tạp có thể thay đổi bằng cách pick điểm trên màn hình. hoặc nếu phức tạp chỉ thay đổi text cũng được!
Vấn đề phức tạp.
Nếu chỉ là text thì lệnh CT dưới đây sẽ đáp ứng điều bạn cần:
(defun c:ct( / e1 e2 a1 a2)
(setq e1 (car (entsel "\nDoi tuong 1: ")))
(redraw e1 3)
(setq e2 (car (entsel "\nDoi tuong 2: ")))
(redraw e1 4)
(setq
a1 (assoc 10 (entget e1))
a2 (assoc 10 (entget e2))
)
(entmod (subst a2 a1 (entget e1)))
(entmod (subst a1 a2 (entget e2)))
)
<<
|
Tác giả: Tue_NV
Bài viết gốc: 60808
Tên lệnh: aci |
Kéo cung tròn thành đường tròn?
Chào Tue_NV Xin phép bổ sung phần Properties (thuộc tính : layer, color, linetype, lineweight)
dùng Entdel thay cho Command Erase.
(defun c:AtC(/ ar ent ds...
>>
Chào Tue_NV Xin phép bổ sung phần Properties (thuộc tính : layer, color, linetype, lineweight)
dùng Entdel thay cho Command Erase.
(defun c:AtC(/ ar ent ds val); Arc to Circle
(defun dxf(id ent) (cdr (assoc id ent)) )
(setq ar (car(entsel "\n Chon arc :")))
(setq ent (entget ar)
ds (list (cons 0 "CIRCLE") (cons 10 (dxf 10 ent)) (cons 40 (dxf 40 ent)) ))
(setq ds (append ds (list (cons 8 (dxf 8 ent)))) );layer
(if (setq val (dxf 62 ent));color
(setq ds (append ds (list (cons 62 val))) )
)
(if (setq val (dxf 6 ent));line type
(setq ds (append ds (list (cons 6 val))) )
)
(if (setq val (dxf 370 ent));line weight
(setq ds (append ds (list (cons 370 val))) )
)
(entmake ds)
(entdel ar)
(princ)
)
Chào anh gia bách
Lời đầu tiên Tue_NV xin cảm ơn anh gia bách rất nhiều vì sự chia sẻ
Nếu để gán thuộc tính của arc cho circle thì mình vẫn có thể sử dụng lệnh MA được mà
(defun c:ACi(/ ar ent)
(setq ar (car(entsel "\n Chon arc :")))
(setq ent (entget ar))
(entmake (list (cons 0 "CIRCLE") (cons 10 (cdr(assoc 10 ent))) (cons 40 (cdr(assoc 40 ent)))))
(command "MATCHPROP" ar (entlast) "")
(entdel ar)
(princ)
)
<<
|
Tác giả: thanhduan2407
Bài viết gốc: 453646
Tên lệnh: 00 |
Nhờ viết Lsp xuất toạ độ tâm block
(defun C:00 (/ I LTSDONG LTSTEXT SSTEXT TDO)
;;;;;;;XUAT TOA DO TEXT
(vl-load-com)
(setvar "CMDECHO" 0)
(setq ssText (ssget (list (cons 0 "TEXT"))))
(if ssText
(progn
(setq LtsText (acet-ss-to-list ssText))
(setq LtsDong nil)
(setq i 1)
(foreach eT LtsText
(setq Tdo (TD:Text-Base eT))
(setq LtsDong (append LtsDong
(list (list (rtos i 2 0)
(rtos (cadr Tdo) 2 3)
...
>>
(defun C:00 (/ I LTSDONG LTSTEXT SSTEXT TDO)
;;;;;;;XUAT TOA DO TEXT
(vl-load-com)
(setvar "CMDECHO" 0)
(setq ssText (ssget (list (cons 0 "TEXT"))))
(if ssText
(progn
(setq LtsText (acet-ss-to-list ssText))
(setq LtsDong nil)
(setq i 1)
(foreach eT LtsText
(setq Tdo (TD:Text-Base eT))
(setq LtsDong (append LtsDong
(list (list (rtos i 2 0)
(rtos (cadr Tdo) 2 3)
(rtos (car Tdo) 2 3)
(rtos (caddr Tdo) 2 3)
)
)
)
)
(setq i (1+ i))
)
(if (> (length LtsDong) 0)
(progn
(if (vlax-get-or-create-object "Excel.Application")
(WriteToExcel LtsDong)
(WriteToCSV LtsDong)
)
)
)
)
)
(princ)
)
(defun TD:Text-Base (ent / MA71 MA72 X11 Ma10 Ma11)
(setq Ma10 (cdr (assoc 10 (entget ent))))
(setq Ma11 (cdr (assoc 11 (entget ent))))
(setq X11 (car Ma11))
(setq Ma71 (cdr (assoc 71 (entget ent))))
(setq Ma72 (cdr (assoc 72 (entget ent))))
(if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
(and (= Ma71 0) (= Ma72 3))
(and (= Ma71 0) (= Ma72 5))
)
Ma10
Ma11
)
)
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add"
)
"Sheets"
)
"Item"
1
)
"Cells"
)
)
(setq row 1)
(foreach pt lst_data
(setq col 1)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col))
)
(setq row (1+ row))
)
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()
(if x
(vlax-release-object x)
)
)
)
)
)
)
(list xlCells xlApp)
)
(gc)
(gc)
)
(defun WriteToCSV (lst_data / fl)
(if (setq fl (getfiled "Output File" "" "csv" 1))
(if (setq fl (open fl "w"))
(progn
(foreach pt lst_data
(write-line
(LM:lst->str pt ",")
fl
)
)
(close fl)
)
)
)
)
<< |
Tác giả: Duong Nhat Duy
Bài viết gốc: 447890
Tên lệnh: cps |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Các bạn cho mình hỏi có hàm nào đưa Pagesetup ở Layout về <None> (như hình) không ?
Mình có tìm trên mạng thấy lisp này:
(vl-load-com)
(defun c:CPS (/ Adoc Layts clyt)
(setq aDoc (vla-get-activedocument (vlax-get-acad-object))
Layts (vla-get-layouts aDoc)
clyt (vla-get-activelayout aDoc)
)
(foreach
itm
(vl-remove (vla-get-name clyt)...
>>
Các bạn cho mình hỏi có hàm nào đưa Pagesetup ở Layout về <None> (như hình) không ?
Mình có tìm trên mạng thấy lisp này:
(vl-load-com)
(defun c:CPS (/ Adoc Layts clyt)
(setq aDoc (vla-get-activedocument (vlax-get-acad-object))
Layts (vla-get-layouts aDoc)
clyt (vla-get-activelayout aDoc)
)
(foreach
itm
(vl-remove (vla-get-name clyt) (layoutlist))
(vla-copyfrom (vla-item Layts itm) clyt)
)
(princ)
)
Nhưng là copy Pagesetup ở Layout hiện hành ra các Layout khác. Giả sử 1 bản vẽ không có Layout nào có Pagesetup là None thì không dùng đc Lisp này.
Các bạn giúp mình nhé, mình cảm ơn !
<< |
Tác giả: ketxu
Bài viết gốc: 105299
Tên lệnh: 1 |
Viết lisp theo yêu cầu [phần 2]
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...
>>
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)
)
Em muốn áp dụng lệnh này cho lệnh hatch,tức là khi đang vẽ,dùng lệnh h thì layer chuyển về lớp kt-hatch,hiện hộp thoại hatch ,sử dụng lệnh hatch xong thì trả về lớp hiện tại.
Nếu bê nguyên code trên thì lệnh hatch nhận các thông số cũ,nên k thấy hiện hộp thoại,mà chọn luôn cả loại hatch cũ làm hatch hiện thời luôn (trong khi e muốn đổi loại).Thêm 1 vấn đề nữa,e muốn đặt hg là sẽ tự động chọn loại hatch ansi đầu tiên chẳng hạn,thì làm sao??Mong các bác giúp đỡ
<<
|
Tác giả: ngokiet
Bài viết gốc: 453951
Tên lệnh: ff |
nối 2 đường polyline với nhau nhưng KHÔNG HỢP lại thành 1
(defun c:ff(/ e1 e2 p1 p2 break)
(defun break(en / lp n)
(setq ob (vlax-ename->vla-object en)
p1 (vlax-curve-getparamatpoint ob
(vlax-curve-getclosestpointto ob (trans p1 1 0)))
p2 (vlax-curve-getparamatpoint ob
(vlax-curve-getclosestpointto ob (trans p2 1 0))))
(If (> p1 p2) (mapcar 'set '(p1 p2) (list p2 p1)))
(setq p1 (1+ (fix p1))
p2 (fix p2))
(if (eq p1 p2)
...
>>
(defun c:ff(/ e1 e2 p1 p2 break)
(defun break(en / lp n)
(setq ob (vlax-ename->vla-object en)
p1 (vlax-curve-getparamatpoint ob
(vlax-curve-getclosestpointto ob (trans p1 1 0)))
p2 (vlax-curve-getparamatpoint ob
(vlax-curve-getclosestpointto ob (trans p2 1 0))))
(If (> p1 p2) (mapcar 'set '(p1 p2) (list p2 p1)))
(setq p1 (1+ (fix p1))
p2 (fix p2))
(if (eq p1 p2)
(command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1)
(progn
(command "breaK" (list en (setq p2 (vlax-curve-getpointatparam ob p2))) p2)
(command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1))))
(if (and (mapcar 'set '(e1 p1) (entsel "Chon 1:"))
(mapcar 'set '(e2 p2) (entsel "Chon 2:")))
(progn
(command "Fillet" p1 p2)
(if (null (entget e1)) (break e2)
(if (null (entget e2)) (break e1)))
(princ))))
Viết nhanh theo kiểu bác Đoàn. Làm sơ sơ nên nếu 2 đối tượng khác màu / layer nhau thì sẽ mất 1 đối tượng.
<< |
Tác giả: nguyen chuong
Bài viết gốc: 135219
Tên lệnh: e2cc |
anh em trợ giúp vấn đề này nhe
Không hẳn là phá sản đâu. Nếu bạn chịu khó ngồi sửa lại điểm InsertPoint của Block trùng vào đúng tâm point đó, mình có thể giúp bạn...
>>
Không hẳn là phá sản đâu. Nếu bạn chịu khó ngồi sửa lại điểm InsertPoint của Block trùng vào đúng tâm point đó, mình có thể giúp bạn luôn phần chèn Block vào chỗ đó và lấy tên luôn ^^ Có lẽ, nếu bạn nghĩ như thế là hay hơn thì hãy tạo Block đi, rồi mai mình giúp bạn, vì giờ mình chuẩn bị vào ổ r ^^ .CÒn đây là lời hứa đoạn code vừa nãy.Sau khi chạy E2c để có tên và point, bạn chạy thằng này, quét qua 1 block và 1 text để cập nhật.
Trong code có sử dụng Function bác Hoành và bác Tuệ giới thiệu
(defun ChangeAttributes (lst blk / item atts)
(if blk
(if (safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object blk))
)
)
)
(progn
(foreach item lst
(mapcar
'(lambda (x)
(if
(= (strcase (car item))
(strcase (vla-get-tagstring x))
)
(vla-put-textstring x (cdr item))
)
)
(vlax-safearray->list atts)
)
)
(vla-update (vlax-ename->vla-object blk))
)
)
)
)
(defun laydt(ss kieu)
(acet-list-to-ss
(vl-remove-if '(lambda(x)
(null (wcmatch (acet-dxf 0 (entget x)) kieu)))
(acet-ss-to-list ss)
)
)
)
(defun c:e2cc(/ ss eText tName)
(princ "\n Free Lisp From Cadviet.com @ ketxu")
(defun chDXF (dxf val ent) (entmod (subst (cons dxf val) (assoc dxf (entget ent)) (entget ent))))
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(princ "\nChon Blocks va text :")
(setq ss (ssget))
(setq tname(dxf 1 (setq eText(ssname (Laydt ss "TEXT") 0))))
(ChangeAttributes (list (cons "TENHOGA" tName)) (ssname (Laydt ss "INSERT") 0))
(entdel eText)
)
nhưng bạn ơi để chạy đoạn code này thì làm như thế nào?
<<
|
|
Filename: 135219_e2cc.lsp
|
|
