Info | File |
Tác giả: gia_bach
Bài viết gốc: 50161
Tên lệnh: dm |
Viết Lisp theo yêu cầu
Chào bạn dacphuong, Bạn dùng thử đoạn code sau đây xem sao:
(defun c:dm ()
(setq ss (ssget "x" (list (cons 0...
>>
Chào bạn dacphuong, Bạn dùng thử đoạn code sau đây xem sao:
(defun c:dm ()
(setq ss (ssget "x" (list (cons 0 "line"))))
.............................................
(Command "dimaligned" fp ep (list (+ (car fp) 10) (+ (cadr fp) 10)) "")
)
(princ)
)
....................
Chào bạn Phamthanhbinh,
Mình có vài góp ý :
- dòng (setq ss (ssget "x" (list (cons 0 "line")))) sẽ chọn tất cả các đường thẳng trong bản vẽ. Nhu cầu thông thường của User là click chọn đối tượng trong cửa sổ và lệnh dimaligned chỉ cho phép chọn đối tượng trên TAB hiện hành -> mình đề nghị đổi thành :
(setq ss (ssget (list (cons 410 (getvar "ctab")) (cons 0 "line"))))
- dòng (Command "dimaligned" fp ep (list (+ (car fp) 10) (+ (cadr fp) 10)) "") không cần 2 dấu nháy cuối cùng
-> (Command "dimaligned" fp ep (list (+ (car fp) 10) (+ (cadr fp) 10)) )
Chúc sức khỏe.
<<
|
Tác giả: txquychk51
Bài viết gốc: 408919
Tên lệnh: al |
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget...
>>
Quick code xem bạn dùng cái nào thì dùng ^^
Vanilla lisp
(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake
(list (cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(assoc 8 (entget (ssname s 0)))
(cons 1
(rtos
(repeat (sslength s)
(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))
))
)
(cons 10 (getpoint "\nInsert point :"))
)
)
(princ))
- Visual lisp :
(defun c:vl(/ d s l lr)(vl-load-com)
(while (not (ssget (list (cons 0 "*TEXT")))))
(vlax-for x
(setq s (vla-get-activeselectionset (setq d (vla-get-activedocument (vlax-get-acad-object)))))
(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
(or lr (setq lr (vla-get-layer x)))
)
(vla-put-layer
(vla-addmtext
(vla-get-block (vla-get-activelayout d))
(vlax-3d-point (getpoint "\nInsert point :"))
(getvar 'textsize)
(rtos (apply '+ l))
)
lr
)
(and s (not(vla-delete s))(vlax-release-object s))
(princ)
)
- Hoặc kết hợp với acet
(defun c:acet(/ s)
(entmake
(list (cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 1 (rtos
(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
)
(assoc 8 (entget (ssname s 0)))
(cons 10 (getpoint "\nInsert point :"))
)
)
(princ))
Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....
bác bày cho e cách sửa lisp al từ mtext thành text được ko ạ? e sửa mtext thành text+ bỏ 2 dòng dưới mà nó ko ra kết quả ạ :)
<<
|
Tác giả: Doan Van Ha
Bài viết gốc: 139088
Tên lệnh: me3 |
measure cho nhiều đối tượng
Bạn hãy kích nút thank động viên bạn ấy kèm theo lời nói :)
Mình cũng góp cái lisp vừa nãy thảo, không đc chi tiết như bạn HHVD viết...
>>
Bạn hãy kích nút thank động viên bạn ấy kèm theo lời nói :)
Mình cũng góp cái lisp vừa nãy thảo, không đc chi tiết như bạn HHVD viết
(defun c:me3 ()
(setq blk (getstring "\nEnter name of block to insert:")
isAlg (getstring "\nAlign block with object? <Y>")
dis (getdist "\nSpecify length of segment : "))
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
(command "measure" x "B" blk isAlg dis)
)
)
À, ra thế!
<<
|
Tác giả: Han Tinh
Bài viết gốc: 405318
Tên lệnh: md |
Lisp Đóng Mở Ngoặc Text, Mtext, Dim
Bạn thử Lisp này:
(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
...
>>
Bạn thử Lisp này:
(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
(setq i 0)
(mapcar 'set '(find rep str icase) Lst)
(while (setq i (vl-string-search (if icase (strcase find) find)
(if icase (strcase str) str) i))
(if icase
(setq str (vl-string-subst (strcase find) find str i)
str (vl-string-subst rep (strcase find) str i))
(setq str (vl-string-subst rep find str i))
)
(setq i (+ i (strlen rep) ) ) )
str)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
(setq entget-ename (entget ename))
(if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
(setq entget-ename (append entget-ename (list (cons dxf newValue))))
)
(setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
(entmod entget-ename)
ename
)
(defun c:md()
(if (setq ss (ssget '((0 . "*TEXT,*DIMENSION")))) (progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if (and (wcmatch (setq nd (cdr(assoc 1 (entget e)))) "*(*")
(wcmatch nd "*)*")
)
(Tue-ent-mod 1 e (Tue-string-replace (list ")" "" (Tue-string-replace (list "(" "" nd)))))
(Tue-ent-mod 1 e (strcat "(" nd ")"))
)
)
))
)
Hai lsp của bạn và rất đúng với ý mình rồi, nhưng 2 lso này chưa chọn được đối tượng là dim. Mong hai bạn giúp thêm
<<
|
Tác giả: Ar_Chanwoo
Bài viết gốc: 14478
Tên lệnh: test reset |
code giới hạn thời gian sử dụng File lisp
Ví dụ lệnh CUA nằm trong file c:\cadviet\lisp\archanwoo.lsp nhưng người sử dụng không biết tên lệnh là CUA. Khi người sử dụng lệnh TEST, sẽ tương đương như lệnh... >>
Ví dụ lệnh CUA nằm trong file c:\cadviet\lisp\archanwoo.lsp nhưng người sử dụng không biết tên lệnh là CUA. Khi người sử dụng lệnh TEST, sẽ tương đương như lệnh CUA, nhưng chỉ được 5 lần sử dụng. Code như sau:
(load "c:/cadviet/lisp/archanwoo.lsp");
(defun c:TEST()
(c:cua)
;;; Doc gia tri
(setq tmp (getcfg "AppData/CADViet/Count")
sl (cond
((or (not tmp) (= tmp "")) "5")
(t tmp)
)
)
;;; Kiem tra va thong bao
(if (/= sl "0")
(progn
;;; Thuc thi ma lenh
(princ (strcat "\nBan con " sl " lan su dung nua"))
;;; Luu gia tri
(setcfg "AppData/CADViet/Count" (itoa (1- (atoi sl))))
)
(princ "\nBan da het han su dung!")
)
(princ)
)
(defun c:RESET()
;;; Reset lai gia tri
(setcfg "AppData/CADViet/Count" "")
(princ)
)
Thanks
<<
|
Filename: 14478_test_reset.lsp
|
|
Tác giả: dungpham01
Bài viết gốc: 431962
Tên lệnh: mc |
Xin lisp đo chiều dài từng đường pline một.
(defun C:mc (/ tap i d strd endd midd l)
(vl-load-com)
(setq tap (ssget '((0 . "lwpolyline"))) i 0)
(while (< i (sslength tap))
(setq d (vlax-ename->vla-object (ssname tap i)))
(setq strd (vlax-curve-getStartPoint d) endd (vlax-curve-getEndPoint d) l (vlax-get d 'length))
(setq midd (list (/ (+ (car strd) (car endd)) 2) (/ (+ (cadr strd) (cadr endd)) 2)))
(entmake (list '(0 . "text") '(7 . "standard") (cons 10...
>>
(defun C:mc (/ tap i d strd endd midd l)
(vl-load-com)
(setq tap (ssget '((0 . "lwpolyline"))) i 0)
(while (< i (sslength tap))
(setq d (vlax-ename->vla-object (ssname tap i)))
(setq strd (vlax-curve-getStartPoint d) endd (vlax-curve-getEndPoint d) l (vlax-get d 'length))
(setq midd (list (/ (+ (car strd) (car endd)) 2) (/ (+ (cadr strd) (cadr endd)) 2)))
(entmake (list '(0 . "text") '(7 . "standard") (cons 10 midd) (cons 11 midd) '(40 . 1000) '(72 . 1) (cons 1 (rtos l 2 3))))
(setq i (1+ i))
))
<<
|
Tác giả: 18011985
Bài viết gốc: 96897
Tên lệnh: a1 |
Edit_box trong dialog
Chào bạn 18011985, Bạn muốn lấy giá trị của biến trong edit-box thì bạn cần lưu ý tới việc đặt tên biến và sử dụng hàm savevars để lưu biến. Hãy đọc...
>>
Chào bạn 18011985, Bạn muốn lấy giá trị của biến trong edit-box thì bạn cần lưu ý tới việc đặt tên biến và sử dụng hàm savevars để lưu biến. Hãy đọc kỹ tài liệu mà mình đã gửi cho bạn.
Chúc bạn thành công.
Mình đã đọc nhưng chưa thông. Mình post đoạn lsp lên bạn góp ý hộ mình nhé.
(defun c:a1 ()
(setq dcl_id (load_dialog "Kcd.DCL"))
(while (not (vl-position hanh '(1 0)))
(if (not (new_dialog "Kcd" dcl_id))
(progn
(alert "\n Kh«ng t×m ®îc file dcl")
(exit)))
(action_tile "diem1" "(done_dialog 2)")
(action_tile "diem2" "(done_dialog 3)")
(setq hanh (start_dialog))
(if (= hanh 2) (setq diem1 (getpoint)) )
(if (= hanh 3) (setq diem2 (getpoint)) )
);while
(action_tile "accept" "(savevar)(done_dialog)")
(setq dcl_id (unload_dialog dcl_id))
)
(defun savevar()
(setq tyleD1 (atof (get_tile "tyleD")))
(setq tyleN1 (atof (get_tile "tyleN")))
(setq Mss1 (atof (get_tile "Mss")))
)
Còn đây là đoạn DCL
Kcd : dialog { label = "----------------------------";
:column {
:boxed_column {
:text {
label = "------------------------";
alignment = centered;
}
:boxed_column {
label = "Lùa chän tû lÖ";
:edit_box {
key = "tyleD";
label = "Tû lÖ ®øng: ";
edit_width = 10;
value = "100";
}
:edit_box {
key = "tyleN";
label = "Tû lÖ ngang: ";
edit_width = 10;
value = "100";
}
:edit_box {
key = "Mss";
label = "Møc so s¸nh: ";
edit_width = 10;
value = "0";
}
}
:boxed_column {
label = "Lùa chän ®êng giãng";
:row {
:text {
label = "§iÓm ®Çu ®êng giãng: ";
}
:button {
key = "diem1";
label = "Chän ®iÓm";
}
}
:row {
:text {
label = "§iÓm cuèi ®êng giãng: ";
}
:button {
key = "diem2";
label = "Chän ®iÓm";
}
}
}
:spacer {height=1;}
ok_cancel;
}
}
}
<<
|
Tác giả: dungpham01
Bài viết gốc: 431976
Tên lệnh: mc |
Xin lisp đo chiều dài từng đường pline một.
(defun C:mc (/ tap i d strd endd midd l)
(vl-load-com)
(setq tap (ssget '((0 . "lwpolyline"))) i 0)
(while (< i (sslength tap))
(setq d (vlax-ename->vla-object (ssname tap i)))
(setq strd (vlax-curve-getStartPoint d) endd (vlax-curve-getEndPoint d) l (vlax-get d 'length))
(setq midd (list (/ (+ (car strd) (car endd)) 2) (/ (+ (cadr strd) (cadr endd)) 2)))
(entmake (list '(0 . "text") '(7 . "standard") (cons 10...
>>
(defun C:mc (/ tap i d strd endd midd l)
(vl-load-com)
(setq tap (ssget '((0 . "lwpolyline"))) i 0)
(while (< i (sslength tap))
(setq d (vlax-ename->vla-object (ssname tap i)))
(setq strd (vlax-curve-getStartPoint d) endd (vlax-curve-getEndPoint d) l (vlax-get d 'length))
(setq midd (list (/ (+ (car strd) (car endd)) 2) (/ (+ (cadr strd) (cadr endd)) 2)))
(entmake (list '(0 . "text") '(7 . "standard") (cons 10 midd) (cons 11 midd) '(40 . 1000) '(72 . 1) (cons 1 (rtos (/ l 1000) 2 3))))
(setq i (1+ i))
))
bạn chỉ cần thay chữ "l" trong dòng thứ 3 từ dưới lên bằng (/ l 1000) là ok thôi
<<
|
Tác giả: dinhvantrang
Bài viết gốc: 246768
Tên lệnh: 6 |
VBA cho AutoCad-Hãy cùng tham gia trao đổi
Mình thấy trong Lisp có hàm ssget ( chọn đối tượng ) --> trong vba không có --> mình thử xây dựng 1 hàm gần giống như kiểu ssget...
>>
Mình thấy trong Lisp có hàm ssget ( chọn đối tượng ) --> trong vba không có --> mình thử xây dựng 1 hàm gần giống như kiểu ssget như sau :
Sub ssget()
Dim ssetObj As AcadSelectionSet
Dim entity As AcadEntity
Set ssetObj = ThisDrawing.PickfirstSelectionSet
If ssetObj.Count Then
...........................
Else
Set ssetObj = ThisDrawing.SelectionSets.Add("#")
If Err <> 0 Then
Set ssetObj = ThisDrawing.SelectionSets("#"): ssetObj.Clear
End If
ssetObj.SelectOnScreen
...............................
End Sub
Nếu mà code trên chạy trong môi trường vba thì không vấn đề gì : * thuộc tính pickfirstSelectionset hoạt động bình thường
nhưng nếu ta thử gọi macro trên bằng lisp thì thuộc tính pickfristSelectionset không thể hoạt động : hàm báo lỗi nil
(defun C:6()
(command "-vbarun" "ssget")
)
---> Mình vẫn chưa tìm ra được nguyên nhân và cách khắc phục, mong các bạn yêu thích vba trong autocad chia sẻ ,trao đổi thêm về vấn để trên !
thanks! <----------- cảm ơn mọi người đã dành thời gian đọc bài viết của mình
bạn đưa nguyên code lên coi nhé để mình xem thử,chứ Code viết như trên không hiểu đc lắm.Thực ra trong VBA đối tượng SelectionSet làm việc rất hiệu quả đó chứ.Các bộ lọc của nó cũng tương đương với bên Lisp.
<<
|
Tác giả: amateurday
Bài viết gốc: 146675
Tên lệnh: nscdpl |
nội suy cao độ đường cong
Cũng hơi đỏ mắt nhưng nếu được thì thêm 4 yêu cầu nữa:
-việc chọn cao độ 2 điểm sẽ là chọn trực tiếp trên bản vẽ thì tốt cực
-em nghĩ dấu x là không cần thiết vì điểm tọa độ chính là điểm chèn rồi, nên tạm biệt nó
-cho phép chọn số số lẻ theo ham muốn
-cho phép chọn điểm liên tục (không thoát lệnh) đến khi răng long đầu bạc mới...
>>
Cũng hơi đỏ mắt nhưng nếu được thì thêm 4 yêu cầu nữa:
-việc chọn cao độ 2 điểm sẽ là chọn trực tiếp trên bản vẽ thì tốt cực
-em nghĩ dấu x là không cần thiết vì điểm tọa độ chính là điểm chèn rồi, nên tạm biệt nó
-cho phép chọn số số lẻ theo ham muốn
-cho phép chọn điểm liên tục (không thoát lệnh) đến khi răng long đầu bạc mới thôi
Hề hề hề,
Bạn dùng thử cái này coi xem có ngứa con mắt bên phải, đỏ con mắt bên trái không nhé......
(defun c:nscdpl (/ pl oldos pdol obj ha ha hp pllength pl1)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setq pdol (getvar "pdmode"))
(setvar "osmode" 512)
(setvar "pdmode" 3)
(setq pl (car (entsel "\n Chon pline can noi suy"))
obj (vlax-ename->vla-object pl)
ha (getreal "\n Nhap cao do diem dau: ")
hb (getreal "\n Nhap cao do diem cuoi: ")
pllength (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
pt (getpoint "\n Chon diem can noi suy thuoc pline")
pl1 (vlax-curve-getdistatpoint obj pt)
hp (+ ha (* (- hb ha) (/ pl1 pllength)))
)
(command "point" pt "")
(command "text" pt 2 0 (rtos hp 2 2))
(setvar "osmode" oldos)
;;;(setvar "pdmode" pdol)
(princ)
)
Hễ chưa đã thì post lên nhé......
<<
|
Filename: 146675_nscdpl.lsp
|
|
Tác giả: tuan_thietkedien
Bài viết gốc: 43453
Tên lệnh: changetext |
Lisp đổi Text được chọn có chiều cao Height=0.2 và Width factor = 3 ????
Bạn dùng thử LISP này : Không biết bạn có gõ nhầm không? thực tế tui thấy bản vẽ ít dùng text có Width factor = 3
>>
Bạn dùng thử LISP này : Không biết bạn có gõ nhầm không? thực tế tui thấy bản vẽ ít dùng text có Width factor = 3
(defun C:ChangeText( / ss e d )
(setq ss (ssget '((0 . "TEXT")))
)
(while (setq e (ssname ss 0))
(setq d (entget e)
d (subst (cons 40 0.2) (assoc 40 d) d) ; Height=0.2
d (subst (cons 41 3) (assoc 41 d) d) ; Width factor = 3
)
(entmod d)
(ssdel e ss)
)
(princ)
)
Chào bác gia bach
Mình đang muốn tìm hiểu về lisp nên mong bác phân tích 1 chút về cái lisp này.
Ví dụ như lệnh ssget, ssname, entget, entmod, ssdel có ý nghĩa như thế nào?
Giả sử mình viết thêm đoạn code về lineweight, Style, ... thì theo bên dưới mong bác hướng dẫn dùm.
(defun C:ChangeText( / ss e d )
(setq ss (ssget '((0 . "TEXT")))
)
(while (setq e (ssname ss 0))
(setq d (entget e)
d (subst (cons 40 0.2) (assoc 40 d) d) ; Height=0.2
d (subst (cons 41 3) (assoc 41 d) d) ; Width factor=3
d (subst (cons 1) (assoc d) d) ; Linetype Scale=1
d (subst (cons 0.2) (assoc d) d) ; Lineweight=0.2
d (subst (cons ORIGINAL) (assoc d) d) ; Style=ORIGINAL
)
(entmod d)
(ssdel e ss)
)
(princ)
)
Mình thấy Autolisp rất hay, hu74u ích trong công việc vẽ Cad nên mong mọi người chỉ giáo thêm về Autolisp.
Xin cảm ơn rất nhiều.
<<
|
Filename: 43453_changetext.lsp
|
|
Tác giả: united
Bài viết gốc: 431183
Tên lệnh: o3 |
Sửa lisp Offset và đổi layer đối tượng
Trước tiên xin cảm ơn các anh vì đã quan tâm!
Em đang tập tành viết 1 lisp với nội dung Offset đối tượng theo 1 khoảng cách đặt trước (trong lisp), đồng thời đối tượng vừa tạo được chuyển sang layer đặt trước.
Nhưng loay hoay mãi không bỏ được bước nhập khoảng cách Offset đi. Nhờ các anh sửa (hoặc viết lại) giúp em để làm sao không phải nhập khoảng cách...
>>
Trước tiên xin cảm ơn các anh vì đã quan tâm!
Em đang tập tành viết 1 lisp với nội dung Offset đối tượng theo 1 khoảng cách đặt trước (trong lisp), đồng thời đối tượng vừa tạo được chuyển sang layer đặt trước.
Nhưng loay hoay mãi không bỏ được bước nhập khoảng cách Offset đi. Nhờ các anh sửa (hoặc viết lại) giúp em để làm sao không phải nhập khoảng cách mỗi lần thực hiền lệnh ạ.
Em cảm ơn nhiều!
(defun C:O3 ()
(setq CMD(getvar "CMDECHO"))
(setq LAYER (getvar "CLAYER"))
(setvar "CMDECHO" 0)
(setvar "OFFSETDIST" 5)
(command "LAYER" "M" "--CHAN" "C" "4" "" "L" "DASHEDX2" "" "")
(command "OFFSET" pause pause pause "")
(command "CHANGE" (entlast) "" "P" "LA" "--CHAN" "")
(setvar "CLAYER" LAYER)
(setvar "CMDECHO" CMD)
)
<<
|
Tác giả: Doan Van Ha
Bài viết gốc: 432188
Tên lệnh: ha |
Nhờ viết lisp chọn nhanh text cùng nội dung
Đây:
(defun C:HA( / txt ss)
(setq txt (getstring "\nNhap chu cai dau tien: "))
(princ "\nChon cac doi tuong Text...")
(setq ss (ssget (list '(0 . "*TEXT") (cons 1 (strcat txt "*")))))
(sssetfirst nil ss))
|
Tác giả: a12k39duchao
Bài viết gốc: 415586
Tên lệnh: tt |
Chỉnh Sửa Lisp Để Lisp Lấy Thêm Được Giá Trị Chiều Dài Của *line
Của em đây:
(defun C:tt(/ lst fn fw i j d)
(princ "\nChon cac Text/Mtext/Dimension can xuat ra...
>>
Của em đây:
(defun C:tt(/ lst fn fw i j d)
(princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")
(setq lst (mapcar 'entget (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION,*LINE")))))
fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w") i 0 j 0 d 0)
(foreach n lst
(princ
(cond
((wcmatch (cdadr n) "*TEXT")(strcat (acet-dxf 1 n) ";Text" (itoa (setq i (1+ i))) "\n"))
((= (cdadr n) "DIMENSION")(strcat (if (= (acet-dxf 1 n) "")(rtos (acet-dxf 42 n))(acet-dxf 1 n)) ";Dim" (itoa (setq j (1+ j))) "\n"))
((wcmatch (cdadr n) "*LINE") (strcat (rtos (vlax-curve-getdistatparam (cdar n) (vlax-curve-getendparam (cdar n))) ) ";*Line" (itoa (setq d (1+ d))) "\n"))
)
fw
)
)
(close fw)
(command "._ai_editcustfile" fn))
Cảm ơn A Tuệ đã phản hồi.
Em vừa kiểm tra nhưng lisp không chạy? Em cũng chưa hiểu tại sao.
Và em hơi tham vọng tí. Em muốn lấy thêm của giá trị của Attribute nữa ạ, Anh xem giùm Em.
<<
|
Tác giả: jangboko
Bài viết gốc: 432198
Tên lệnh: sf |
annotative cho dim nhiều tỷ lệ
(defun c:SF (/ ss n scLst OSC:GetScales)
(print "Select the objects you wish to modify: ")
(if (or (setq ss (ssget "I")) (setq ss (ssget)))
(progn
;; Define helper function to get scales attached to an entity
(defun OSC:GetScales (en / ed xn xd cdn cdd asn asd cn cd sn sd cannoscale)
(setq ed (entget en))
(if (and
;; Get the XDictionary attached to the object
...
>>
(defun c:SF (/ ss n scLst OSC:GetScales)
(print "Select the objects you wish to modify: ")
(if (or (setq ss (ssget "I")) (setq ss (ssget)))
(progn
;; Define helper function to get scales attached to an entity
(defun OSC:GetScales (en / ed xn xd cdn cdd asn asd cn cd sn sd cannoscale)
(setq ed (entget en))
(if (and
;; Get the XDictionary attached to the object
(setq xn (vl-position '(102 . "{ACAD_XDICTIONARY") ed))
(setq xn (cdr (nth (1+ xn) ed)))
(setq xd (entget xn))
;; Get the Context Data Management dictionary attached to the XDictionary
(setq cdn (vl-position '(3 . "AcDbContextDataManager") xd))
(setq cdn (cdr (nth (1+ cdn) xd)))
(setq cdd (entget cdn))
;; Get the Annotation Scales dictionary attached to the CD
(setq asn (vl-position '(3 . "ACDB_ANNOTATIONSCALES") cdd))
(setq asn (cdr (nth (1+ asn) cdd)))
(setq asd (entget asn))
;; Get the 1st scale attached
(setq cn (assoc 3 asd))
(setq cn (member cn asd))
)
;; Step through all scales attached
(while cn
(if (and (= (caar cn) 350) ;It it's pointing to a scale record
;; Get the record's data
(setq cd (entget (cdar cn)))
;; Get the Context data class
(setq sn (assoc 340 cd))
(setq sd (entget (cdr sn)))
(setq sn (assoc 300 sd))
;; Check if the scale is already in the list
(not (vl-position (cdr sn) scLst))
)
;; Add it to the list
(setq scLst (cons (cdr sn) scLst))
)
(setq cn (cdr cn))
)
)
)
;; Find a list of scales used in selection
(setq n (sslength ss))
(while (>= (setq n (1- n)) 0)
(OSC:GetScales (ssname ss n))
)
;; Add the current scale to the selection
(setq cannoscale (getvar "CANNOSCALE"))
(command "._ObjectScale" ss "" "_Add" cannoscale "")
;; Remove all other scales attached
(command "._ObjectScale" ss "" "_Delete")
(foreach n scLst
(if (wcmatch (strcase n) (strcat "~" (strcase cannoscale)))
(command n)
)
)
(command "")
)
)
(princ)
)
;;===================================================================
dùng lisp trên là sử lý được vấn đề của bạn. lệnh fs
<<
|
Tác giả: Doan Nguyen Van
Bài viết gốc: 432235
Tên lệnh: xx |
CẢI TIẾN LISP GÁN CONTENT CHO TEXT
13 giờ trước, ngothanhduy đã nói:
Chào bác chủ lips... em đã...
>>
13 giờ trước, ngothanhduy đã nói:
Chào bác chủ lips... em đã test lips của bác, và em có đóng góp như thế này:
- Bác có thể thêm lựa chọn có hoặc không có dấu thập phân (có nghĩa là 3500 thì có thể lựa chọn là 3.500 hoặc 3,500 tuỳ định dạng).
- Bác có thể thêm chữ L= trước giá trị text xuất ra.
em cũng có 1 topic đang hỏi vấn đề trên ở trên diễn đàn mà chưa có kết quả như em mong muốn, nếu được bác có thể hoàn chỉnh thêm lips của bác được không ạ?
Thanks bác!
P/S: bên dưới là link em đăng topic để hỏi vấn đề tương tự ạ?
(defun c:xx (/ e len txt etxt)
(vl-load-com)
(while (setq e (car (entsel "\n Chon pline can ghi chieu dai ")))
(setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
(setq txt (car (entsel "\n Chon text can ghi bo xung gia tri chieu dai polyline"))
etxt (entget txt)
dot (getint "\n Chen dau phay o vi tri thu: ")
txtt (rtos len 2 0))
(if (>= dot (strlen txtt)) (alert "\Number of dot is does not exist")(progn
(setq txt1 (substr txtt 1 (- (strlen txtt) dot))
txt2 (substr txtt (+ dot 1))
etxt (subst (cons 1 (strcat " L= " txt1 "." txt2 )) (assoc 1 etxt) etxt) )
(entmod etxt))
)))
Bạn thử xem đúng ý bạn chưa ?
<<
|
Tác giả: minhtu2004
Bài viết gốc: 184219
Tên lệnh: dpl |
Lisp vẽ đường thẳng nhập chiều cao va khoảng cách liên tục
+nhâp
(defun c:dpl ()
(while
(and
(setq P1 (getpoint "cho diem dau: "))
(setq L (getreal "nhap chieu dai: "))
)
(setq D 80.000)
(setq D1 (*...
>>
+nhâp
(defun c:dpl ()
(while
(and
(setq P1 (getpoint "cho diem dau: "))
(setq L (getreal "nhap chieu dai: "))
)
(setq D 80.000)
(setq D1 (* (- L D) 1000))
(setq P2 (polar P1 (/ Pi 2) D1))
(command "line" P1 P2 "")
) (princ) )
Bạn thêm while và and vào cho sự kiện chọn điểm + nhập chiều dài
-Mình cảm ơn bạn đã giúp, nhưng còn phần nhập khoảng cách thì như thế nào vậy.Nhu cầu của mình là chỉ việc nhập giá trị chiều cao và khoảng cách từng doạn thẳng.
-VD:Đầu tiên chọn điểm bắt đầu, nhập chiều cao được đường thẳng 1 và sao đó nhập khoảng cách 443.1 và chiều cao là đường thẳng thứ 2 cứ như vậy đến khi không nhập nữa.Như trong file cad mình đính kèm. Cám ơn bạn.
<<
|
Tác giả: hhhhgggg
Bài viết gốc: 47135
Tên lệnh: chuyen |
Lisp đổi kiểu nét của Layer sang Hidden2 và Line type scale =0.25
Tổng hợp 2 LISP của Tue_NV và tuan_thietkedien
(defun c:chuyen (/ dt )
(if (tblsearch "layer" "CADVIET")
(progn
(setq curLay (getvar "clayer"))
(Command...
>>
Tổng hợp 2 LISP của Tue_NV và tuan_thietkedien
(defun c:chuyen (/ dt )
(if (tblsearch "layer" "CADVIET")
(progn
(setq curLay (getvar "clayer"))
(Command "layer" "m" "CADVIET" "L" "Hidden2" "" "")
;(prompt "\nChon doi tuong: ")
(if (setq dt (ssget "X" (list (cons 8 "CADVIET"))))
(command "chprop" dt "" "s" "0.25" "")
(alert "Khong co doi tuong tren layer CADVIET !")
)
(setvar "clayer" curLay)
)
(alert "Chua co Layer : CADVIET !")
)
(princ)
)
Ok ! Cảm ơn bác Gia_Bach đã giải bài toán giúp em !
<<
|
Filename: 47135_chuyen.lsp
|
|
Tác giả: BKXD98
Bài viết gốc: 31941
Tên lệnh: dlf |
Cách xác định kích thước thật của dimension ?
Bạn thử với đoạn này, chắc là không "chuối" nữa!
(defun C:DLF( / d d1 k);;;get DIMLFAC of dimension entity
(setq d (entget (car (entsel "\nSelect dimension:"))...
>>
Bạn thử với đoạn này, chắc là không "chuối" nữa!
(defun C:DLF( / d d1 k);;;get DIMLFAC of dimension entity
(setq d (entget (car (entsel "\nSelect dimension:")) '("ACAD")))
(if (setq d1 (cdr (car (cdr (assoc -3 d)))))
(setq k (cdr (assoc 1040 d1)))
(setq k (cdr (assoc 144 (tblsearch "dimstyle" (cdr (assoc 3 d))))))
)
(alert (strcat "DimLFAC = " (rtos k)))
)
Thanks.
<<
|
Tác giả: BKXD98
Bài viết gốc: 31723
Tên lệnh: vd |
Cách xác định kích thước thật của dimension ?
Cái "củ chuối" ấy đây! Có thể thay DXF 43 bằng bất cứ cái gì bạn muốn...
(defun DimVal(d / val)
(command "explode" d)
(setq Val (cdr (assoc 43 (entget...
>>
Cái "củ chuối" ấy đây! Có thể thay DXF 43 bằng bất cứ cái gì bạn muốn...
(defun DimVal(d / val)
(command "explode" d)
(setq Val (cdr (assoc 43 (entget (entlast)))))
(command "undo" 1)
Val
)
;;;---------------------------
(defun C:VD()
(alert (strcat "Text height = " (rtos (DimVal (car (entsel "\nSelect dimension:"))))))
)
đúng là củ chuối thật :lol:
Thanks, anyway.
<<
|