| Info | File |
Tác giả: pphung183
Bài viết gốc: 411098
Tên lệnh: test |
Dim Nhanh Giữa Các Line (Hoặc Pl)
Xem cái này sắp xếp thế nào nhé. ^_^
(defun c:test (/ lst old old_osm ss pt lst_dim n p11n)
(setq lst nil _ang...
>>
Xem cái này sắp xếp thế nào nhé. ^_^
(defun c:test (/ lst old old_osm ss pt lst_dim n p11n)
(setq lst nil _ang nil)
(setq old (getvar "DIMJUST"))
(setq old_osm (getvar 'osmode))
(if (setq ss (ssget '((0 . "LINE"))))
(progn
(command "_zoom" "obj" ss "")
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq
lst (vl-sort lst
'(lambda (e1 e2)
(> (if (< (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 11 (entget e1))))
)
(cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 11 (entget e1))))
) ;if e1
(if (< (cadr (cdr (assoc 10 (entget e2))))
(cadr (cdr (assoc 11 (entget e2))))
)
(cadr (cdr (assoc 10 (entget e2))))
(cadr (cdr (assoc 11 (entget e2))))
) ;if e2
)
)
)
) ;setq
(setq pt (polar (cdr (assoc 10 (entget (car lst))))
(angle (cdr (assoc 10 (entget (car lst))))
(cdr (assoc 11 (entget (car lst))))
)
(/ (distance (cdr (assoc 10 (entget (car lst))))
(cdr (assoc 11 (entget (car lst))))
)
2
)
)
)
(setvar "DIMJUST" 1)
(command "DIMUPT" "OFF")
(command "DIMALIGNED"
pt
"_per"
(cdr (assoc 11 (entget (cadr lst))))
"_none"
pt
)
(setq lst_dim nil)
(setq lst_dim (cons (entlast) lst_dim))
(setq n 2)
(command "DIMBASELINE")
(repeat (- (length lst) 2)
(command "_per" (cdr (assoc 11 (entget (nth n lst)))))
(setq lst_dim (cons (entlast) lst_dim))
(setq n (1+ n))
)
(command "" "")
(setvar 'osmode 0)
(if (lm:clockwise-p
(vlax-get (vlax-ename->vla-object (car lst_dim))
'textposition
)
(vlax-get (vlax-ename->vla-object (car lst))
'startpoint
)
(vlax-get (vlax-ename->vla-object (car lst))
'endpoint
)
)
(setq _ang (+ pi (txt_angle (car lst_dim))))
(setq _ang (- pi (txt_angle (car lst_dim))))
) ;if
(mapcar
'(lambda (obj)
(setq p11n (polar (vlax-get (vlax-ename->vla-object obj)
'textposition
)
_ang
(* (getvar 'dimtxt) 10.)
)
) ;setq
(vlax-put (vlax-ename->vla-object obj) 'textposition p11n)
)
lst_dim
)
) ;progn then
(princ "\nBan da khong chon LINE.")
) ;if
(command "_zoom" "P")
(setvar "DIMJUST" old)
(setvar "OSMODE" old_osm)
(princ)
)
(defun txt_angle (ename / blkent entdata _angle)
(if
(and
(= (cdr (assoc 0 (setq entdata (entget ename))))
"DIMENSION"
)
(setq blkent (tblobjname "block" (cdr (assoc 2 entdata))))
)
(while (setq blkent (entnext blkent))
(if (= (cdr (assoc 0 (setq entdata (entget blkent)))) "MTEXT")
(setq _angle (cdr (assoc 50 (entget blkent))))
)
)
)
_angle
)
(defun lm:clockwise-p (p1 p2 p3)
((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))
(mapcar '- p1 p3)
)
)
(princ)
Cơ bản nè Bee :bz :
(command "DIMALIGNED"
pt
"_per"
(cdr (assoc 11 (entget (cadr lst))))
"_none"
pt
)
1/ Thiếu 1 "_none" truoc pt
2/ Nên trả lại biến hệ thống diimupt
3/ Nên thêm (setq old_dli (getvar 'dimdli)) ...... (setvar 'dimdli giatri) ...... (setvar "DIMDLI" old_dli) bởi vì nếu dímtyle đã set Dimdli là rất nhỏ (0.75 chẳng hạn)
lúc đó chạy lisp nhìn thử :)
Vài góp ý nhỏ . Nói chung bạn tuổi trẻ tài cao :)
<<
|
|
Filename: 411098_test.lsp
|
|
Tác giả: SoftvnBin
Bài viết gốc: 204853
Tên lệnh: vtl1 |
Lisp rải taluy trên đường cong
Hề hề hề,
1/- Đã sửa
2/- Đã sửa
3/- Đã sửa
4/- Đã sửa
5/- Đã sửa.
6.1/- Không sửa. Nếu...
>>
Hề hề hề,
1/- Đã sửa
2/- Đã sửa
3/- Đã sửa
4/- Đã sửa
5/- Đã sửa.
6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.
6.2 a/- Đã sửa
6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.
Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử
Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.
;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
(progn
(setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
(if (not (setq scaletmp (getint thongbao)))
(setq scaletmp scale)
)
)
(progn
(setq thongbao "Ty le ban ve ? <1/1000>:")
(if (not (setq scaletmp (getint thongbao)))
(setq scaletmp 1000)
)
)
)
(setq scale scaletmp)
(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
(setq Defaultdist tg)
)
(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
(setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
(setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
(setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
(setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
(setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
(setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
(setq sodoanngan tg tg nil)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))
)
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)
(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)
;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel "\nChon doi tuong ve ta luy..."))
(if ep
(progn
(nsl1)
(setq solan (vetaluy ep))
(initget "Undo Change")
(while
(setq chon (getkword "Undo/Change <enter for exit>: "))
(if (= chon "Undo")
(command "_.Undo" solan)
)
(if (= chon "Change")
(progn
(nsl1)
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(initget "Undo Change")
)
(setq blname (getstring t "\n Nhap ten block ban muon: "))
(if (/= blname "")
(command "block" blname (list 0.0 0.0 0.0) ss "")
)
(setq ep nil)
)
)
)
(command "undo" "e")
(princ)
)
Hề hề hề,
Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.
Chúc bạn vui.
Cảm ơn bác PhamThanhBinh đã tận tình giúp đỡ, tuy nhiên sau khi test thì em thấy có lỗi như sau (lỗi một phần do em không diễn tả đúng ý mình (văn lùn quá :D ).
Em xin giả trình lại như sau:
Command: vtl1
Chon doi tuong ve ta luy...
Chieu dai doan ngan<250>:100 (250 là số liệu mặc định khi thực hiện lệnh VTL1 lần đầu tiên, 100 là số liệu nhập vào, lần thứ 2 khi thực hiện lệnh VTL1 thì sẽ chuyển thành Chieu dai doan ngan<100>:… 100 là số liệu lần cận kề dưới nó.
Chieu dai doan dai<500>:200 (Tương tự như trên)
Khoang cach giua cac doan<200>:100 (Tương tự như trên)
So doan ngan trong 1 doan dai<1>:2 (Tương tự như trên)
Undo/Change <enter for exit>:
Nhap ten block ban muon: mai duong 1
1. Lưu số liệu lần nhập trước (được giải trình như trên và dưới đây)
Khi thực hiện lệnh VTL1 lần 1 thì hỏi các thông số nhập vào
Khi thực hiện lệnh VTL1 lần 2, lần 3… thì vẫn hỏi các thông số nhập vào, nhưng cho số gợi nhớ các thông số đã nhập lần gần nhất.
Ví dụ: thực hiện lệnh VTL1 lần thứ nhất -> Khoang cach giua cac doan<200>:100, thì khi thực hiện lệnh VTL1 lần thứ hai sẽ nhớ -> Khoang cach giua cac doan<100>:150 (150 là số liệu mới nhập vào lần 2, 100 là số liệu lần nhập cận kề dưới nó (trong trường họp này chính là lần đầu tiên). Khi thực hiện lệnh VTL1 lần thứ ba sẽ nhớ số liệu nhập lần cận kề dưới nó (ở đây sẽ là Khoang cach giua cac doan<150>:.…. .)
2. Sau khi kết thúc lệnh bằng Enter (Undo/Change <enter for exit>) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)
(Khi nhập tên Block xong thì toàn bộ mái taluy vừa rải biến mất :) )
3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1
(đã Oke!)
4. Khắc phục nill khi kết thúc lệnh Enter
(đã Oke!)
5. Khi thực hiện lệnh để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn
(đã Oke!)
6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)
(đã Oke!)
7. Bác xem giúp em luôn chọn đối tượng rải -> chọn đoạn rải (thuộc đối tượng rải) -> từ điểm pick 1 đến điểm pick 2 đến điểm Pick 3 thì sẽ chỉ rải trong đoạn từ điểm pick 1 đến điểm pick 3 (theo chiều từ pick 1 đến pick 2 đến pick 3 (để khắc phục chiều rải trong hình kín) không ạ, em chân thành cảm ơn!
<<
|
|
Filename: 204853_vtl1.lsp
|
|
Tác giả: nguoihung_3
Bài viết gốc: 204891
Tên lệnh: sline |
Lisp vẽ Pline mũi tên 2 đầu
Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm...
>>
Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm nhé ^^
(defun c:sline (/ loop p1 p2)
(grtext -1 "Free from Cadviet.com @Ketxu")
(if (not asize) (setq asize 1))
(if (not PThk) (setq PThk 0.01))
(defun GETR (val msg / tm)
(setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
(cond ((= (type tm) 'REAL) (eval tm))
((= tm nil) (eval val))
(t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
(defun loop ()
(cond ((setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : ")) (command p2)
(setq p0 p1) (setq p1 p2) (loop))
( t (command "u" (polar p1 (angle p1 p0) asize)
"w" (/ asize 3) 0.0 p1 ""))))
(setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
(setq PThk (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
(setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
(command "pline" p1 "w" 0.0 0.0)
(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
(command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
"w" PThk PThk p2)
(setq p1 p2)
(loop)
(eval "Done")
)
Bác có thể chèn thêm dòng lệnh khai báo bề rộng điểm đầu mũi tên,chiều dài mũi tên,và bề rộng điểm cuối mũi tên sau đó mới khai báo bề dày của PL được không bác?
<<
|
|
Filename: 204891_sline.lsp
|
|
Tác giả: mrphuocvie
Bài viết gốc: 393207
Tên lệnh: getstyle |
List Tất Cả Layer, Teststyle, Dimstyle Trong Bản Vẽ Hiện Hành
;20160204-GETSTYLE
;--------------------------------------------DIALOG-------------------------------------------------------
;getstyle : dialog { //dialog name
; label = "Select Layer, Textstyle, Dimstyle" ; //give it a label
; : column {
; : popup_list { //define list box
; key = "sel_lyr"; //give it a name
; label = "Select layer";
; value = "0"; //initial value
; } //end list
; : popup_list { //define list box
; key = "sel_tst";...
>>
;20160204-GETSTYLE
;--------------------------------------------DIALOG-------------------------------------------------------
;getstyle : dialog { //dialog name
; label = "Select Layer, Textstyle, Dimstyle" ; //give it a label
; : column {
; : popup_list { //define list box
; key = "sel_lyr"; //give it a name
; label = "Select layer";
; value = "0"; //initial value
; } //end list
; : popup_list { //define list box
; key = "sel_tst"; //give it a name
; label = "Select textstyle";
; value = "0"; //initial value
; } //end list
; : popup_list { //define list box
; key = "sel_dst"; //give it a name
; label = "Select dimstyle";
; value = "0"; //initial value
; } //end list
; } //end column
; ok_cancel ; //predifined OK/Cancel
;} //end dialog
;--------------------------------------------lISP-------------------------------------------------------
(defun C:GETSTYLE( / table_lyr table_tst table_dst lyrs tsts dsts);define funcion
(setvar "cmdecho" 0);switch off command echo
;Get list of all Layer
(vlax-for lyr
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq table_lyr (cons (vla-get-name lyr) table_lyr))
)
;Get list of all Textstyles
(vlax-for tst
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq table_tst (cons (vla-get-name tst) table_tst))
)
;Get list of all Dimstyles
(vlax-for dst
(vla-get-dimstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq table_dst (cons (vla-get-name dst) table_dst))
)
(setq dcl_id (load_dialog "getstyle.dcl")) ;load dialogue
(if (not (new_dialog "getstyle" dcl_id) ;check for errors
) ;not
(exit) ;if problem exit
) ;if
;Layer
(set_tile "sel_lyr" "0") ;initilise list box
(start_list "sel_lyr") ;start the list
(mapcar 'add_list table_lyr) ;add the layer table_lyr
(end_list) ;end the list
;Textstyles
(set_tile "sel_tst" "0") ;initilise list box
(start_list "sel_tst") ;start the list
(mapcar 'add_list table_tst) ;add the layer table_tst
(end_list) ;end the list
;Dimstyles
(set_tile "sel_dst" "0") ;initilise list box
(start_list "sel_dst") ;start the list
(mapcar 'add_list table_dst) ;add the layer table_dst
(end_list) ;end the list
;Action
(action_tile "accept" "(setq ddiag 2)(Assign_value)(done_dialog)")
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
(start_dialog) ;Display the dialog box
(unload_dialog dcl_id) ;Unload the dialog box
(if(= ddiag 1) ;If the user pressed the Cancel button
(princ "\n Cancelled!")
)
(if(= ddiag 2) ; If the user pressed the Okay button
(progn
(alert (strcat "\nYou Selected Layer:" lyrs ",Textstyle: " tsts ",Dimstyle: " dsts))
)
);end if
(princ)
);defun
(defun Assign_value()
;Layer
(setq lyrs (nth (atoi (get_tile sel_lyr)) sel_lyr))
;Textstyles
(setq tsts (nth (atoi (get_tile sel_tst)) sel_tst))
;Dimstyles
(setq dsts (nth (atoi (get_tile sel_dst)) sel_dst))
)
Xin lỗi, vì có thể vấn đề này hơi bi dư thừa cho nhiều người. Nhưng mình đang găp thắc mắc.
1. Nhờ moi người sửa giúp đoan lisp trên.
2. Chỉ ra lỗi của nó.
3. Theo mình biết thì muốn có Dialog (hôp thoai) thì cần có 1 file .dcl để goi khi chay. Nhưng trong đoan lisp mình xem trên Lee Mac thì nó đươc tích hơp trong .lsp luôn. Vây, cách tao nó như thế nào. Có thể áp dung trong bài này luôn đươc không?
Xin cảm ơn!
<<
|
|
Filename: 393207_getstyle.lsp
|
|
Tác giả: lebaonam
Bài viết gốc: 243751
Tên lệnh: dai |
Nhờ viết lisp tính toán chiều dài theo layer
1. Nếu chỉ riêng LINE, PLINE bạn có thể tắt những Layer không liên quan đi và áp dụng lisp sau của Lee Mac:
>>
1. Nếu chỉ riêng LINE, PLINE bạn có thể tắt những Layer không liên quan đi và áp dụng lisp sau của Lee Mac:
(defun c:DAI ( / ss )
(vl-load-com)
(if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
(
(lambda ( i total / e )
(while (setq e (ssname ss (setq i (1+ i))))
(setq total (+ total (vla-get-length (vlax-ename->vla-object e))))
)
(princ (strcat "\n<< Length: " (rtos total) " >>"))
)
-1 0
)
)
(princ))
2. Nếu bạn muốn lọc layer thì thêm vào, phần lọc nữa, tùy bạn lọc theo tên layer, hoặc theo đối tượng chọn mẫu... Trong toàn bản vẽ hay khu vực cửa sổ chọn... Sau đó bạn search trên diễn đàn để bổ xung thêm tính toán cho các loại đối tượng khác: ARC; SPLINE; ELIPS...
Chúc vui vẻ!
ok thank ! để tớ tim thêm trên dd
<< |
Tác giả: phanthanh536
Bài viết gốc: 295436
Tên lệnh: td |
nhờ các bác viết giúp e lips pick 1 điểm xuất ra tọa độ dưới dạng (x;y)
Có phải như vầy không.
(defun c:td( / get-x get-y oce xp yp rwc )
(setq oce (getvar "cmdecho"))
(setvar...
>>
Có phải như vầy không.
(defun c:td( / get-x get-y oce xp yp rwc )
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "luprec" 4)
(main)
(setvar "cmdecho" oce)
)
;;;----------------------------- Leader Placement Routine ---------------------
;;; Here is where the leaders are actually written to the database
;;; based upon the value of coordinates passed from module "MAIN" .
;;; Null points are ignored.
(defun do_put_leader( xyp )
(command "_.leader" rwc pause "" xyp "")
)
;;;----------------------------- xyz coordinate breakdown ----------------------
;;; This routine accepts a point from the calling function and breaks it down
;;; into X,Y values.
(defun get_xyz ( pt )
(strcat "(" (rtos (* 0.001 (car pt)) 2 3) ";" (rtos (* 0.001 (cadr pt)) 2 3) ")"))
;;;-------------------Secondary main module------------------------------------
;;; Accepts the user input and allows the user to select many objects in
;;; succession.
(defun main()
(setq olddim (getvar "dimstyle"))
(setq a (getreal "\n Input Text Height for Annotation : <2.5> "))
(if (null a) (setq a 2.5))
(setvar "dimtxt" a)
(while (setq rwc (getpoint "\nSelect point: "))
(do_put_leader (get_xyz rwc))
)
(command "dimstyle" "restore" olddim)
)
e cám ơn bác rất nhiều. đúng là lips e cần. bác rảnh ko hôm nào đi uống bia với e nhé. e ở chợ Phùng Khoang. :v
<<
|
Tác giả: study_forever
Bài viết gốc: 76587
Tên lệnh: m um msot |
Lisp đưa đối tượng về vị trí cũ sau khi move?
Chào 'study_forever'Đây là Lisp MSOT -> Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Tue_NV bổ sung vào Lisp nhé :
...
>>
Chào 'study_forever'Đây là Lisp MSOT -> Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Tue_NV bổ sung vào Lisp nhé :
1. Lệnh M : move các đối tượng của bản vẽ : giống lệnh M (Move) của CAD như 2 giọt nước
2. Lệnh UM (Unmove) : đưa các đối tượng Move nhầm về vị trí cũ
3 . Lệnh MSOT : Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Các bạn hãy sử dụng thử và cho mình biết ý kiến nhé :
(defun c:m()
(setq ss (ssget))
(command "line" '(0 0 0) '(1 1 1) "")
(setq ss (ssadd (entlast) ss))
(command "move" ss "")
(while (< 0 (getvar "CMDACTIVE")) (command pause))
(setq dc (cdr(assoc 10 (entget (entlast)))))
(setq ss (ssdel (entlast) ss))
(entdel (entlast))
(setq kc (distance '(0 0 0) dc))
(setq ang (angle dc '(0 0 0) ))
(princ)
)
;
(defun c:um(/ ssg po lis)
(prompt "\n Chon doi tuong Move nham :")
(setq ssg (ssget) i 0 j 0)
(while (< i (sslength ss))
(setq lis (append lis (list (ssname ss i))))
(setq i (1+ i))
)
(while (< j (sslength ssg))
(if (/= (member (ssname ssg j) lis) nil)
(progn
(setq ss (ssdel (ssname ssg j) ss))
(setq po (polar '(0 0 0) ang kc))
(setq ssg (ssadd (ssname ssg j) ssg))
)
(princ "\n Doi tuong chon khong phai Move nham")
)
(setq j (1+ j))
)
(command "move" ssg "" '(0 0 0) po)
(princ)
)
;
(defun c:msot(/ ssg po lis)
(prompt "\n Chon doi tuong Move sot :")
(setq ssg (ssget) i 0 j 0)
(while (< i (sslength ss))
(setq lis (append lis (list (ssname ss i))))
(setq i (1+ i))
)
(while (< j (sslength ssg))
(if (= (member (ssname ssg j) lis) nil)
(progn
(setq po (polar '(0 0 0) (+ pi ang) kc))
(setq ssg (ssadd (ssname ssg j) ssg))
)
(princ "\n Doi tuong chon da Move roi")
)
(setq j (1+ j))
)
(command "move" ssg "" '(0 0 0) po)
(princ)
)
@study : Với yêu cầu 2 thì Tue_NV yêu cầu bạn post bài đúng chổ. Đây là bài viết về Move chứ không phải bài viết về copy. Mong bạn hiểu. Bạn post đoạn code trên ở chổ nào thì trả về đúng chổ cũ của nó. Mình sẽ trả lời bạn nếu bạn post bài đúng chổ. Bạn đồng ý chứ?
Hãy edit lại bài viết trên của bạn và trả về vị trí của nó
Cảm ơn bác đã giúp đỡ em về cái lisp trên, lisp dùng rất tốt!
Về vấn đề bác nói ở trên em xin trình bày là, hôm trước em đã tìm kiếm rất nhiều trên diễn đàn nhưng ko thấy cái Topic cũ của bác, chỉ còn cái lisp là em đã lưu trong máy thôi. Hôm nay nghe bác góp ý em đã cố gắng liên hệ với thằng bạn em có bài trong Topic cũ đó, nó phải giở mục lịch sử bài viết của nó ra mới thấy được cái Topic này, vì thế em đã gửi yêu cầu trong bài viết ở đó, đồng thời xin phép được bỏ phần yêu cầu ở bài viết trên. Em xin cảm ơn.
Link bài viết ấy đây ạ
<<
|
|
Filename: 76587_m_um_msot.lsp
|
|
Tác giả: ths
Bài viết gốc: 397336
Tên lệnh: cxy |
Lisp ghi toạ độ điểm ra màn hình !!!
(defun C:cxy ( / pt1 pt2 txtx txty)
(setvar "cmdecho" 0)
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal...
>>
(defun C:cxy ( / pt1 pt2 txtx txty)
(setvar "cmdecho" 0)
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chieu cao text <"
(rtos *chieucao* 2 2)
"> :"
)
)
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(setq pt1 (getpoint "\n Pick diem can lay toa do: "))
(if pt1
(progn
(setq pt2 (getpoint pt1 "\n Pick diem ghi toa do: "))
(if pt2
(progn
(setq txtx (strcat "X = " (rtos (car pt1) 2 2) " m"))
(setq txty (strcat "Y= " (rtos (cadr pt1) 2 2)" m"))
(command "Mtext" pt2 "h" chieucao pt2 txtx txty "")
)
)
)
)
(setvar "cmdecho" 1)
(princ)
)
bạn ơi, làm sao để khi xuất ra màn hình, thì số hiện ra là 3 chữ số sau dấu phẩy bạn nhỉ?
<<
|
Tác giả: vuonghung018
Bài viết gốc: 407378
Tên lệnh: gg |
Xin Trợ Giúp Về Lisp Ghi Độ Dài Đường Thẳng Ra Block Att
Cho mình hỏi nếu lấy thập phân sau dấu , 1 hoặc 2, 3 số thì ntn?
Thanks!
Đã Code xong cho anh rồi đây :)
Anh dùng...
>>
Cho mình hỏi nếu lấy thập phân sau dấu , 1 hoặc 2, 3 số thì ntn?
Thanks!
Đã Code xong cho anh rồi đây :)
Anh dùng xem sao nhé ^^
;;;------------------------------
;;;-----by MENZI ENGINEERING ----
(defun SetAtt (obj lst / attval)
(mapcar '(lambda (att)
(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))
(vla-put-TextString att attval)
)
)
(vlax-invoke obj 'GetAttributes)
)
(vla-update obj)
)
;;;------------------------------
(defun TS:select (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Line,Pline,SPline \U+0111\U+1EC3 l\U+1EA5y chi\U+1EC1u d\U+00E0i :"))
(cond
((= 7 (getvar 'errno))
(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")
)
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"*LINE"
)
(progn (setq ent (car ent))
nil
)
(princ
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i LINE,PLINE,SPLINE."
)
)
)
)
)
)
ent
)
;;;-------------------------------
(defun GetLen (ent / len)
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (>= len 0)
(fix (+ len 0.5))
(fix (- len 0.5))
)
)
;;;-------------------------------
(defun GetDxf (n elist) (cdr (assoc n elist)))
;;;-------------------------------
(defun c:GG (/ *error* blkatt ent len)
(vl-load-com)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")
(defun *error* (msg)
(if ent
(redraw ent 4)
)
(if (not (wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(while (setq ent (TS:select))
(redraw ent 3)
(setq Len (itoa (GetLen ent)))
(if (and (setq BlkATT (car (entsel "\nChon Block ATT:")))
(wcmatch (GetDxf 0 (entget BlkATT)) "INSERT")
(= (GetDxf 66 (entget BlkATT)) 1)
)
(SetAtt (vlax-ename->Vla-Object BlkATT) (list (cons "CHIEUDAI" Len)))
(alert
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block ATTribute."
)
)
(redraw ent 4)
)
(princ)
)
Em viết Lisp mà được người khác khen và Tick Thanks (nút xanh) là em thấy vui rồi :) :) :)
Hơn nữa viết nhiều mới mau lên tay được nên a yên tâm,vì quan điểm của e là : giúp người=giúp ta mà :)
Thôi,hết giờ làm rồi,ra làm ly bia cho nó mát mát ruột đã .hehe
Hẹn gặp lại sau !
Chào thân ái !
<<
|
Tác giả: hotanphi
Bài viết gốc: 289535
Tên lệnh: ftext |
Viết giúp Lisp xoá text trong khoảng nhất định
với tỷ lệ khác thì không được. : Lisp ở trên không phụ thuộc vào tỉ lệ bản vẽ.
Update lisp :...
>>
với tỷ lệ khác thì không được. : Lisp ở trên không phụ thuộc vào tỉ lệ bản vẽ.
Update lisp : cho phép người dùng nhập giá trị khoảng cách cần loại bỏ.
- nói thêm về giá trị này : đó là khoảng cách từ đuờng bao của Text (tưong tự lệnh OFFSET)
Lisp sẽ lọc các Text có giao với đuờng bao Offset này (đuờng màu cyal)
File Cad kết quả : Filter_text.dwg
(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp) ;|By Gia Bach 2010|;(defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur) (setq elist (entget ent) ang (cdr (assoc 50 elist)) tb (textbox elist) tb1 (car tb) tb2 (cadr tb) ll (polar (cdr (assoc 10 elist)) (+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1)) lr (polar ll ang (- (car tb2) (car tb1))) ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2)) ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) ) (setq ang (angle ll lr) ) (setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))) lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2))) ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2))) ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))) ) (list ll lr ur ul)) (command "_.undo" "be") (setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) ) (or *ofset (setq *ofset 0.5)) (initget 4) (setq ofset (getreal (strcat "\nNhap khoang cach duong vien : <" (rtos *ofset) ">"))) (if (= ofset nil) (setq ofset *ofset) (setq *ofset ofset)) (while (> (sslength ss) 0) (setq ent (ssname ss 0) lst (GetBound ent ofset) ) (ssdel ent ss) (if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT")))) (progn (setq i -1) (while (setq ent1 (ssname ss_tmp (setq i (1+ i)))) (if (not (equal ent ent1)) (progn (ssadd ent1 ss1) (if (ssmemb ent1 ss) (ssdel ent1 ss)) ))) ) ) ) (if (> (sslength ss1) 0) (progn (setq newlayer "Text_Filter") (if (not (tblsearch "layer" newlayer)) (command "-layer" "n" newlayer "c" 2 newlayer "") ) (command "change" ss1 "" "p" "la" newlayer "") ) ) (command "_.undo" "e") (princ))
Xin chào bác Gia Bach và tất cả mọi người. Mình đã load lisp file text của anh gia bach nhugw ko hiểu bị lỗi gì mà ko dùng được cho file này. Mong anh em giúp đỡ. Đây là file mình cần làm nhưng ko biết bị lỗi gì mà ko lọc được các text gần nhau. Mong anh và mọi người chỉ cho lỗi giúp
Ngày trước mình có sử dụng một lần thì được nhưng giờ làm lại cho các file thì ko được mà ko hiện lỗi gì cả. Mong anh em giúp cho. Bác gia bach bận nhiều việc quá mong nhờ anh phamthanhbinh và anh em khác xem giúp. Xin cảm ơn các anh
https://www.mediafire.com/?7ruw4u4trd3ddm2
<<
|
|
Filename: 289535_ftext.lsp
|
|
Tác giả: naturooo
Bài viết gốc: 421691
Tên lệnh: vv |
Sửa lisp Mview
Các bác cho em hỏi chút với ạ.
Em muốn sau khi dùng lệnh Mview với layer Defpoints sau đó trở về layer mặc định trước đó. Vì nếu không về layer mặc định thì các nét vẽ tiếp theo sẽ trở thành nét Def khi mình không để ý in ra bị mất nét. Em có bắt trước mấy lisp đặt lại mặt...
>>
Các bác cho em hỏi chút với ạ.
Em muốn sau khi dùng lệnh Mview với layer Defpoints sau đó trở về layer mặc định trước đó. Vì nếu không về layer mặc định thì các nét vẽ tiếp theo sẽ trở thành nét Def khi mình không để ý in ra bị mất nét. Em có bắt trước mấy lisp đặt lại mặt định OSnap mà k được.
Các bác xem giúp em với ạ.
Trân trọng cảm ơn!
(defun C:VV() ((setq old_clayer (getvar "clayer")) (setvar "clayer" "defpoints") (command "mview") (setvar "clayer" old_layer))
<< |
Tác giả: buiquangnam
Bài viết gốc: 52190
Tên lệnh: scc chd xy cl l1 ll lto |
Tiện ích nhỏ về kích thước và đo đạc
1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure:
;;;=================================
;;;SMALL UTILITIES FOR DIMENSIONS...
>>
1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure:
;;;=================================
;;;SMALL UTILITIES FOR DIMENSIONS AND MEASUREMENTS
;;;CAC TIEN ICH NHO VE KICH THUOC VA DO LUONG
;;;=================================
;;;HUONG DAN:
;;;SaveAs *.lsp, go lenh Appload, go cac lenh sau day de chay:
;;;-------------------------------------------------------------
;;;1- Lenh SCC: SCale with Constant dimensions
;;;Hoat dong nhu lenh Scale cua AutoCAD nhung giu nguyen gia tri Dim
;;;(chi co "Dim Scale Linear" va "Dim Scale Overall" thay doi)
;;;Cac thuoc tinh khac cua Dim khong bi anh huong
;;;Tuy chon Dim Scale Overall = Y cho phep scale ca cac yeu to khac cua Dim
;;;(text, kich thuoc mui ten, khoang nho ra cua duong giong...)
;;;Mac dinh la Dim Scale Overall = N
;;;Chap nhan cac Dim co DimStyle khac nhau
;;;-------------------------------------------------------------
;;;2- Lenh CHD: CHeck Dimensions
;;;Kiem tra toan bo cac doi tuong Dimensions co trong ban ve
;;;Dim bi edit bang Text Override se chuyen sang layer DimCheck co mau RED
;;;-------------------------------------------------------------
;;;3- Lenh XY: ghi toa do X, Y cua diem pick
;;;Ket qua ghi dang Leader va 1 Mtext co 2 dong
;;;-------------------------------------------------------------
;;;4- Lenh CL: ve Center Line cho duong tron tai layer CEN
;;;Neu Layer khong ton tai, chuong trinh tu tao layer CEN
;;;Voi thiet lap mau Magenta, Ltype ACAD_ISO04W100
;;;-------------------------------------------------------------
;;;5- Lenh L1: Do va ghi chieu dai 1 doi tuong, vi tri dat text do user chon
;;;-------------------------------------------------------------
;;;6- Lenh LL: Do va ghi chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Vi tri dat text tai diem giua cua tung doi tuong
;;;-------------------------------------------------------------
;;;7- Lenh LTO: Do va ghi tong chieu dai nhieu doi tuong, user chon vi tri dat text
;;;-------------------------------------------------------------
;;;GHI CHU CHUNG VOI KET QUA GHI DANG TEXT
;;;Chuong trinh dung TextStyle hien hanh de ghi ket qua
;;;So chu so thap phan phu thuoc thiet lap Units
;;;Vao Format -> Units -> chon Precision tuy y
;;;-------------------------------------------------------------
;;;Copyright by ssg - www.cadviet.com - March 2009
;;;=================================
;;;PUBLIC FUNCTIONS
;;;=================================
(defun getL(e) ;;;Get Length of curve e
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;-------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(Defun Bdraw()
;;;Begin draw, get some current system variables, disable them
(setq OldOs (getvar "osmode"))
(setq OldLay (getvar "clayer"))
(setvar "osmode" 0)
)
;;;-------------------------------------------------------------
(Defun Edraw()
;;;End draw, reset all system variables
(setvar "osmode" OldOs)
(setvar "clayer" OldLay)
)
;;;-------------------------------------------------------------
(Defun SetLayer(MyLayer)
;;;Make and Set Layer
(if (not (tblsearch "LAYER" MyLayer)) (progn
(Cond
((= (strcase MyLayer) "0") (setq MyColor "White" MyLtype "Continuous"))
((= (strcase MyLayer) "CEN") (setq MyColor "Magenta" MyLtype "ACAD_ISO04W100"))
((= (strcase MyLayer) "DIM") (setq MyColor "Green" MyLtype "Continuous"))
((= (strcase MyLayer) "HATCH") (setq MyColor "Yellow" MyLtype "Continuous"))
((= (strcase MyLayer) "HID") (setq MyColor "Cyan" MyLtype "ACAD_ISO02W100"))
((= (strcase MyLayer) "STT") (setq MyColor 140 MyLtype "Continuous"))
((= (strcase MyLayer) "KHUNGTEN") (setq MyColor 120 MyLtype "Continuous"))
)
(Command "Layer" "N" MyLayer "L" MyLtype MyLayer "C" MyColor MyLayer "T" MyLayer "")
))
(setvar "CLayer" MyLayer)
)
;;;=================================
;;;DIMENSION AND GEOMETRIC COMMAND FUNCTIONS
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob)
)
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")
)
)
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)
)
)
;;;-------------------------------------------------------------
(defun C:SCC( / ss ssd p k opt) ;;;SCale with Constant dimensions
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nBase point:")
k (getreal "\nScale Factor:")
opt (strcase (getstring "\nDim scale overall? :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(princ)
)
;;;=================================
(defun C:CHD( / ss e txt n) ;;;CHeck Dimensions
(setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "DimCheck"))
(command "Layer" "N" "DimCheck" "C" "Red" "DimCheck" "")
)
(while (setq e (ssname ss 0))
(setq txt (cdr (assoc 1 (entget e))))
(if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
(command "change" e "" "p" "LA" "DimCheck" "")
(setq n (1+ n))
))
(ssdel e ss)
)
(if (= n 0) (setq S "Ket qua check: OK")
(setq S (strcat "Co " (itoa n) " Dimensions bi sua Text Override"
"\nDa duoc chuyen sang layer DimCheck co mau RED!")
)
)
(alert S)
(princ)
)
;;;=================================
(defun C:XY( / p1 p2)
(setq
p1 (getpoint "\nFirst point:")
p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X=" (rtos (car p1)) "\\PY=" (rtos (cadr p1))) "")
(princ)
)
;;;=================================
(defun C:CL(/ p r p1 p2 p3 p4 oldos oldlay) ;;;Center Line duong tron
(setq
p (getpoint "\nCenter point:")
oldOrtho (getvar "orthomode")
)
(setvar "orthomode" 1)
(setq r (getdist p "\nEnd point: "))
(Bdraw)
(SetLayer "CEN")
(command "line" (polar p pi r) (polar p 0 r) "")
(command "line" (polar p (/ pi 2) r) (polar p (/ pi -2) r) "")
(setvar "orthomode" oldOrtho)
(Edraw)
(princ)
)
;;;=================================
(defun C:L1( / e L) ;;;Do va ghi chieu dai 1 doi tuong
(setq e (car (entsel "\nSelect object:")))
(command "lengthen" e "")
(setq L (getvar "perimeter"))
(wtxt (strcat "L= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================
(defun Measure1(e / L p)
(vl-load-com)
(setq
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
p (vlax-curve-getPointAtDist e (/ L 2))
)
(wtxt (strcat "L= " (rtos L)) p)
)
;;;-------------------------------------------------------------
(defun C:LL( / ss e) ;;;Do chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Ket qua ghi tai diem giua cua tung doi tuong
(setq ss (ssget '((0 . "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))))
(while (setq e (ssname ss 0))
(measure1 e)
(ssdel e ss)
)
)
;;;=================================
(defun C:LTO( / ss Le L e L1) ;;;Do va ghi tong chieu dai nhieu doi tuong
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
Le (ss2ent ss)
L 0
)
(foreach e Le (setq L (+ L (getL e))))
(wtxt (strcat "Lt= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================
2- Có vấn đề gì về sử dụng, các bạn phản hồi để ssg sửa
3- Cần bổ sung thêm những tiện ích gì thuộc dạng này không?
Thanks.
bạn có thể nói rõ thêm về các ứng dụng cũng như cách sử dụng(câu lệnh) được kô?
<<
|
|
Filename: 52190_scc_chd_xy_cl_l1_ll_lto.lsp
|
|
Tác giả: bach1212
Bài viết gốc: 194919
Tên lệnh: brh |
Nhờ các bạn viết Lisp cắt đôi miếng hatch
Ồ, lần trước nói ý nói tứ rồi mà bạn lại lập tiếp cái nữa.
Thôi thì nói thẳng với bạn vậy : Hãy tránh dùng từ " >>
Ồ, lần trước nói ý nói tứ rồi mà bạn lại lập tiếp cái nữa.
Thôi thì nói thẳng với bạn vậy : Hãy tránh dùng từ "Tôi muốn", vì bạn đang ở vị trí người cần được giúp đỡ ^^ (Mặc dù đội ngũ BQT thống nhất với tiền tố cho ngắn gọn)
- Về vấn đề của bạn, Hatch là đối tượng khó chịu, với khả năng của mình thì chỉ giúp bạn được ở mức thực hiện thao tác trim + Hatch lại giúp bạn thôi.
Lệnh : brh
Thao tác : Chọn Pline chia, Pick vào 1 phía của miếng Hatch
(defun c:brh ()
(grtext -1 "Free Lisp From Cadviet @Ketxu")
(setq Pline (car (entsel "\n Pick vao Pline"))
e (entsel "\nPick vao vung Hatch ")
hObj (car e)
pt (cadr e)
)
(command ".trim" Pline "" pt "" "-hatch" pt "" "_MATCHPROP" hObj (entlast) ""))
Bác ketxu bổ sung thêm lựa chọn đường cắt là nhiều đường 1 lúc, và có thể chọn cả pline, arc, spline....được không ah? Thanks bác
<<
|
Tác giả: proconeng86
Bài viết gốc: 297082
Tên lệnh: tmp |
lisp tính tổng số đai trong dim
Bạn thử dùng cái này, nó chẳng phân biệt kiểu dim, chỉ phân biệt tẽt dim thôi.
(defun...
>>
Bạn thử dùng cái này, nó chẳng phân biệt kiểu dim, chỉ phân biệt tẽt dim thôi.
(defun c:tmp()
(defun GeD(v / l en)
(setq l nil)
(vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
(cdr (assoc 2 (entget v))))
(if (= "MTEXT" (cdr (assoc 0 (entget (setq en (vlax-vla-object->ename item))))))
(setq l en))
) l
)
(Prompt "\nChon Dim:")
(setq l nil)
(foreach x (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
(setq txt (cdr (assoc 1 (entget (Ged x))))
sl (atoi (substr txt (+ 2 (vl-string-search "[" txt))
(- (vl-string-search "%" txt) (vl-string-search "[" txt) 1)))
fi (atoi (substr txt (+ 4 (vl-string-search "%" txt))
(- (vl-string-search "a" txt) (vl-string-search "%" txt) 3)))
l (if (not (assoc fi l))
(cons (cons fi sl) l)
(subst (cons fi (+ sl (cdr (assoc fi l)))) (assoc fi l) l)))
)
(foreach x l (princ (strcat "\n" (itoa (cdr x)) (chr 216) (itoa (car x)))))
(princ)
)
Lisp này rất tốt đó,đúng ý mình rồi tuy nhiên có 1 điều là nó đưa ra số đai ở dòng command, mà dòng này thì mình hay để nó bé nhất có thể để cho màn hình vẽ được lớn hơn. Bạn Tot77 có thể sửa giúp mình lại là đưa ra bảng thông báo trên màn hình như lisp của bạn phamthanhbinh được không. Lisp của bạn phamthanhbinh có bao nhiêu loại đường kính đai thì xuất hiện bấy nhiêu bảng, bạn sửa lại chỉ xuất hiện 1 bảng cho tất cả các loại đai chọn nhé (như thông báo trong dòng command của bạn đó nhưng là bảng hiện trên màn hình)
Mình cám ơn nhiều :)
<<
|
Tác giả: calendar08
Bài viết gốc: 161270
Tên lệnh: t2m |
Cần help convert text - Mtext
Hề hề hề,Có phải bạn muốn cái này không??? Nó cũng sử dụng txt2mtxt của express tools đấy. Tuy nhiên cách dùng hơi khác mà...
>>
Hề hề hề,Có phải bạn muốn cái này không??? Nó cũng sử dụng txt2mtxt của express tools đấy. Tuy nhiên cách dùng hơi khác mà thôi.
(defun c:t2m (/ slt txt )(vl-load-com)(command "undo" "be")(alert "\n Hay chon cac text can chuyen thanh mtext")(setq slt (acet-ss-to-list (ssget (list (cons 0 "text")))))(foreach txt slt(command "txt2mtxt" txt ""))(command "undo" "e")(princ))
Hề hề hề, nếu bạn thấy chưa ưng thì hãy post rõ cái chỗ chưa ưng lên nhé.Chúc bạn vui.
Thanks bạn nhìu nha. Dưới là vấn đề nè.
Đây là nguyên bản trc khi dùng lisp của bạn
Và đây là sau khi dùng lisp
Mình cần là sau khi dùng lisp các text được chuyển giữ đc vị trí như ở hình 1.
Thanks bạn rất nhiều:)
<<
|
Tác giả: quocmanh04tt
Bài viết gốc: 425018
Tên lệnh: lc+%C2%A0 |
vấn đề về lệnh tắt trong cad
13 giờ trước, danhandoi đã nói:
Giống bác trên, mình cũng làm như...
>>
13 giờ trước, danhandoi đã nói:
Giống bác trên, mình cũng làm như thế mà cái khung nó không to ra được?
Chắc là muốn như vầy:
(defun c:lc (/ LM:ListBox str lstData ST:SendKeys)
(defun c:Xformat nil
(alert "B\U+1EA1n có ch\U+1EAFc là XÓA S\U+1EA0CH \U+1ED5 c\U+1EE9ng không?")
(princ))
(setq lstData (acad_strlsort
(list ;Viet tiep cac lenh vao duoi dong nay theo mau "Ten lenh Noi dung"
"Erase \tXoa doi tuong" "Copy \tSao chep doi tuong" "Mirror \tLay doi xung" "CO \tCopy th\U+00F4ng minh"
"XFormat \tXóa s\U+1EA1ch \U+1ED5 c\U+1EE9ng, d\U+1EADp tan màn h\U+00ECnh...")))
(defun ST:SendKeys (keys / ws)
(vlax-invoke-method (setq ws (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object ws)
(princ))
(defun LM:ListBox (title data multiple / file tmp dch return)
(cond ((not
(and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
(write-line (strcat "listbox : dialog { label = \""
title
"\"; spacer; : list_box { key = \"list\"; multiple_select = "
(if multiple
"true"
"false")
"; width = 100; height= 30; tabs = \"10 20 30\";
} spacer; ok_cancel;}")
file)
(not (close file))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch))))
(t
(start_list "list")
(mapcar 'add_list data)
(end_list)
(setq return (set_tile "list" "0"))
(action_tile "list" "(setq return $value)")
(setq return (if (= 1 (start_dialog))
(mapcar '(lambda (x) (nth x data)) (read (strcat "(" return ")")))))))
(if (< 0 dch)
(unload_dialog dch))
(if (setq tmp (findfile tmp))
(vl-file-delete tmp))
return)
(cond ((setq str (LM:ListBox "Ghi ch\U+00FA l\U+1EC7nh - lisp CAD - @ketxu - 2/6/2012 :" lstData nil))
(setq str (car str))
(ST:SendKeys (strcat (substr str 1 (vl-string-position 32 str)) "\n"))))
(princ))
<<
|
|
Filename: 425018_lc+%C2%A0.lsp
|
|
Tác giả: Phiphi-
Bài viết gốc: 73495
Tên lệnh: nalcl nall |
Lisp xuất-nhập toạ độ
PP dùng Lisp Copy+Align do bác Duy782006 viết, có nhiều cái hay trong đó. Giới thiệu để các Bác thử xem:
*Đây bạn: -Tên lệnh: NALL (new algin line)
-Chọn...
>>
PP dùng Lisp Copy+Align do bác Duy782006 viết, có nhiều cái hay trong đó. Giới thiệu để các Bác thử xem:
*Đây bạn: -Tên lệnh: NALL (new algin line)
-Chọn đối tượng mốn copy và rotate (1 hoặc nhiều đối tượng) enter.
-Chọn các line (1 hoặc nhiều đối tượng, chỉ nhận đối tượng line) enter ==>Xong.
*Ở đây thì lisp sẽ copy đối tượng từ điểm đích thứ nhất đến điểm đầu của line và quay nó song song với line. Nếu bạn muốn copy đối tượng từ điểm đích thứ nhất đến điểm cuối của line thì sửa
(setq diem1m (cdr (assoc 10 ttdt)))
(setq diem2m (cdr (assoc 11 ttdt)))
Thành
(setq diem1m (cdr (assoc 11 ttdt)))
(setq diem2m (cdr (assoc 10 ttdt)))
Là được.
*Sẳn tiện mình viết luôn lệnh NALCL:
Giống lệnh trên nhưng thay vì chọn 2 điểm nguồn thì lisp hỏi chọn line nguồn (line này có thể nằm trong tập hợp chọn hoặc không gì cũng được). Lisp sẽ lầy điểm đầu và điểm cuối của line này làm 2 điểm nguồn.
(Defun C:NALCL ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(setq donvi (/ (getvar "viewsize") 50))
(Princ "\nHay chon doi tuong :")
(setq XX (ssget))
(setq ddd (entsel "\nChon LINE nguon"))
(while
(or
(null ddd)
(/= "LINE" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la LINE! Chon lai")
(setq ddd (entsel "\nChon LINE nguon"))
)
(setq DTDTT (car ddd))
(setq DTTT (entget DTDTT))
(setq NDTTT (cdr (assoc 1 DTTT)))
(setq diem1 (cdr (assoc 10 DTTT)))
(setq diem2 (cdr (assoc 11 DTTT)))
(grdraw diem1 diem2 3)
(setq gocchuan(angle diem1 diem2))
(thuchienchon)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun C:NALL ( )
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "undo" "be")
(setq donvi (/ (getvar "viewsize") 50))
(Princ "\nHay chon doi tuong :")
(setq XX (ssget))
(setq diem1 (getpoint "\nDiem chuan thu nhat: "))
(setq diemvt1 (polar diem1 pi donvi))
(setq diemvt2 (polar diem1 (* 2 pi) donvi))
(setq diemvt3 (polar diem1 (/ pi 2) donvi))
(setq diemvt4 (polar diem1 (- 0 (/ pi 2)) donvi))
(grdraw diemvt1 diemvt2 3)
(grdraw diemvt3 diemvt4 3)
(setq diem2 (getpoint "\nDiem chuan thu hai: "))
(setq diemvt12 (polar diem2 pi donvi))
(setq diemvt22 (polar diem2 (* 2 pi) donvi))
(setq diemvt32 (polar diem2 (/ pi 2) donvi))
(setq diemvt42 (polar diem2 (- 0 (/ pi 2)) donvi))
(grdraw diemvt12 diemvt22 3)
(grdraw diemvt32 diemvt42 3)
(setq gocchuan(angle diem1 diem2))
(thuchienchon)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchienchon ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(Princ "\nHay chon cac LINE dich :")
(setq SS (ssget '((0 . "LINE"))))
(setq i 0)
(setq N (sslength ss))
(while (< i N)
(setq doituong (ssname SS i))
(setq ttdt (entget doituong))
(setq diem1m (cdr (assoc 10 ttdt)))
(setq diem2m (cdr (assoc 11 ttdt)))
(thuchienall)
(setq i (1+ i))
)
(setvar "osmode"luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchienall ()
(setq gocmoi(angle diem1m diem2m))
(setq goctinh (- gocmoi gocchuan))
(setq diem3 (polar diem1m goctinh 100))
(setq L 0)
(setq M (sslength XX))
(while (< L M)
(setq DT (ssname xx L))
(command ".copy" DT "" diem1 diem1m)
(command ".rotate" "last" "" diem1m diem3)
(setq L (1+ L))
)
(Princ)
)
http://www.cadviet.com/forum/index.php?sho...12064&st=20
<<
|
|
Filename: 73495_nalcl_nall.lsp
|
|
Tác giả: Danh Cong
Bài viết gốc: 425027
Tên lệnh: kt |
Nhờ viết lisp tra kinh tuyến các Tỉnh
+ Nhập tên địa danh nhé, không dấu nhé :
(defun c:KT ()
(setq danhsach (list
'(0 "Ha Noi" 105.00)
'(1 "Ho Chi Minh" 105.45)
'(2 "Lai Chau" 103.30)
'(3 "Dien Bien" 103.30)
)
i 0)
(setq n (length danhsach))
(setq name (getstring T "Nhap ten dia danh:...
>>
+ Nhập tên địa danh nhé, không dấu nhé :
(defun c:KT ()
(setq danhsach (list
'(0 "Ha Noi" 105.00)
'(1 "Ho Chi Minh" 105.45)
'(2 "Lai Chau" 103.30)
'(3 "Dien Bien" 103.30)
)
i 0)
(setq n (length danhsach))
(setq name (getstring T "Nhap ten dia danh: "))
(while (and (< i n) (/= (strcase name) (strcase (cadr (nth i danhsach)))))
(setq i (+ i 1)))
(if (< i n)
(alert (strcat "Kinh tuyen: " (Rtos (caddr (nth i danhsach)) 2 2)))
(alert "Co gi do sai roi! - Kiem tra lai di !"))
(princ)
)
<< |
Tác giả: thanhduan2407
Bài viết gốc: 425053
Tên lệnh: ktt |
Nhờ viết lisp tra kinh tuyến các Tỉnh
Bạn dùng cái này! Tra được KTT trên cả 2 hệ tọa độ VN2000 và HN72.
(defun c:KTT (/ TENTINH KTUYENTRUC_)
;;;KINH TUYEN TRUC
(setvar "CMDECHO" 0)
(initget "VN2000 HN72")
(setq KTUYENTRUC_
(strcase
(getkword
"\nB\U+1EA1n mu\U+1ED1n t\U+00ECm kinh tuy\U+1EBFn tr\U+1EE5c thu\U+1ED9c h\U+1EC7 t\U+1ECDa \U+0111\U+1ED9 n\U+00E0o? :"
)
)
)
(setq TENTINH
(strcase
...
>>
Bạn dùng cái này! Tra được KTT trên cả 2 hệ tọa độ VN2000 và HN72.
(defun c:KTT (/ TENTINH KTUYENTRUC_)
;;;KINH TUYEN TRUC
(setvar "CMDECHO" 0)
(initget "VN2000 HN72")
(setq KTUYENTRUC_
(strcase
(getkword
"\nB\U+1EA1n mu\U+1ED1n t\U+00ECm kinh tuy\U+1EBFn tr\U+1EE5c thu\U+1ED9c h\U+1EC7 t\U+1ECDa \U+0111\U+1ED9 n\U+00E0o? :"
)
)
)
(setq TENTINH
(strcase
(getstring
"\nNh\U+1EADp t\U+00EAn t\U+1EC9nh (g\U+1ED3m ch\U+1EEF c\U+00E1i \U+0111\U+1EA7u c\U+1EE7a t\U+00EAn th\U+1EE9 nh\U+1EA5t v\U+00E0 2 ch\U+1EEF c\U+00E1i \U+0111\U+1EA7u c\U+1EE7a t\U+00EAn th\U+1EE9 hai. VD: Hai Phong = HPH): "
)
)
)
(setq KINHTUYENTRUC (GetTINH TENTINH KTUYENTRUC_ ))
(Alert KINHTUYENTRUC)
(princ KINHTUYENTRUC)
(princ)
)
(Defun GetTINH (NAMETINH HTD / Lt1)
(setq Tinh nil)
(setq
Lt1 (list
(LIST "LCH" "Lai Chau = 103 00")
(LIST "DBI" "Dien Bien = 103 00")
(LIST "SLA" "Son La = 104 00")
(LIST "LCA" "Lao Cai = 104 45")
(LIST "YBA" "Yen Bai = 104 45")
(LIST "HGI" "Hau Giang = 105 00 ...... Ha Giang = 105 30")
(LIST "TQU" "Tuyen Quang = 106 00")
(LIST "PTH" "Phu Tho = 104 45")
(LIST "VPH" "Vinh Phuc = 105 00")
(LIST "CBA" "Cao Bang = 105 45")
(LIST "LSO" "Lang Son = 107 15")
(LIST "BCA" "Bac Can = 106 30")
(LIST "TNG" "Thai Nguyen = 106 30")
(LIST "BGI" "Bac Giang = 107 00")
(LIST "BNI" "Bac Ninh = 105 30")
(LIST "QNI" "Quang Ninh = 107 45")
(LIST "HPH" "Hai Phong = 105 45")
(LIST "HDU" "Hai Duong = 105 30")
(LIST "HYE" "Hung Yen = 105 30")
(LIST "HNO" "Ha Noi = 105 00")
(LIST "HBI" "Hoa Binh = 106 00")
(LIST "HNA" "Ha Nam = 105 00")
(LIST "NDI" "Nam Dinh = 105 30")
(LIST "TBI" "Thai Binh = 105 30")
(LIST "NBI" "Ninh Binh = 105 00")
(LIST "THO" "Thanh hoa = 105 00")
(LIST "NAN" "Nghe An = 104 45")
(LIST "HTI" "Ha Tinh = 105 30")
(LIST "QBI" "Quang Binh = 106 00")
(LIST "QTR" "Quang Tri = 106 15")
(LIST "TTH" "Thua Thien Hue = 107 00")
(LIST "DNA" "Da Nang = 107 45 ...... Dong Nai = 107 45")
(LIST "QNA" "Quang Nam = 107 45")
(LIST "QNG" "Quang Ngai = 108 00")
(LIST "BDI" "Binh Dinh = 108 15")
(LIST "KTU" "Kon Tum = 107 30")
(LIST "GLA" "Gia Lai = 108 30")
(LIST "DLA" "Dak Lak = 108 30")
(LIST "DNO" "Dak Nong = 108 30")
(LIST "PYE" "Phu Yen = 108 30")
(LIST "KHO" "Khanh Hoa = 108 15")
(LIST "NTH" "Ninh Thuan = 108 15")
(LIST "BTH" "Binh Thuan = 108 30")
(LIST "LDO" "Lam Dong = 107 45")
(LIST "BDU" "Binh Duong = 105 45")
(LIST "BPH" "Binh Phuoc = 106 15")
(LIST "DNA" "Dong Nai = 107 45")
(LIST "BRI" "Ba Ria Vung Tau = 107 45")
(LIST "VTA" "Ba Ria Vung Tau = 107 45")
(LIST "TNI" "Tay Ninh = 105 30")
(LIST "LAN" "Long An = 105 45")
(LIST "TGI" "Tien Giang = 105 45")
(LIST "BTR" "Ben Tre = 105 45")
(LIST "DTH" "Dong Thap = 105 00")
(LIST "VLO" "Vinh Long = 105 30")
(LIST "TVI" "Tra Vinh = 105 30")
(LIST "AGI" "An Giang = 104 45")
(LIST "KGI" "Kien Giang = 104 30")
(LIST "CTH" "Can Tho = 105 00")
(LIST "STR" "Soc Trang = 105 30")
(LIST "BLI" "Bac Lieu = 105 00")
(LIST "CMA" "Ca Mau = 104 30")
(LIST "HCM" "TP HCM = 105 45")
)
)
(setq
Lt2 (list
(LIST "LCH" "Lai Chau = 103 00")
(LIST "DBI" "Dien Bien = Khong co")
(LIST "SLA" "Son La = 104 00")
(LIST "LCA" "Lao Cai = 104 00")
(LIST "YBA" "Yen Bai = 104 30")
(LIST "HGI" "Ha Gian = 105 00")
(LIST "TQU" "Tuyen Quang = 105 00")
(LIST "PTH" "Phu Tho = 105 00")
(LIST "VPH" "Vinh Phuc = 105 00")
(LIST "CBA" "Cao Bang = 106 00")
(LIST "LSO" "Lang Son = 107 00")
(LIST "BCA" "Bac Can = 106 00")
(LIST "TNG" "Thai Nguyen = 106 00")
(LIST "BGI" "Bac Giang = 106 30")
(LIST "BNI" "Bac Ninh = 106 00")
(LIST "QNI" "Quang Ninh = 107 00")
(LIST "HPH" "Hai Phong = 107 00")
(LIST "HDU" "Hai Duong = 106 00")
(LIST "HYE" "Hung Yen = 106 00")
(LIST "HNO" "Ha Noi = 105 45")
(LIST "HBI" "Hoa Binh = 105 00")
(LIST "HNA" "Ha Nam = 106 00")
(LIST "NDI" "Nam Dinh = 106 00")
(LIST "TBI" "Thai Binh = 106 00")
(LIST "NBI" "Ninh Binh = 106 00")
(LIST "THO" "Thanh hoa = 105 00")
(LIST "NAN" "Nghe An = 105 00")
(LIST "HTI" "Ha Tinh = 106 00")
(LIST "QBI" "Quang Binh = 106 30")
(LIST "QTR" "Quang Tri = 107 00")
(LIST "TTH" "Thua Thien Hue = 107 30")
(LIST "TDA" "Da Nang = 108 00")
(LIST "QNA" "Quang Nam = 108 00")
(LIST "QNG" "Quang Ngai = 109 00")
(LIST "BDI" "Binh Dinh = 109 00")
(LIST "KTU" "Kon Tum = 108 00")
(LIST "GLA" "Gia Lai = 108 00")
(LIST "DLA" "Dak Lak = 108 00")
(LIST "DNO" "Dak Nong = Khong co")
(LIST "PYE" "Phu Yen = 109 00")
(LIST "KHO" "Khanh Hoa = 109 00")
(LIST "NTH" "Ninh Thuan = 109 00")
(LIST "BTH" "Binh Thuan = 108 00")
(LIST "LDO" "Lam Dong = 108 00")
(LIST "BDU" "Binh Duong = 107 00")
(LIST "BPH" "Binh Phuoc = 107 00")
(LIST "DNA" "Dong Nai = 107 00")
(LIST "BRI" "Ba Ria Vung Tau = 107 00")
(LIST "TNI" "Tay Ninh = 106 00")
(LIST "LAN" "Long An = 106 00")
(LIST "TGI" "Tien Giang = 106 00")
(LIST "BTR" "Ben Tre = 106 00")
(LIST "DTH" "Dong Thap = 106 00")
(LIST "VLO" "Vinh Long = 106 00")
(LIST "TVI" "Tra Vinh = 106 00")
(LIST "AGI" "An Giang = 105 00")
(LIST "KGI" "Kien Giang = 105 00")
(LIST "CTH" "Can Tho = 106 30")
(LIST "HGI" "Hau Giang = Khong co")
(LIST "STR" "Soc Trang = 106 00")
(LIST "BLI" "Bac Lieu = 106 00")
(LIST "CMA" "Ca Mau = 105 00")
(LIST "HCM" "TP HCM = 105 00")
)
)
(Cond ((equal HTD "VN2000")
(setq
Tinh
(car (vl-remove nil
(mapcar '(lambda (x)
(if (= (car x) NAMETINH)
(cadr x)
nil
)
)
Lt1
)
)
)
)
)
((equal HTD "HN72")
(setq
Tinh
(car (vl-remove nil
(mapcar '(lambda (x)
(if (= (car x) NAMETINH)
(cadr x)
nil
)
)
Lt2
)
)
)
)
)
)
Tinh
)
<< |
Tác giả: letrongdaihp
Bài viết gốc: 219066
Tên lệnh: ha |
Lisp thống kê kích thước trong bản vẽ cad
Đây bạn ơi!
;Doan Van Ha - CADViet.com - Ngay 21/5/2012
;Muc dich: nhom cac doi tuong Dim cung Length, sau do xuat ra...
>>
Đây bạn ơi!
;Doan Van Ha - CADViet.com - Ngay 21/5/2012
;Muc dich: nhom cac doi tuong Dim cung Length, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong Dimension can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "DIMENSION")))))))
(foreach ent entlst
(if (= "" (cdr (assoc 1 (entget ent))))
(setq lst (cons (rtos (cdr (assoc 42 (entget ent))) 2 4) lst))
(setq lst (cons (cdr (assoc 1 (entget ent))) lst))))
(setq lst (LM:ListOccurrences lst))
(setq a lst)
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong") pw)
(foreach n lst
(write-line (strcat (vl-prin1-to-string (car n)) "\t" (itoa (cdr n))) pw))
(close pw))
(defun LM:ListOccurrences (lst)
(if lst
(cons
(cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
(LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
Xin chào cả nhà, mình thấy lisp của bạn Hà rất tuyệt! Mình cũng đang cần nó. Có cách nào mà không phải là chọn các Dim mà là chọn luôn đối tượng không hả bạn, như vậy mình đỡ phải Dim nữa!
<<
|