Info | File |
Tác giả: 790312
Bài viết gốc: 68912
Tên lệnh: scdo |
Hỏi về chỉnh kích thước hình tròn vẽ bằng lệnh donut
Tue_NV đã chỉnh lại. Bạn thử Code này xem :
(defun c:scdo()
(vl-load-com)
(setq ss (ssget '((0 . "*POLYLINE"))) i 0)
(setq tle (getdist "\n Nhap he so ti le :...
>>
Tue_NV đã chỉnh lại. Bạn thử Code này xem :
(defun c:scdo()
(vl-load-com)
(setq ss (ssget '((0 . "*POLYLINE"))) i 0)
(setq tle (getdist "\n Nhap he so ti le : "))
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq diem1 (cdr (assoc 10 (entget (entnext ent)))))
(setq diem2 (cdr (assoc 10 (entget(entnext (entnext ent))))))
(setq po (list (/ (+ (car diem1) (car diem2)) 2) (/ (+ (cadr diem1) (cadr diem2)) 2) 0))
(command "scale" ent "" po tle)
(setq i (1+ i))
)
(princ)
)
Đoạn viết này nó còn sai tọa độ nằm trên trục Y còn nhiều hơn code trước,mình gửi file đính kèm nhờ bạn xem giúp.Thanks
http://www.cadviet.com/upfiles/2/new_block.dwg
<<
|
Tác giả: Cuongkieu
Bài viết gốc: 198240
Tên lệnh: tkh |
Lisp thống kê diện tích Hatch theo Layer
Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại...
>>
Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại chỗ tùy ý để bạn tiện ghi chú
(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
(progn
(vl-load-com)
(acet-sysvar-set (list "cmdecho" 0))
(grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
(Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch : ")
(if (setq ss (ssget(list (cons 0 "HATCH"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
(setq lay (vlax-get-property e 'Layer))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
(setq ar (* 0.000001 (vlax-get-property e 'Area)))
(progn
(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
(redraw (vlax-vla-object->ename e) 3)
)
)
(if (not (assoc lay lst))
(setq lst (cons (cons lay ar) lst))
(setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
(assoc lay lst) lst))))
(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)
(while (setq e (nth (setq i (1+ i)) lst))
(vla-addtext msp (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") (vlax-3d-point '(0 0 0)) txtsiz)
(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
(command ".move" (entlast) "" '(0 0 0) pt)
)
(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
(alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
(acet-sysvar-restore)(princ))
(defun st-ss->ent (ss / n e l)
(setq n -1)
(while (setq e (ssname ss (setq n (1+ n))))
(setq l (cons e l))
)
)
Bác giúp em làm một cái khi điền text thì không có tên layer ở đằng trước nhé. thanks bác
<<
|
Tác giả: vtd_xd
Bài viết gốc: 91633
Tên lệnh: tkck |
Viết lisp theo yêu cầu [phần 2]
Chào bạn vtd_xd, Đây là cái lisp để bạn dùng thử. Mình viết lại dựa theo cái lisp của bác Tue_NV viết để thống kê vòng tròn. Nếu có gì chưa phù hợp bạn...
>>
Chào bạn vtd_xd, Đây là cái lisp để bạn dùng thử. Mình viết lại dựa theo cái lisp của bác Tue_NV viết để thống kê vòng tròn. Nếu có gì chưa phù hợp bạn hãy post lên.
(defun c:tkck (/ ltxt ltst)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "TEXT") (cons 8 "_text") (cons 7 "TKCK")))
ltxt (list)
ltst (list)
i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ltxt (append ltxt (list(cdr (assoc 1 (entget ent)))))))
(foreach x ltxt
(if (setq old (cdr (assoc x ltst)))
(setq ltst (subst (cons x (1+ old) ) (assoc x ltst) ltst))
(setq ltst (append ltst (list (cons x 1))))))
(setq k 1
p (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao text: ")
d (getreal "\n Nhap do rong cot: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 h) (cons 1 "THONG KE CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "TEN CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "SO LUONG")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "GHI CHU")))
(foreach x1 ltst
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos k 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (car x1))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos (cdr x1) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h (1+ k)))))
(cons 40 h) (cons 1 "" )))
(setq k (1+ k)))
(command "undo" "e")
(princ)
)
Trong lisp này mình căn cứ vào bản vẽ bạn post và giả định là các text cần đếm của bạn nằm trên lớp "_text" và có style là "TKCK". Với các bản vẽ mà text cần phân loại không có các thuộc tính như trên thì bạn có thể đổi lại mã trong dòng code này cho phù hợp:
(ssget (list (cons 0 "TEXT") (cons 8 "_text") (cons 7 "TKCK")))
Chúc bạn vui.
Cám ơn bạn nhé, nếu có các đường line kẻ thành bảng thì tốt qua, thanks
<<
|
Tác giả: bienda
Bài viết gốc: 171735
Tên lệnh: ha |
Lisp chỉnh sửa nội dung text
@Ketxu: không thấy Ket giúp nên nghĩ chắc Ket bận, đành liều giúp vậy, có gì thì srr nhé!
Bạn dùng cái này thì Text có các...
>>
@Ketxu: không thấy Ket giúp nên nghĩ chắc Ket bận, đành liều giúp vậy, có gì thì srr nhé!
Bạn dùng cái này thì Text có các kiểu tiền tố và hậu tố hay số nguyên và số thực đều OK
P/S: loay hoay viết, đến khi xong, thì Ket đã xong rồi, srr Ket.
(defun C:HA( / num txtm) ;Doan Van Ha CADViet.com
(setq num (getreal "\nNhap so can them/bot: "))
(princ "\nChon cac Text can thay doi...")
(foreach ent (acet-ss-to-list (ssget '((0 . "*TEXT"))))
(setq txtm (acet-str-replace (cadr (chia3 (cdr (assoc 1 (entget ent)))))
(rtos (+ num (atof (cadr (chia3 (cdr (assoc 1 (entget ent))))))) 2 (get-sle (cadr (chia3 (cdr (assoc 1 (entget ent)))))))
(cdr (assoc 1 (entget ent)))))
(entmod (subst (cons 1 txtm) (cons 1 (cdr (assoc 1 (entget ent)))) (entget ent)))))
(defun get-sle (str)
(if (not (acet-str-find "." str)) 0 (- (strlen str) (acet-str-find "." str))))
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
(cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
(T (setq lstt nil))))
(while lstn
(cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
Rất cảm ơn sự giúp đỡ của bạn
Thanks 2 người sao lại không được nhỉ
Diễn đàn bảo lỗi
<<
|
Tác giả: hiepttr
Bài viết gốc: 427723
Tên lệnh: vtt |
Lisp vẽ tiếp tuyến nhiều cung tròn trong đường PLine
Đang rảnh nên xào xáo được cho bạn cái này.
Đề bài sơ sai nên nếu sản phẩm không như ý thì cũng đừng kêu quá to nhé :D :D :D
;lisp ve tiep tuyen cho cung trong LWPolyline
(defun c:VTT( / ANG ANG1 BULGE DIST DXF10_LST DXF42_LST ENT I INFO LEN LST_VA OLD PT1 PT2 PT_D R TT)
(setq lst_va '("osmode" "cmdecho" "AUNITS"))
(setq...
>>
Đang rảnh nên xào xáo được cho bạn cái này.
Đề bài sơ sai nên nếu sản phẩm không như ý thì cũng đừng kêu quá to nhé :D :D :D
;lisp ve tiep tuyen cho cung trong LWPolyline
(defun c:VTT( / ANG ANG1 BULGE DIST DXF10_LST DXF42_LST ENT I INFO LEN LST_VA OLD PT1 PT2 PT_D R TT)
(setq lst_va '("osmode" "cmdecho" "AUNITS"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3))
(prompt "\nChon tuyen PL!")
(setq ent (ssget "+.:E:S" '((0 . "LWPOLYLINE"))))
(if ent
(progn
(setq info (entget(ssname ent 0))
dxf10_lst (vl-remove-if-not '(lambda(x) (= (car x) 10)) info)
dxf42_lst (vl-remove-if-not '(lambda(x) (= (car x) 42)) info)
i 0
len (length dxf42_lst)
)
(while (< i (1- len))
(cond
((not (equal (setq bulge (cdr (nth i dxf42_lst))) 0))
(setq pt1 (cdr (nth i dxf10_lst))
pt2 (if (< i (1- len)) (cdr (nth (1+ i) dxf10_lst)) (cdr (nth 0 dxf10_lst)))
dist (distance pt1 pt2)
ang (* 4 (atan bulge))
R (/ (/ dist 2.) (cos (setq ang1 (- (* 0.5 pi) (* ang 0.5)))))
TT (* R (/ (sin (* ang 0.5)) (cos (* ang 0.5))))
pt_D (polar pt1 (- (angle pt1 pt2) (- (* pi 0.5) ang1)) TT)
)
(MakeLine pt1 pt_D nil nil nil 2 nil)
(MakeLine pt2 pt_D nil nil nil 2 nil)
)
) ;cond
(setq i (1+ i))
) ;while
)
(princ "\n*** Khong chon duoc PL nao! ***")
)
;;xong tra ve:
(mapcar 'setvar lst_va old)
(princ)
)
;=================================
(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
<<
|
Tác giả: friday13th
Bài viết gốc: 7769
Tên lệnh: nn |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Xong phần khởi động. Giờ là bắt đấu vẽ với LINE, với ARC... - Ồ! những đường Line này sao không phải là PLINE nhỉ? Vừa dễ quản lý vừa nhẹ bản vẽ. Phải làm sao...
>>
Xong phần khởi động. Giờ là bắt đấu vẽ với LINE, với ARC... - Ồ! những đường Line này sao không phải là PLINE nhỉ? Vừa dễ quản lý vừa nhẹ bản vẽ. Phải làm sao đây? BO lại à ? OH không !!!
Bài 4. Nối LINE và ARC thành PLINE
(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
(defun MoPL (ssdt /)
(= (cdr (assoc '70 (entget ssdt))) 0)
)
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(command ".PEDIT" ssdt "J" "All" "" "X")
)
)
(defun NoiLC (ssdt /)
(command ".PEDIT" ssdt "Y" "J" "All" "" "X")
)
(setq
tdt (ssget)
sodt (sslength tdt)
index 0
)
(repeat sodt
(setq
ssdt (ssname tdt index)
index (1+ index)
)
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE")
)
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
)
(princ)
)
Lệnh để nối LINE và ARC thành PLINE là nn
sao em ko nối được????
<<
|
Tác giả: vinhngoc
Bài viết gốc: 8381
Tên lệnh: taol |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời... >> Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời gian. Vậy làm thế nào???
( Tất cả các LISP CODE bạn chỉ việc copy rồi save ra file cùng tên với lệnh lisp và có phần mở rộng la .LSP (ví dụ: TaoL.LSP) là ok :bigsmile: )
Bài 1: Tạo Layer
(defun c:TaoL()
(command "layer" "m" "!tuong" "c" "2" "" "")
(command "layer" "m" "!tim" "c" "1" "" "")
(command "layer" "m" "!thay" "c" "7" "" "")
(command "layer" "m" "!noithat" "c" "8" "" "")
(command "layer" "m" "!hatch" "c" "8" "" "")
(command "layer" "m" "!chu" "c" "3" "" "")
(command "layer" "m" "!kichthuoc" "c" "8" "" "")
(princ)
)
Với lisp này lệnh để tạo layer sẽ là TaoL.
Bài 2: Tạo Text Style ( kiểu chữ )
(defun c:TaoC()
(command "style" "!vnAvanH" ".VnAvantH" "" "" "" "" "")
(princ)
)
Với lisp này lệnh để tạo kiểu chữ sẽ là TaoC.
Bài 3: Tạo Dim Style ( kiểu kích thước )
(defun c:TaoK (/ scl fcal scal );dmasz dexo dexo dtxt dgap dclre dclrt dsn ao ad obj)
(vl-load-com)
(setq scl (getstring "\nTY LE BAN VE: "))
(setq fcal (atof (substr scl 1 1)))
(setq scal (atof (substr scl 3 3)))
(setq tyle (/ fcal scal))
(setq caochu (getint "\nCHIEU CAO CUA CHU: "))
(setvar "DIMALTF" 25)
(setvar "DIMALTTZ" 13)
(setvar "DIMALTZ" 13)
(setvar "DIMBLK" "ArchTick")
(setvar "DIMBLK1" "ArchTick")
(setvar "DIMBLK2" "ArchTick")
(setvar "DIMASZ" (/ caochu 2))
(setvar "DIMCEN" -50)
(setvar "DIMCLRD" 9)
(setvar "DIMDLE" (/ caochu 2))
(setvar "DIMTOFL" 1)
(setvar "DIMDLI" 0)
(setvar "DIMCLRE" 9)
(setvar "DIMEXE" (/ caochu 2))
(setvar "DIMEXO" 0)
(setvar "DIMTMOVE" 2)
(setvar "DIMLDRBLK" "ArchTick")
(setvar "DIMDEC" 0)
(setvar "DIMCLRT" 9)
(setvar "DIMTXT" caochu)
(setvar "DIMLFAC" TYLE)
(setvar "DIMTIX" 1)
(setvar "DIMTIH" 0)
(setvar "DIMGAP" (/ caochu 2))
(setvar "DIMTOH" 0)
(setvar "DIMTAD" 1)
(setvar "DIMTXSTY" "!vnAvanH")
(setvar "DIMTDEC" 0)
(setvar "DIMTZIN" 13)
(setvar "DIMZIN" 13)
;-------------------------------------------------------------
(setq dsn (getstring "\nTEN CUA KIEU DIM MOI: "))
(setq ao (vlax-get-acad-object))
(setq ad (vla-get-ActiveDocument ao))
(setq obj (vla-add (vla-get-dimstyles ad) dsn))
(vla-copyfrom Obj ad)
(vla-put-activedimstyle ad Obj)
(princ)
)
Với lisp này lệnh để tạo kiểu kích thước sẽ là TaoK.
Các thông số cần nhập
1. Tỷ lệ bản vẽ: (Thường là 1/1, cũng có thể là 1/2 tùy vào kiểu dim bạn muốn tạo)
2. Chiều cao chữ: (Tùy thuộc vào bản vẽ của bạn)
3. Tên kiểu dim mới: (Nên đặt theo chiều cao của chữ)
<<
|
Tác giả: vinhngoc
Bài viết gốc: 8381
Tên lệnh: taoc |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời... >> Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời gian. Vậy làm thế nào???
( Tất cả các LISP CODE bạn chỉ việc copy rồi save ra file cùng tên với lệnh lisp và có phần mở rộng la .LSP (ví dụ: TaoL.LSP) là ok :bigsmile: )
Bài 1: Tạo Layer
(defun c:TaoL()
(command "layer" "m" "!tuong" "c" "2" "" "")
(command "layer" "m" "!tim" "c" "1" "" "")
(command "layer" "m" "!thay" "c" "7" "" "")
(command "layer" "m" "!noithat" "c" "8" "" "")
(command "layer" "m" "!hatch" "c" "8" "" "")
(command "layer" "m" "!chu" "c" "3" "" "")
(command "layer" "m" "!kichthuoc" "c" "8" "" "")
(princ)
)
Với lisp này lệnh để tạo layer sẽ là TaoL.
Bài 2: Tạo Text Style ( kiểu chữ )
(defun c:TaoC()
(command "style" "!vnAvanH" ".VnAvantH" "" "" "" "" "")
(princ)
)
Với lisp này lệnh để tạo kiểu chữ sẽ là TaoC.
Bài 3: Tạo Dim Style ( kiểu kích thước )
(defun c:TaoK (/ scl fcal scal );dmasz dexo dexo dtxt dgap dclre dclrt dsn ao ad obj)
(vl-load-com)
(setq scl (getstring "\nTY LE BAN VE: "))
(setq fcal (atof (substr scl 1 1)))
(setq scal (atof (substr scl 3 3)))
(setq tyle (/ fcal scal))
(setq caochu (getint "\nCHIEU CAO CUA CHU: "))
(setvar "DIMALTF" 25)
(setvar "DIMALTTZ" 13)
(setvar "DIMALTZ" 13)
(setvar "DIMBLK" "ArchTick")
(setvar "DIMBLK1" "ArchTick")
(setvar "DIMBLK2" "ArchTick")
(setvar "DIMASZ" (/ caochu 2))
(setvar "DIMCEN" -50)
(setvar "DIMCLRD" 9)
(setvar "DIMDLE" (/ caochu 2))
(setvar "DIMTOFL" 1)
(setvar "DIMDLI" 0)
(setvar "DIMCLRE" 9)
(setvar "DIMEXE" (/ caochu 2))
(setvar "DIMEXO" 0)
(setvar "DIMTMOVE" 2)
(setvar "DIMLDRBLK" "ArchTick")
(setvar "DIMDEC" 0)
(setvar "DIMCLRT" 9)
(setvar "DIMTXT" caochu)
(setvar "DIMLFAC" TYLE)
(setvar "DIMTIX" 1)
(setvar "DIMTIH" 0)
(setvar "DIMGAP" (/ caochu 2))
(setvar "DIMTOH" 0)
(setvar "DIMTAD" 1)
(setvar "DIMTXSTY" "!vnAvanH")
(setvar "DIMTDEC" 0)
(setvar "DIMTZIN" 13)
(setvar "DIMZIN" 13)
;-------------------------------------------------------------
(setq dsn (getstring "\nTEN CUA KIEU DIM MOI: "))
(setq ao (vlax-get-acad-object))
(setq ad (vla-get-ActiveDocument ao))
(setq obj (vla-add (vla-get-dimstyles ad) dsn))
(vla-copyfrom Obj ad)
(vla-put-activedimstyle ad Obj)
(princ)
)
Với lisp này lệnh để tạo kiểu kích thước sẽ là TaoK.
Các thông số cần nhập
1. Tỷ lệ bản vẽ: (Thường là 1/1, cũng có thể là 1/2 tùy vào kiểu dim bạn muốn tạo)
2. Chiều cao chữ: (Tùy thuộc vào bản vẽ của bạn)
3. Tên kiểu dim mới: (Nên đặt theo chiều cao của chữ)
<<
|
Tác giả: vinhngoc
Bài viết gốc: 8381
Tên lệnh: taok |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời... >> Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời gian. Vậy làm thế nào???
( Tất cả các LISP CODE bạn chỉ việc copy rồi save ra file cùng tên với lệnh lisp và có phần mở rộng la .LSP (ví dụ: TaoL.LSP) là ok :bigsmile: )
Bài 1: Tạo Layer
(defun c:TaoL()
(command "layer" "m" "!tuong" "c" "2" "" "")
(command "layer" "m" "!tim" "c" "1" "" "")
(command "layer" "m" "!thay" "c" "7" "" "")
(command "layer" "m" "!noithat" "c" "8" "" "")
(command "layer" "m" "!hatch" "c" "8" "" "")
(command "layer" "m" "!chu" "c" "3" "" "")
(command "layer" "m" "!kichthuoc" "c" "8" "" "")
(princ)
)
Với lisp này lệnh để tạo layer sẽ là TaoL.
Bài 2: Tạo Text Style ( kiểu chữ )
(defun c:TaoC()
(command "style" "!vnAvanH" ".VnAvantH" "" "" "" "" "")
(princ)
)
Với lisp này lệnh để tạo kiểu chữ sẽ là TaoC.
Bài 3: Tạo Dim Style ( kiểu kích thước )
(defun c:TaoK (/ scl fcal scal );dmasz dexo dexo dtxt dgap dclre dclrt dsn ao ad obj)
(vl-load-com)
(setq scl (getstring "\nTY LE BAN VE: "))
(setq fcal (atof (substr scl 1 1)))
(setq scal (atof (substr scl 3 3)))
(setq tyle (/ fcal scal))
(setq caochu (getint "\nCHIEU CAO CUA CHU: "))
(setvar "DIMALTF" 25)
(setvar "DIMALTTZ" 13)
(setvar "DIMALTZ" 13)
(setvar "DIMBLK" "ArchTick")
(setvar "DIMBLK1" "ArchTick")
(setvar "DIMBLK2" "ArchTick")
(setvar "DIMASZ" (/ caochu 2))
(setvar "DIMCEN" -50)
(setvar "DIMCLRD" 9)
(setvar "DIMDLE" (/ caochu 2))
(setvar "DIMTOFL" 1)
(setvar "DIMDLI" 0)
(setvar "DIMCLRE" 9)
(setvar "DIMEXE" (/ caochu 2))
(setvar "DIMEXO" 0)
(setvar "DIMTMOVE" 2)
(setvar "DIMLDRBLK" "ArchTick")
(setvar "DIMDEC" 0)
(setvar "DIMCLRT" 9)
(setvar "DIMTXT" caochu)
(setvar "DIMLFAC" TYLE)
(setvar "DIMTIX" 1)
(setvar "DIMTIH" 0)
(setvar "DIMGAP" (/ caochu 2))
(setvar "DIMTOH" 0)
(setvar "DIMTAD" 1)
(setvar "DIMTXSTY" "!vnAvanH")
(setvar "DIMTDEC" 0)
(setvar "DIMTZIN" 13)
(setvar "DIMZIN" 13)
;-------------------------------------------------------------
(setq dsn (getstring "\nTEN CUA KIEU DIM MOI: "))
(setq ao (vlax-get-acad-object))
(setq ad (vla-get-ActiveDocument ao))
(setq obj (vla-add (vla-get-dimstyles ad) dsn))
(vla-copyfrom Obj ad)
(vla-put-activedimstyle ad Obj)
(princ)
)
Với lisp này lệnh để tạo kiểu kích thước sẽ là TaoK.
Các thông số cần nhập
1. Tỷ lệ bản vẽ: (Thường là 1/1, cũng có thể là 1/2 tùy vào kiểu dim bạn muốn tạo)
2. Chiều cao chữ: (Tùy thuộc vào bản vẽ của bạn)
3. Tên kiểu dim mới: (Nên đặt theo chiều cao của chữ)
<<
|
Tác giả: Ar_Chanwoo
Bài viết gốc: 13919
Tên lệnh: oo |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Ờ nhỉ tí quến. Thế khi vẽ tim và tường thì làm thế nào cho nhanh. Co người thì dùng MLine, co người thì dùng Line. MLine thì không bàn, nhanh, nhưng không phải ai cũng quen. Vậy... >>
Ờ nhỉ tí quến. Thế khi vẽ tim và tường thì làm thế nào cho nhanh. Co người thì dùng MLine, co người thì dùng Line. MLine thì không bàn, nhanh, nhưng không phải ai cũng quen. Vậy làm thế nào khi đã ve xong tim tường rồi? OFFSET ?
Bài 7: Offset line sang 2 bên
(defun c:oo(/ data_m)
(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)
(defun process(/ ent check)
(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)
(defun p_d_offset(/ p1 p2 p3 p4)
(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))
(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))
))
(princ)
)
(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)
Lênh để offset line sang 2 bên là oo.
....
Còn lắm nhưng mà ăn cơm đã..hè hè
Thông thường khi vẽ kiến trúc người ta sẽ vẽ tim đầu tiên, sau đó offset sang 2 bên hoặc dùng lệnh mline để vẽ, lisp trên của a theo e còn có hạn chế là sau khi offset sang 2 bên thì đối tượng mới trùng layer với đối tượng cũ, như vậy sẽ rất khó khăn khi tách (theo kiểu on/off layer) đối tượng ra để chỉnh sửa trong những bản vẽ phưc tạp.
<<
|
Tác giả: pphung183
Bài viết gốc: 388052
Tên lệnh: tdt tcd |
Đo tổng chiều dài đối tượng trên Autocad 2015
Chào cả nhà,
Hôm nay search topic này đúng ngay chỗ bữa giờ e lăn tăn. Chẳng là e đang dùng cái lisp TDT TCD,...
>>
Chào cả nhà,
Hôm nay search topic này đúng ngay chỗ bữa giờ e lăn tăn. Chẳng là e đang dùng cái lisp TDT TCD, hjx, kể từ khi xài qua thằng Cad 16 thì TDT vẫn ok, trong khi thằng TCD lại "đơ". Bác nào fix giúp em lỗi này với nhé, thanks :)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/59317-nho-chi-nh-su-a-lisp-ti-nh-to-ng-die-n-ti-ch-va-chu-vi-ca-c-hi-nh/
(defun c:tdt(/ dt sdt gt tgt id pt1)
(setq dt (ssget
'((-4 . "<OR")
(0 . "CIRCLE")
(0 . "*POLYLINE")
(-4 . "OR>")
))
)
(setq
sdt (sslength dt)
id 0
tgt 0)
(testcaochu)
(repeat sdt
(setq ent (ssname dt id)
id (1+ id)
)
(command "area" "o" ent "")
(setq gt (getvar "area"))
(setq tgt (+ tgt gt))
(princ)
)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
(command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
(setq dt (ssget '((-4 . "<OR")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "ARC")
(0 . "LINE")
(0 . "*POLYLINE")
(-4 . "OR>")
))
)
(testcaochu)
(setq sdt (sslength dt))
(setq
index 0
tcd 0
)
(repeat sdt
(setq
ent (ssname dt index)
index (1+ index)
)
(command "lengthen" ent "")
(setq cd (getvar "perimeter"))
(setq tcd (+ tcd cd))
)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
(command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
(princ)
)
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
(if (not caochu1)
(setq caochu (getdist "\nchieu cao chu? :"))
(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
)
(if (= caochu nil) (setq caochu caochu1))
(setq caochu1 caochu)
)
Xem qua code TDT và TCD là giống nhau nhưng ở Cad2015 thì TCD bị đơ cũng lạ nhỉ? :wub:
Bạn thử thay (command "lengthen" ent "") bằng (command "area" "o" ent) xem sao :)
<<
|
Filename: 388052_tdt_tcd.lsp
|
|
Tác giả: Tue_NV
Bài viết gốc: 235935
Tên lệnh: hcn |
Code lisp như thế nào để hạn chế lỗi cho người dùng?
Thank bác Duy782006. Qua 3 góp ý ở trên, sơ bộ sửa như vầy. Và hình như nó vẫn còn cần bẫy lỗi? Mời tiếp...
>>
Thank bác Duy782006. Qua 3 góp ý ở trên, sơ bộ sửa như vầy. Và hình như nó vẫn còn cần bẫy lỗi? Mời tiếp tục!
(defun C:HCN( / p1 p3) (if (and (setq p1 (getpoint "\nPick diem 1: ")) (setq p3 (getcorner p1 "\nPick diem 2: "))) (command ".rectang" "non" p1 "non" p3)) (princ))
Không cần tới If đâu bác :
(defun C:HCN( / p1 p3)
(and
(setq p1 (getpoint "\nPick diem 1: "))
(setq p3 (getcorner p1 "\nPick diem 2: "))
(command ".rectang" "non" p1 "non" p3))
(princ))
<<
|
Tác giả: gia_bach
Bài viết gốc: 327141
Tên lệnh: knut gn |
Lisp thống kê thông số đường cong
;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196992&st=0entry196992
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196822&st=0entry196822
;Khëi t¹o mét sè th«ng sè cho vÏ nót
;------------------------------------------------------
(defun C:knut ()
(setq hf (getreal "\nChieu cao text: "))
(command "dimstyle" "s" "Dimn" "dimstyle" "s" "Dran")
(command "-Style" "hoatfon" "hoatfon" hf "" "" "" "" "")
(command "-Layer" "n" "Text" "c" "4" "Text" "")
(command "-Layer" "n" "Dim" "c" "8" "DIm" "")
(command "-Layer" "n" "Khuat" "c" "4" "Khuat" "l" "Dashed" "Khuat" "")
(Princ)
)
;;;Chuong trinh chinh (Ve va thong ke cac yeu to cua duong cong)
(setq tlv (getint "\nNhap ty le ban ve nut 1/... :"))
(defun c:GN ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq sttdinh (getint "\nNhap so thu tu dinh :"))
(setq es (entsel "\nChon cung tron can ve:"))
(setq dbang (getpoint "\nChon vi tri dat bang thong ke:"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq tdt (car es)
dra (cadr es)
ent (entget tdt)
cen (cdr (assoc 10 ent))
goc1 (cdr (assoc 50 ent))
goc2 (cdr (assoc 51 ent))
bk (cdr (assoc 40 ent))
)
(setq td1 (polar cen goc1 bk)
td2 (polar cen goc2 bk)
)
(setq mid (list (/ (+ (car td1) (car td2)) 2) (/ (+ (cadr td1) (cadr td2)) 2) (caddr td1)))
(setq goc (angle cen mid))
(setq goctam (abs (- goc2 goc1)))
(if (< goctam pi)
(setq goct goctam)
(setq goct (- (* 2 pi) goctam))
)
(setq dtam (/ bk (cos (/ goct 2))))
(setq dinh (polar cen goc dtam))
(setq T (rtos (/ (* (distance dinh td1) tlv) 1000) 2 2)
P (rtos (/ (* (- dtam bk) tlv) 1000) 2 2)
K (rtos (/ (* (* goct bk) tlv) 1000) 2 2)
Ssbk (rtos (/ (* bk tlv) 1000) 2 2)
)
(command "-layer" "s" "khuat" "" ".line" td1 dinh td2 "")
(command "-layer" "s" "DIM" "" "Dimstyle" "" "Dimn")
(setq kckt (* 2.2 (getvar "dimtxt")) dkt1 (polar td1 goc1 kckt))
(command "DIMALIGNED" dinh td1 dkt1)
(setq dkt2 (polar td2 goc2 kckt))
(command "DIMALIGNED" dinh td2 dkt2)
(command "Dimstyle" "" "Dran" "DIMRADIUS" tdt dra "")
;VÏ khung thèng kª nut
;--------------------------------
(setq xb (+ (car dbang) (* 11 (getvar "textsize"))) yb (- (cadr dbang) (* 10.25 (getvar "textsize"))) dbang2 (list xb yb (caddr dbang)) odbang (polar dbang (/ (* 3 pi) 4) (/ (getvar "textsize") 5)) odbang2 (polar dbang2 (- (* 2 pi) (/ pi 4)) (/ (getvar "textsize") 5)))
(command ".layer" "s" "text" "" ".rectang" odbang odbang2 ".rectang" dbang dbang2) (command "change" "l" "" "p" "c" "1" "")
;Xö lý b¶ng thèng kª
;-----------------------------
(setq gockep (angtos (- pi goct) 1 4))
(setq Kiem1 (substr gockep 2 1) kiem2 (substr gockep 3 1) kiem3 (substr gockep 4 1))
(cond ((= kiem1 "d") (setq dau (substr gockep 1 1) cuoi (substr gockep 3))) ((= kiem2 "d") (setq dau (substr gockep 1 2) cuoi (substr gockep 4))) ((= kiem3 "d") (setq dau (substr gockep 1 3) cuoi (substr gockep 5)))
)
(setq gockep (strcat (strcat dau "%%d") cuoi))
;----------------------------
(setq nhan (rtos sttdinh 2 0))
(setq chugoc (strcat (strcat "A" nhan) (strcat "=" gockep)))
(setq chubk (strcat (strcat (strcat "R" nhan) (strcat "=" ssbk)) "m"))
(setq chutt (strcat (strcat (strcat "T" nhan) (strcat "=" T)) "m"))
(setq chup (strcat (strcat (strcat "P" nhan) (strcat "=" P)) "m"))
(setq chucd (strcat (strcat (strcat "K" nhan) (strcat "=" K)) "m"))
(setq dong1 (polar dbang (- (* 2 pi) (/ (* 9 pi) 24)) (* 1.75 (getvar "textsize")))
dong2 (polar dong1 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong3 (polar dong2 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong4 (polar dong3 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong5 (polar dong4 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
)
(command "-layer" "s" "Text" "" ".text" dong1 "" chugoc ".text" dong2 "" chubk ".text" dong3 "" chutt ".text" dong4 "" chup ".text" dong5 "" chucd)
(setq tendinh (strcat "A" nhan))
(command ".text" dinh "" tendinh)
(command "insert" "nut" dinh "" "" "" )
(setvar "osmode" osm)
(setvar "cmdecho" cmd) (princ)
(setvar "osmode" 15359)
)
Lisp đó đây ah.
Mình không nhớ lisp này là ai viết nữa cả.
Mình vẫn dùng cad 2007 như từ trước đến giờ.
Lỗi là khi xuất kết quả, toàn bộ các thông số R, T, P, K của tất cả các đường cong khác nhau đều là 0.02 với 0.01. Không đúng với giá trị thực tế.
XIn gửi file đính kèm để các bạn kiểm tra hộ nhé.
http://www.mediafire.com/download/argi2wcom81amtx/111.dwg
A1 = 71d31'09''
R1 = 21.97m
T1 = 30.51m
P1 = 15.63m
K1 = 41.61m
Trí nhớ của bạn tệ thật!
Tôi nhớ là bạn đã mời tác giả Lisp này cafe (+ vé máy bay) cơ mà.
Thôi thì liên hệ tác giả + nhớ mua thêm vé máy bay khứ hồi.
Link của nó còn trong file Lisp nè : :
<<
|
Filename: 327141_knut_gn.lsp
|
|
Tác giả: ndtnv
Bài viết gốc: 261570
Tên lệnh: m2l |
mirror qua 2 đường thẳng song song!
Bạn dùng cái này xem:
(defun C:M2L()
(vl-load-com) (if (not cal) (arxload "geomcal"))
(prompt...
>>
Bạn dùng cái này xem:
(defun C:M2L()
(vl-load-com) (if (not cal) (arxload "geomcal"))
(prompt "\nChon cac doi tuong can Mirror: ")
(setq ss (ssget))
(setq l1 (entsel "\nChon duong Line thu 1: "))
(setq l2 (entsel "\nChon duong Line thu 2: "))
(setq p1d (cdr (assoc 10 (entget (car l1)))))
(setq p1c (cdr (assoc 11 (entget (car l1)))))
(setq p2d (cdr (assoc 10 (entget (car l2)))))
(setq p2c (cdr (assoc 11 (entget (car l2)))))
(setq p3d (cal "plt(p1d,p2d,0.5)"))
(setq p3c (cal "plt(p1c,p2c,0.5)"))
(initget "Y N") (setq xoa (getkword "\nXoa doi tuong cu <NO>: "))
(if (or (= xoa "N") (not xoa))
(command ".mirror" ss "" p3d p3c "N")
(command ".mirror" ss "" p3d p3c "Y")))
Bạn chưa xét trường hợp 2 line // nhưng ngược chiều nhau, khi đó p3c và p3d trùng nhau.
Nếu 2 line // thì không cần p2c
(setq p3c (cal "plt(p1c,p2d,0.5)"))
<<
|
Tác giả: bach1212
Bài viết gốc: 196819
Tên lệnh: knut gn |
Lisp xuất thông số của đường ra block thuộc tính
Lâu không đóng góp gì cho cad việt không biết lisp này minh tìm được có hay hơn và giúp hơn cho bạn không.
>>
Lâu không đóng góp gì cho cad việt không biết lisp này minh tìm được có hay hơn và giúp hơn cho bạn không.
;Khëi t¹o mét sè th«ng sè cho vÏ nót
;------------------------------------------------------
(defun C:knut ()
(command "dimstyle" "s" "Dimn" "dimstyle" "s" "Dran")
(command "-Style" "hoatfon" "hoatfon" "" "" "" "" "" "")
(command "-Layer" "n" "Text" "c" "4" "Text" "")
(command "-Layer" "n" "Dim" "c" "1" "DIm" "")
(command "-Layer" "n" "Khuat" "c" "4" "Khuat" "l" "Dashed" "Khuat" "")
(Princ)
)
;;;Chuong trinh chinh (Ve va thong ke cac yeu to cua duong cong)
(setq tlv (getint "\nNhap ty le ban ve nut 1/... :"))
(defun c:GN ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq sttdinh (getint "\nNhap so thu tu dinh :"))
(setq es (entsel "\nChon cung tron can ve:"))
(setq dbang (getpoint "\nChon vi tri dat bang thong ke:"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq tdt (car es)
dra (cadr es)
ent (entget tdt)
cen (cdr (assoc 10 ent))
goc1 (cdr (assoc 50 ent))
goc2 (cdr (assoc 51 ent))
bk (cdr (assoc 40 ent))
)
(setq td1 (polar cen goc1 bk)
td2 (polar cen goc2 bk)
)
(setq mid (list (/ (+ (car td1) (car td2)) 2) (/ (+ (cadr td1) (cadr td2)) 2) (caddr td1)))
(setq goc (angle cen mid))
(setq goctam (abs (- goc2 goc1)))
(if (< goctam pi)
(setq goct goctam)
(setq goct (- (* 2 pi) goctam))
)
(setq dtam (/ bk (cos (/ goct 2))))
(setq dinh (polar cen goc dtam))
(setq T (rtos (/ (* (distance dinh td1) tlv) 1000) 2 2)
P (rtos (/ (* (- dtam bk) tlv) 1000) 2 2)
K (rtos (/ (* (* goct bk) tlv) 1000) 2 2)
Ssbk (rtos (/ (* bk tlv) 1000) 2 2)
)
(command "-layer" "s" "khuat" "" ".line" td1 dinh td2 "")
(command "-layer" "s" "DIM" "" "Dimstyle" "" "Dimn")
(setq kckt (* 2.2 (getvar "dimtxt")) dkt1 (polar td1 goc1 kckt))
(command "DIMALIGNED" dinh td1 dkt1)
(setq dkt2 (polar td2 goc2 kckt))
(command "DIMALIGNED" dinh td2 dkt2)
(command "Dimstyle" "" "Dran" "DIMRADIUS" tdt dra "")
;VÏ khung thèng kª nut
;--------------------------------
(setq xb (+ (car dbang) (* 9 (getvar "textsize"))) yb (- (cadr dbang) (* 10.25 (getvar "textsize"))) dbang2 (list xb yb (caddr dbang)) odbang (polar dbang (/ (* 3 pi) 4) (/ (getvar "textsize") 5)) odbang2 (polar dbang2 (- (* 2 pi) (/ pi 4)) (/ (getvar "textsize") 5)))
(command ".layer" "s" "text" "" ".rectang" odbang odbang2 ".rectang" dbang dbang2) (command "change" "l" "" "p" "c" "1" "")
;Xö lý b¶ng thèng kª
;-----------------------------
(setq gockep (angtos (- pi goct) 1 4))
(setq Kiem1 (substr gockep 2 1) kiem2 (substr gockep 3 1) kiem3 (substr gockep 4 1))
(cond ((= kiem1 "d") (setq dau (substr gockep 1 1) cuoi (substr gockep 3))) ((= kiem2 "d") (setq dau (substr gockep 1 2) cuoi (substr gockep 4))) ((= kiem3 "d") (setq dau (substr gockep 1 3) cuoi (substr gockep 5)))
)
(setq gockep (strcat (strcat dau "%%d") cuoi))
;----------------------------
(setq nhan (rtos sttdinh 2 0))
(setq chugoc (strcat (strcat "A" nhan) (strcat "=" gockep)))
(setq chubk (strcat (strcat (strcat "R" nhan) (strcat "=" ssbk)) "m"))
(setq chutt (strcat (strcat (strcat "T" nhan) (strcat "=" T)) "m"))
(setq chup (strcat (strcat (strcat "P" nhan) (strcat "=" P)) "m"))
(setq chucd (strcat (strcat (strcat "K" nhan) (strcat "=" K)) "m"))
(setq dong1 (polar dbang (- (* 2 pi) (/ (* 9 pi) 24)) (* 1.75 (getvar "textsize")))
dong2 (polar dong1 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong3 (polar dong2 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong4 (polar dong3 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong5 (polar dong4 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
)
(command "-layer" "s" "Text" "" ".text" dong1 "" "" chugoc "" ".text" dong2 "" "" chubk "" ".text" dong3 "" "" chutt "" ".text" dong4 "" "" chup "" ".text" dong5 "" "" chucd "")
(setq tendinh (strcat "A" nhan))
(command ".text" dinh "" "" tendinh "")
(command "insert" "nut" dinh "" "" "" )
(setvar "osmode" osm)
(setvar "cmdecho" cmd) (princ)
)
Các bác cho e hỏi trong code trên chỉnh sửa như thế nào để được chiều cao của text xuất ra và text trong dim được như ý muốn?
<<
|
Filename: 196819_knut_gn.lsp
|
|
Tác giả: billgateviet
Bài viết gốc: 64995
Tên lệnh: od oc |
Đánh số thứ tự tăng dần
:lol2:
Bạn dùng thử chương trình sau. Có 2 lệnh: 1) Lệnh OD: Ordinate number with any format. Đánh số thứ tự với bất kỳ định dạng nào: số, chữ, chữ và số. Ví...
>>
:lol2:
Bạn dùng thử chương trình sau. Có 2 lệnh: 1) Lệnh OD: Ordinate number with any format. Đánh số thứ tự với bất kỳ định dạng nào: số, chữ, chữ và số. Ví dụ:
Command: od
Begin at <1>: HTT-01-03. Nếu không nhập số, bấm Enter sẽ mặc định từ 1
Increment <1>: 3. Nếu không nhập số, bấm Enter sẽ lấy mặc định là 1
Base point <exit>: chỉ điểm -> HTT-01-03
Base point <exit>: chỉ điểm -> HTT-01-06
Base point <exit>: chỉ điểm -> HTT-01-09
.........
Đến khi... chán thì:
Base point <exit>: Enter -> Thoát
2) Lệnh OC: Ordinate number, Copy from template. Đánh số thứ tự bằng cách copy mẫu có sẵn. Hoạt động giống như trên, nhưng thay vì "Begin at" thì chọn một mẫu có sẵn và 1 điểm tham chiếu làm chuẩn (tương tự như trình của bạn Lê Huy Hà nhưng có thêm tính năng tùy chọn Increment theo ý bạn).
Các bạn dùng nếu thấy có gì bất ổn thì phản hồi để mình sửa.
;;;------------------------------------------------------------------------------------
(defun getTw() ;;;Get textstyle
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th) ;;;Get textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p) ;;;Entmake text S at p
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
(cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
n2 (itoa (+ dn (atoi n)))
i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;------------------------------------------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
i (strlen c)
c1 (substr c 1 (- i 1))
c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
(progn (command "erase" (entlast) "") (alert "Over character!") (exit))
(strcat c1 c2)
)
)
;;;==============================================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
cn (getstring "\nBegin at <1>: " T)
dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
(emkT cn p)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
)
(princ)
)
;;;==============================================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
e (car (entsel "\nSelect template text:"))
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
(command "copy" e "" p1 p2)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
(setq
dat (entget (entlast))
dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
)
(princ)
)
;;;==============================================
Nếu dùng lệnh OD của bạn mà copy cho mình cái này được kô " Bản vẽ số n/1200" với n chạy từ 1 đến 1200. Hoặc bạn có phương án nào hay giải quyết bài toán này giúp mình để kô phải làm thủ công . Thanks a lot
<<
|
Filename: 64995_od_oc.lsp
|
|
Tác giả: proconeng86
Bài viết gốc: 289934
Tên lệnh: dmat |
lisp chuyển màu các thuộc tính dynamic block
Hề hề hề,
Sorry bạn vì chậm trả lời.
Đây là lisp mình đã bổ sung theo yêu cầu của bạn. hãy dùng thử...
>>
Hề hề hề,
Sorry bạn vì chậm trả lời.
Đây là lisp mình đã bổ sung theo yêu cầu của bạn. hãy dùng thử và cho ý kiến.
(defun c:dmat (/ ss tag col i a b taglst tagname ssl tag0)
(prompt "\n Chon cac block chua thuoc tinh can doi mau")
(setq ss (ssget (list (cons 0 "insert") (cons 66 1))))
(setq ssl (acet-ss-to-list ss))
(setq taglst (list))
(foreach blk ssl
(setq a (entnext blk))
(while (and a (/= (cdr (assoc 0 (entget a))) "SEQEND"))
(if (= (cdr (assoc 0 (entget a))) "ATTRIB")
(progn
(setq tag0 (cdr (assoc 2 (entget a))))
(if (not (member tag0 taglst))
(setq taglst (append taglst (list tag0)))
)
)
)
(setq a (entnext a))
)
)
(setq tagname "")
(foreach tag taglst
(setq tagname (strcat tagname tag " , "))
)
(prompt (strcat "\n Cac thuoc tinh bao gom: " tagname))
(setq tag (getstring "\n Nhap tag name cua thuoc tinh can doi mau : ")
col (acad_colordlg 1)
i 0)
(while (setq a (ssname ss i))
(setq b (entnext a))
(while (and b (/= (cdr (assoc 0 (entget b))) "SEQEND"))
(if (and (= (cdr (assoc 0 (entget b))) "ATTRIB") (= (cdr (assoc 2 (entget b))) tag))
(progn
(entmod (subst (cons 62 col) (assoc 62 (entget b)) (entget b)))
(entupd b)
)
)
(setq b (entnext b))
)
(setq i (1+ i))
)
(princ)
)
Cám ơn bạn phamthanhbinh nhiều lắm, mình đã dùng thử và lisp bạn rất tốt, đúng ý của mình cần, nhưng qua trao đổi trên diễn đàn mình thấy bạn Tue_NV đưa ra 1 ý rất hay, đó là tạo 1 lisp có thể liệt kê hàng loạt ra các attribute có nội dung giống nhau để từ đó đổi màu luôn thế, như thế sẽ rất tiện lợi, mình làm hết 1 lượt, cuối cùng chọn tất cả để đổi màu thôi, rất là hay. cụ thể nội dung lisp đó là:
1. gõ lệnh
2. đưa ra lựa chọn các dynamic block cần đổi mầu
3. đưa ra 1 bảng để liệt kê ra các attribute có nội dung giống nhau (chỉ những attribute có nội dung giống nhau thôi)
4. chọn attribute cần đổi màu
5. đưa ra bảng màu để lựa chọn
6. hỏi có muốn đổi attribute khác có nội dung giống nhau khác không, nếu có lặp lại bước 3, còn không thì kết thúc lệnh
Ngoài ra mình còn cần 1 lisp kiểu như lệnh machop nhưng dùng được với attribute trong dynamic block để đổi nội dung và màu của 1 attribute theo 1 attribute mẫu. nội dung lisp đó là:
1. đưa ra lựa chọn attribute của 1 dynamic block chọn làm mẫu (lựa chọn bằng cách click thẳng vào attribute nào thì lấy luôn attribute đó làm gốc)
2. đưa ra lựa chọn những atribute của dynamic block nào muốn đổi theo attribute mẫu (đưa ra bảng liệt kê tên các attribute trong các dynamic block đã được lựa chọn)
3. kết thúc lệnh
Rất mong bạn phamthanhbinh cũng như các bạn trên diễn đàn giúp mình, mình cám ơn nhiều
<<
|
Filename: 289934_dmat.lsp
|
|
Tác giả: phamngoctukts
Bài viết gốc: 108833
Tên lệnh: cat |
nhờ các cao thủ viết dùm lisp hatch,ve thang cat.
hatch: lisp 1:khi nhập lệnh h thì tự chuyển layer hatch và xuất hiện hợp thoại hatch cho chọn vật liệu và hatch bình thường như lệch hatch của cad.
lisp 2:khi...
>>
hatch: lisp 1:khi nhập lệnh h thì tự chuyển layer hatch và xuất hiện hợp thoại hatch cho chọn vật liệu và hatch bình thường như lệch hatch của cad.
lisp 2:khi nhập lệnh hh thì tự chuyển layer hatch và cho ta hatch = mặt cắt solid (lưu ý:không xuất hiện hộp thoại hatch,chỉ cần nhập lệnh tự chuyển layer hatch,pick chon miền,enter->được hatch solid)
vẽ thang cắt:
khi nhập lệnh,pick 2 điểm cad tự tính ra chiều cao của thang,pick điểm bắt đầu,nhập bề rộng bậc và số bật->ta duoc thang cắt (lưu ý:vì pick 2 điểm(chiều cao của tầng)nên chiều cao thang có thể lẽ nên lisp này là tối ưu nhất)
Bạn có thể dùng cái vẽ mặt vắt thang này do mình viết.
Mình là KTS giống như bao KTS khác đều ngại vẽ mặt cắt cầu thang. Chính vì vậy mình muốn xây dựng lisp để làm công việc này được nhanh chóng thuận lợi. Mình đã xây dựng được code như thế này. Mong các bạn đóng góp ý kiến thêm để mình hoàn chỉnh.
đây là code
(defun c:cat ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq tbl (tblsearch "layer" "_cat"))
(if (= tbl nil) (command "-layer" "n" "_cat" "c" "4" "_cat" ""))
(setq tbl1 (tblsearch "layer" "_hatch"))
(if (= tbl1 nil) (command "-layer" "n" "_hatch" "c" "8" "_hatch" ""))
(setq tbl2 (tblsearch "layer" "_thay"))
(if (= tbl2 nil) (command "-layer" "n" "_thay" "c" "23" "_thay" ""))
(setvar "clayer" "_cat")
(setq pc1 (getpoint "\nChon diem thu nhat: "))
(setq pc2 (getpoint "\nChon diem thu hai: " pc1))
(command "-view" "s" "v1")
(setq p (getpoint "\nChon diem de ve mat cat: "))
(command "-view" "s" "v2")
(setq ct (getreal "\nVao chieu cao tang: "))
(setq sb1 (getint "\nVao so bac: "))
(command "-view" "r" "v1")
(setq catb (ssget "f" (list pc1 pc2)))
(setq i 0)
(setq listpoint nil)
(setq listbac nil)
(while (< i (sslength catb))
(setq n (ssname catb i))
(setq pl1 (cdr (assoc 10 (entget n))))
(setq pl2 (cdr (assoc 11 (entget n))))
(setq pcat (inters pc1 pc2 pl1 pl2))
(setq listpoint (append listpoint (list pcat)))
(setq i (1+ i))
)
(setq i1 0)
(setq sb 0)
(while (< (1+ i1) (length listpoint))
(setq po1 (nth i1 listpoint))
(setq po2 (nth (1+ i1) listpoint))
(setq bac (distance po1 po2))
(setq listbac (append listbac (list bac)))
(if (equal (nth 0 (reverse listbac)) (nth 1 (reverse listbac)))
(setq sb (+ i1 2))
)
(setq i1 (1+ i1))
)
(vethangthang)
)
(defun vethangthang ()
(setq nb 20.0 bk 10.0
MBTong1 "ANSI32" tl1 100 angh1 0
MBTong2 "ar-conc" tl2 10 angh2 0
MBTong3 "ANSI31" tl3 200 angh3 0
MBTong4 "ar-sand" tl4 4 angh4 0
r (car listbac)
c (/ ct sb1)
d 100
oldos (getvar "osmode")
di (* sb (sqrt (+ (* c c) (* r r))))
ang (atan (/ c r))
p01 (polar p 0 10)
p02 (polar p01 (/ (* 270 pi) 180) 20)
p03 (polar p02 ang (/ 20 (sin ang)))
p2 (polar p02 ang di)
p22 (polar p2 (/ (* 90 pi) 180) 20)
p222 (polar p22 (/ (* 180 pi) 180) 10)
p3 (polar p03 0 (/ d (sin ang)))
p33 (polar p02 0 (/ d (sin ang)))
p4 (polar p2 (/ (* 3 pi) 2) (/ d (cos ang)))
dibt (/ 10 (cos ang))
pbt1 p02
pbt3 (polar p02 ang (/ (distance p02 p2) sb) )
pbt2 (list (car pbt1) (cadr pbt3) 0)
pbt4 (polar pbt2 (/ (* 90 pi) 180) 10)
)
(setvar "osmode" 0 )
(command "-view" "r" "v2")
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")
)
)
(command "")
(setvar "cmdecho" 0)
(command "line" p p01 "")
(setq el4 (entlast))
(command "pline" pbt1 pbt2 pbt3 "C")
(setq eL1 (entlast))
(command "hatch" MBTong3 tl3 angh3 eL1 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL2 (entlast))
(command "line" pbt3 (list (car p) (cadr pbt3) 0) "")
(setq eL3 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" el1 el2 el3 el4 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(command "-BOUNDARY" pbt4 "")
(setq eL5 (entlast))
(command "rectang" p pbt2)
(setq eL6 (entlast))
(command "hatch" MBTong4 tl4 angh4 eL5 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL8 (entlast))
(command "hatch" MBTong4 tl4 angh4 el6 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq eL7 (entlast))
(command "ucs" "z" p02 p2)
(command "ARray" eL5 eL6 el7 el8 "" "R" "1" sb (/ di sb))
(command "ucs" "")
(vethangcong)
(setvar "osmode" oldos)
(setvar "clayer" old_layer)
(princ)
)
(defun vethangcong ()
(setq goc01 (polar p ang di))
(setq i2 sb)
(setq ptt goc01)
(while (< i2 (length listbac))
(setq rbc (nth i2 listbac))
(command ".pline")
(command ptt)
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ 10 rbc)) ",0")
""
)
(setq ptt1 (polar ptt (/ (* 90 pi) 180) (- c (* 2.0 bk))))
(setq ptt2 (polar ptt1 0 10))
(setq ptt3 (polar ptt2 (/ (* 90 pi) 180) 10))
(command "rectang" ptt ptt2)
(command "hatch" MBTong4 tl4 angh4 "l" "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command ".pline")
(command ptt1)
(command
(strcat "@" (rtos (+ 10 rbc)) ",0")
(strcat "@0," (rtos (* 2.0 bk)))
(strcat "@" (rtos (- bk nb)) ",0")
""
)
(setq ptt (getvar "lastpoint"))
(command "-hatch" ptt3 "")
(command "change" "l" "" "p" "la" "_hatch" "")
(setq i2 (1+ i2))
)
(setq pocuoi (polar ptt (/ (* 270 pi) 180) (/ (* c 2) 3)))
(setq pocuoi1 (polar pocuoi (/ (* 270 pi) 180) (/ (* c 2) 3)))
(command ".pline" p02 p2 "a" pocuoi "")
(setq noi1 (entlast))
(command "offset" "100" noi1 pocuoi1 "")
(setq noi2 (entlast))
(setq popcuoi (cdr (assoc 10 (reverse (entget noi2)))))
(setq popdau (cdr (assoc 10 (entget noi2))))
(command ".pline")
(command p02)
(command
(strcat "@-200,0")
(strcat "@0,-300")
(list (car popdau) (- (cadr p02)300))
)
(command popdau "")
(command "")
(setq noi3 (entlast))
(command ".pline" pocuoi popcuoi "")
(setq noi4 (entlast))
(command "pedit" noi1 "j" noi1 noi2 noi3 noi4 "" "")
(setq banbt (entlast))
(command "hatch" MBTong1 tl1 angh1 banbt "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "hatch" MBTong2 tl2 angh2 banbt "")
(command "change" "l" "" "p" "la" "_hatch" "")
(command "line" ptt pocuoi "")
(setq pohatch (polar goc01 0 20))
(command "-hatch" "p" MBTong3 tl3 angh3 pohatch "")
(command "change" "l" "" "p" "la" "_hatch" "")
)
<<
|
Tác giả: HoangSon614
Bài viết gốc: 70062
Tên lệnh: inte |
nối các đường line giao nhau thành pline
Laogia : sử dụng Code này Tue_NV mới viết thử xem
(defun c:inte(/ ss p1 p2 e p)
(prompt "\n Chon cac Line :")
(setq ss (ssget '((0 . "LINE"))))
(setq p1 (getpoint "\n Chon...
>>
Laogia : sử dụng Code này Tue_NV mới viết thử xem
(defun c:inte(/ ss p1 p2 e p)
(prompt "\n Chon cac Line :")
(setq ss (ssget '((0 . "LINE"))))
(setq p1 (getpoint "\n Chon diem dau Polyline A : "))
(setq p2 (getpoint "\n Chon diem cuoi Polyline F : "))
(command "line" p1 p2 "")
(setq e (entlast))
(setq p (getpoint "\n Pick 1 diem vao mien trong da tuyen : "))
(command "boundary" "A" "O" "P" "" p "")
(entdel e)
(command "erase" ss "")
(Command "break" "L" p1 p2)
(princ)
)
Lisp Tue_NV chạy ôốt ôồi nhưng bị ôột lỗi nhỏ
Khi pick 1 điểm vào miền trong đa tuyến thì các chữ cái nằm trong miền đa tuyến bị hình cữ nhật bao lại nhìn không được đẹp cho lắm, Tue_NV có thể khắc phục lỗi này thì tuyệt vời luôn (nhưng còn ý này nữa: Chọn điểm đầu Polyline F chứ không phải điểm cuối)
<<
|
Tác giả: cangua172
Bài viết gốc: 207988
Tên lệnh: rft |
Sửa Lisp phun tọa độ?
Thì lúc đó code của bác gia_bach còn thế này thôi , mình chưa test do bạn lười post file txt lên :
(defun c:RFT(/ data f...
>>
Thì lúc đó code của bác gia_bach còn thế này thôi , mình chưa test do bạn lười post file txt lên :
(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
;| By : Gia Bach, gia_bach @ www.CadViet.com Edited @Ketxu |;
(vl-load-com)
(if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
(or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
(setq f (open (findfile ten) "r"))
(while (setq Line (read-line f))
(setq pt (read (strcat "(" Line ")")))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
(progn
(vla-put-Layer (vla-addpoint spc (setq pXY (vlax-3d-point (list (car pt)(cadr pt))))) "Point")
(vla-put-Layer (vla-addtext spc (rtos (last pt) 2 2) pXY h) "Caodo")
)
)
)
)
)
(princ))
Cảm ơn Bác... Lisp dùng được rồi. Chúc Bác sức khỏe...
<<
|