- page 134

Filename: 238672_ha.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 108685
Tên lệnh: hcm

Chào bạn Ba5chngoctung,
Bạn xài thử cái này xem đã đúng ý chưa nhé.
Có vài điều lưu ý bạn khi dùng lisp này là:
1/- Việc chọn điể đầu và điểm cuối của bạn phải được thực hiện đúng trên đường chuẩn như bạn đã đánh dấu.
2/- Việc chọn text cần thay thế bạn phải chọn các text nằm dọc theo các cọc màu ghi của bạn chứ không chọn các text nằm ngang vuông góc...

Filename: 108685_hcm.lsp

Tác giả: cd2k44
Bài viết gốc: 238755
Tên lệnh: cr

Bạn dùng tạm lisp này nhé

;;Ham luu cac gia tri vao bien tam
(defun start ()
(setq tamcmdecho (getvar "cmdecho"))
(setq tamosmode (getvar "osmode"))
(setq tamangbase (getvar "angbase"))
(setq tamangdir (getvar "angdir"))
)
;;ham dat lai cac gia tri nay
(defun end ()
(setvar "cmdecho" tamcmdecho)
(setvar "osmode" tamosmode)
(setvar "angbase" tamangbase)
(setvar "angdir" tamangdir)
)
;;Ham dat cac gia tri bien bang...

Filename: 238755_cr.lsp

Tác giả: cd2k44
Bài viết gốc: 238769
Tên lệnh: cr

Bổ sung thêm cái tâm xoay cho bạn chọn lại tâm xoay

(defun c:cr (/ goc dmoi gocxoay txoay)
(prompt "\nChon doi tuong muon copy")
(ssget)
(setq dgoc (getpoint "\nChon diem goc:"))
(setq dmoi (getpoint "\nChon diem den moi:"))
(command "copy" "P" "" dgoc dgoc "")
(command "move" "p" "" dgoc dmoi "")
(setq txoay (getpoint "\nChon tam xoay:"))
(if (= txoay nil) (setq txoay dmoi))
(setq gocxoay (/ (* (getangle "\nNhap goc xoay:") 180)...

Filename: 238769_cr.lsp

Tác giả: Chiron
Bài viết gốc: 238766
Tên lệnh: mnr

sang29 thử cái này xem:

(defun c:mnr ()
  (setq ss (ssget))
  (command "move" ss "" "0" "0")
  (command "move" ss "" pause pause)
  (command "rotate" ss "" "@" pause)
)

Filename: 238766_mnr.lsp

Tác giả: hiepttr
Bài viết gốc: 238847
Tên lệnh: cr

Cho mình chung vui với :D

Thể theo nguyện vọng của Hoằn mình edit sang "thể loại" MOCORO:

(defun c:cr( / oldcm doituong goc dmoi)
(setq oldcm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nChon doi tuong muon copy")
(setq doituong (ssget))
(setq dgoc (getpoint "\nChon diem goc:"))
(setq dmoi (getpoint dgoc "\nChon diem den moi:"))
(prompt "\nChon goc quay: ")
(command ".mocoro" doituong "" dgoc "c" dmoi "" "r" pause...
>>

Cho mình chung vui với :D

Thể theo nguyện vọng của Hoằn mình edit sang "thể loại" MOCORO:

(defun c:cr( / oldcm doituong goc dmoi)
(setq oldcm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nChon doi tuong muon copy")
(setq doituong (ssget))
(setq dgoc (getpoint "\nChon diem goc:"))
(setq dmoi (getpoint dgoc "\nChon diem den moi:"))
(prompt "\nChon goc quay: ")
(command ".mocoro" doituong "" dgoc "c" dmoi "" "r" pause "")
(setvar "cmdecho" oldcm)
(princ)
)

Filename: 238847_cr.lsp

Tác giả: ketxu
Bài viết gốc: 238894
Tên lệnh: a b

[LI] Bài tập chương 4.1

@Tuấn : bạn đã thử test code của bạn chưa ? Có vẽ được DimLine nào không ?

@Hiep : Lỗi của bạn thuộc mục thứ 2 ket đã nêu. Khi bạn khai báo (/ oldcmd oldos oldab oldad) có nghĩa là toàn bộ các biến old* đều là biến cục bộ của hàm end, không dùng chung với biến oldcmd ở các hàm khác.

Ở hàm end này oldcmd đang là nil . Lỗi này rất nhiều "cao thủ" ở CV dính và lầm tưởng, không riêng...

@Tuấn : bạn đã thử test code của bạn chưa ? Có vẽ được DimLine nào không ?

Ở hàm end này oldcmd đang là nil . Lỗi này rất nhiều "cao thủ" ở CV dính và lầm tưởng, không riêng gì bạn :)

Để bạn hiểu rõ ý hơn mình đưa ra ví dụ sau :

(defun c:a()(setq l 1))
(defun c:b(/ l)
	(princ (strcat "Gia tri l truoc khi thay doi la " (vl-princ-to-string l)))
	(setq l 2)
	(princ (strcat "Gia tri l sau khi thay doi la " (vl-princ-to-string l)))
	(princ)
)

(defun c:b(/ l)

(princ (strcat "Gia tri l truoc khi thay doi la " (vl-princ-to-string l)))

(setq l 2)

(princ (strcat "Gia tri l sau khi thay doi la " (vl-princ-to-string l)))

(princ)

)

Bước 1 : Chạy a, kiểm tra giá trị l

Bước 2 : Chạy b, bạn thấy 2 điều sau :

- Khi chưa gán, nó đang là nil (có thông báo), tức nó không lấy giá trị của L ở A

- l ta đã thay đổi thành 2 (có thông báo), nhưng đây là giá trị l tạm trong B, nó không liên quan đến l của A

Bước 3 : Nhập !l để kiểm tra giá trị l sau khi B kết thúc

Nhận xét giá trị l, bạn sẽ thấy nó không hề bị ảnh hưởng bởi biến cục bộ của B, chỉ là trùng tên mà thôi

(defun c:a()(setq l 1))

(defun c:b(/ l)(setq l 2))

(defun c:a()(setq l 1))

(defun c:b(/ l)(setq l 2))

(defun c:a()(setq l 1))

(defun c:b(/ l)(setq l 2))

Filename: 238894_a_b.lsp

Tác giả: Tue_NV
Bài viết gốc: 238994
Tên lệnh: cr

Cảm ơn vì đã góp ý & rất mong nhận được sự "khai ngộ" từ các bác để mình ngày một hoàn thiện hơn !!!

.............

Đã hiểu, nhưng với mình bây giờ thì vẫn chưa...
>>

Cảm ơn vì đã góp ý & rất mong nhận được sự "khai ngộ" từ các bác để mình ngày một hoàn thiện hơn !!!

.............

Đã hiểu, nhưng với mình bây giờ thì vẫn chưa làm được !

Bạn xem đoạn code mình sửa lại cho bạn, mình đã ghi chú kèm theo trong code.

Bạn đọc và ngộ ra nhé!

(defun c:cr( / oldcm doituong goc dmoi)
(setq oldcm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nChon doi tuong muon copy")
(setq doituong (ssget))
(setq dgoc (getpoint "\nChon diem goc:"))
 
(prompt "\nChon diem den moi:");; dong nhac chon diem den moi
(command ".mocoro" doituong "" dgoc "c" pause); tam dung tra lai quyen dieu khien cho CAD de ban thay anh dong khi COPY va ban chon diem den moi
(prompt "\nChon goc quay :"); dong nhac chon goc quay
(Command  "" "r" pause ""); tiep tuc lenh mocoro con dang do, tam dung tra lai quyen dieu khien cho CAD de ban thay anh dong khi ROTATE
(setvar "cmdecho" oldcm)
(princ)
)

(defun c:cr( / oldcm doituong goc dmoi)

(setq oldcm (getvar "cmdecho"))

(setvar "cmdecho" 0)

(prompt "\nChon doi tuong muon copy")

(setq doituong (ssget))

(setq dgoc (getpoint "\nChon diem goc:"))

(prompt "\nChon diem den moi:");; dong nhac chon diem den moi

(command ".mocoro" doituong "" dgoc "c" pause); tam dung tra lai quyen dieu khien cho CAD de ban thay anh dong va ban chon diem den moi

(prompt "\nChon goc quay :")

(Command "" "r" pause ""); tiep tuc lenh mocoro con dang do

(setvar "cmdecho" oldcm)

(princ)

)

Mỗi ngày một câu chuyện cười

Filename: 238994_cr.lsp

Tác giả: gp14
Bài viết gốc: 11689
Tên lệnh: cr

Tưởng Là Không Phải

Có anh chàng ở dơ, lại hay mắc cỡ. Một hôm sờ lên cổ áo, bắt được con rận, sợ người ta cười nên vội vàng vứt xuống đất nói to lên:

- Tưởng là con rận hóa ra không phải.

Có người đứng bên cúi xuống tìm bắt con con rận mà chàng ở dơ vừa quăng xuống kiền nói:

- Tưởng là không phải, hóa ra là con rận thật!

[Yêu cầu] Lisp chọn nhanh block cùng nội dung ATT

Filename: 11689_cr.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 239192
Tên lệnh: an hien hientc chuyen

Tôi quên link rồi. Cái này nhớ ra là của ai đó, tôi chỉ biên tập lại thôi :lol: Tôi post lên lại vậy.

;---------- AN & HIEN. free lisp from cadviet.com

;---------- AN DOI TUONG DUOC CHON, HIEN PHAN CON LAI

(defun C:AN (/ sset count elem)

(defun DXF (id obj)

(cdr (assoc id (entget obj))))

(prompt "\nChon cac doi tuong de an: ")

(cond

((setq sset...

Lisp chọn nhanh block cùng nội dung ATT

Filename: 239192_an_hien_hientc_chuyen.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 239201
Tên lệnh: an hien hientc chuyen

Có chút sơ ý.

(defun DXF (id obj)

(cdr (assoc id (entget obj))))

;---------- AN & HIEN. free lisp from cadviet.com

;---------- AN DOI TUONG DUOC CHON, HIEN PHAN CON LAI

(defun C:AN (/ sset count elem)

(prompt "\nChon cac doi tuong de an: ")

(cond

((setq sset (ssget))

(repeat (setq count (sslength sset))

(setq count (1- count) elem (ssname sset...

Help - Rắc rối do lạm dụng annotative !

Filename: 239201_an_hien_hientc_chuyen.lsp

Tác giả: quansla
Bài viết gốc: 239194
Tên lệnh: 1234

Chẳng hiểu là bị đặt annotative ở đâu nữa, nếu tìm ra, thì sẽ có cách khác để sửa code lisp
tạm thời thì bác xài tạm cái này

P/s Nên sang thẻ layout "in" nhấp đôi vào Vp và chạy lệnh này, có thể đổi lại tên lệnh cho khác đi bằng cách thay

dòng

(defun c:1234.....)

thành

(defun c:

Chẳng hiểu là bị đặt annotative ở đâu nữa, nếu tìm ra, thì sẽ có cách khác để sửa code lisp
tạm thời thì bác xài tạm cái này

P/s Nên sang thẻ layout "in" nhấp đôi vào Vp và chạy lệnh này, có thể đổi lại tên lệnh cho khác đi bằng cách thay

dòng

(defun c:1234.....)

thành

(defun c:####.....)

(defun c:1234 ( / dt ent i k sizet ss ten )
(setq dt nil)
(while (null dt)
(prompt "\nChon Block")
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq dt (ssname ss 0))
(prompt (strcat "\nBlock duoc chon :\t <" (setq ten (cdr(assoc 2 (entget dt)))) ">"))
)
;(setq dt nil)
)
)
(if (and dt
(setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 ten)))
i -1
sizeT (cdr(assoc 40 (entget (entnext dt))))
k (getreal (strcat "\nChon co chu moi <" (rtos sizeT 2 3) ">"))))
(while (< (setq i (1+ i)) (sslength ss))
(setq dt (ssname ss i)
ent(entget(entnext dt)))
(entmod (subst (cons 40 k)(assoc 40 ent)ent)))
(prompt "\nKhong thanh cong")
)
(princ)
)

(defun c:1234 ( / dt ent i k sizet ss ten )

(setq dt nil)

(while (null dt)

(prompt "\nChon Block")

(if (setq ss (ssget '((0 . "INSERT"))))

(progn

(setq dt (ssname ss 0))

(prompt (strcat "\nBlock duoc chon :\t <" (setq ten (cdr(assoc 2 (entget dt)))) ">"))

)

;(setq dt nil)

)

(if (and dt

(setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 ten)))

i -1

sizeT (cdr(assoc 40 (entget (entnext dt))))

k (getreal (strcat "\nChon co chu moi <" (rtos sizeT 2 3) ">"))))

(while (< (setq i (1+ i)) (sslength ss))

(setq dt (ssname ss i)

ent(entget(entnext dt)))

(entmod (subst (cons 40 k)(assoc 40 ent)ent)))

(prompt "\nKhong thanh cong")

)

(princ)

)

[yêu cầu] Nhờ sửa code copy sang bản vẽ mới

Filename: 239194_1234.lsp

Tác giả: hoangkimoanh
Bài viết gốc: 239349
Tên lệnh: test

cái code này có mục đích để copy và paste sang file mới, nhưng khi thực hiện lệnh thì nó có sang file mới,nhưng lại hiện sau file mình đang làm việc.

Nhờ các anh sửa giúp để khi Paste sang file mới thì file mới sẽ mở ngay trước mắt màn hình làm việc của mình. cảm ơn các anh!

(defun c:test(/ app docs doc objects ss i n sslist)
  (setq app (vlax-get-acad-object))
 ...
>>

cái code này có mục đích để copy và paste sang file mới, nhưng khi thực hiện lệnh thì nó có sang file mới,nhưng lại hiện sau file mình đang làm việc.

Nhờ các anh sửa giúp để khi Paste sang file mới thì file mới sẽ mở ngay trước mắt màn hình làm việc của mình. cảm ơn các anh!

(defun c:test(/ app docs doc objects ss i n sslist)
  (setq app (vlax-get-acad-object))
  (setq doc (vla-get-activedocument app))
  (setq docs (vla-get-documents app))
  (setq ss (ssget))
  (setq n (sslength ss)
        i 0)
  (repeat n
    (setq sslist (append sslist (list (vlax-ename->vla-object (ssname ss i)))))
    (setq i (1+ i))
  )
  (setq objects (vlax-make-safearray vlax-vbObject (cons 0  (1- n))))
  (vlax-safearray-fill objects sslist)
  (setq doc_new (vla-add docs "acad.dwt"))
  (vla-copyobjects doc objects (vla-get-modelspace doc_new))
(command "_.zoom" "_e")
   (princ)
)

Filename: 239349_test.lsp

Tác giả: phamngoctukts
Bài viết gốc: 120081
Tên lệnh: dx

E sưu tầm được 1 lisp vẽ ký hiệu đối xứng.Nhưng khi vẽ xong nó không phải block,e lại không biết lisp.Nhờ các bác sửa giùm khi vẽ xong nó là 1 block.Thanks.

Nhờ lisp vẽ đường SPL dựa theo 2 SPL hoặc PL có sẵn

Filename: 120081_dx.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 239113
Tên lệnh: ha

Lisp vẽ đường mặt cắt địa chất (đồng danh đất đá) theo 2 lớp (vỉa) trên/dưới và vị trí chính xác của các lỗ khoan.

Chú ý: lisp chỉ vẽ đường đồng danh nằm giữa các lỗ khoan, không vẽ bên ngoài các lỗ khoan.

;Doan Van Ha - CADViet.com - Ngay 20/6/2013

;Chuc nang: ve mat cat dia chat theo 2 lop tren/duoi va vi tri cac lo khoan.

(defun C:HA( / a a1 a2 b b1 b2 dis11 dis12...

Lisp vẽ đường mặt cắt địa chất (đồng danh đất đá) theo 2 lớp (vỉa) trên/dưới và vị trí chính xác của các lỗ khoan.

Chú ý: lisp chỉ vẽ đường đồng danh nằm giữa các lỗ khoan, không vẽ bên ngoài các lỗ khoan.

;Doan Van Ha - CADViet.com - Ngay 20/6/2013

;Chuc nang: ve mat cat dia chat theo 2 lop tren/duoi va vi tri cac lo khoan.

(defun C:HA( / a a1 a2 b b1 b2 dis11 dis12 dis21 dis22 disAB ent ent1 ent11 ent12 ent2 i lst lst1 lst2 lst3 lx pg11 pg12 pg21 pg22 pt pt1 pt2 px1 px2 pxg vec z)

(or cal (arxload "geomcal")) (command "undo" "be")

(setq ent1 (car (entsel "\nChon duong tren: ")))

(setq ent2 (car (entsel "\nChon duong duoi: ")))

(setq lst nil lst1 nil)

(while (setq pt (getpoint "\nChon cac diem lo khoan: "))

(setq lst (cons pt lst))

(if (> (length lst) 1)

(progn

(setq i -1)

(grdraw (nth (setq i (1+ i)) lst) (nth (1+ i) lst) 3))))

(setq lst (reverse lst) i -1 vec '(0 1))

(repeat (1- (length lst))

(setq pt1 (nth (setq i (1+ i)) lst))

(setq ent11 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt1) (cons 11 vec))))

(setq pg11 (car (HA:Giao2Ent ent1 ent11 acExtendNone)) pg12 (car (HA:Giao2Ent ent2 ent11 acExtendNone)))

(setq dis11 (distance pt1 pg11) dis12 (distance pt1 pg12))

(setq pt2 (nth (1+ i) lst))

(setq ent12 (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt2) (cons 11 vec))))

(setq pg21 (car (HA:Giao2Ent ent1 ent12 acExtendNone)) pg22 (car (HA:Giao2Ent ent2 ent12 acExtendNone)))

(setq dis21 (distance pt2 pg21) dis22 (distance pt2 pg22))

(setq disAB (cal "dpl(pt1,pg21,pg22)"))

(setq lst1 (cons (list dis11 dis12 dis21 dis22 disAB pt1 pt2) lst1))

(mapcar 'entdel (list ent11 ent12)))

(setq lst1 (reverse lst1) lst3 nil i -1)

(repeat (length lst1)

(setq lst (nth (setq i (1+ i)) lst1) lx (/ (nth 4 lst) 100) z -1 lst2 nil)

(repeat 101

(setq pxg (polar (nth 5 lst) 0 (* (setq z (1+ z)) lx)))

(setq ent (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pxg) (cons 11 vec))))

(setq px1 (car (HA:Giao2Ent ent1 ent acExtendNone)) px2 (car (HA:Giao2Ent ent2 ent acExtendNone)))

(entdel ent)

(setq a (* lx z) b (- (nth 4 lst) a) a1 (car lst) a2 (cadr lst) b1 (caddr lst) b2 (cadddr lst))

(setq lst2 (cons (polar px1 (/ pi -2) (/ (* (distance px1 px2) (+ (* a b1) (* b a1))) (+ (* a b1) (* b a1) (* a b2) (* b a2)))) lst2)))

(setq lst3 (append lst3 (reverse lst2))))

(Spline lst3)

(command "undo" "e") (redraw) (princ))

(defun HA:Giao2Ent(ent1 ent2 mode / l r)

(setq l (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2) mode))

(repeat (/ (length l) 3)

(setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))

(reverse r))

(defun Spline(lst)

(entmake (append (list '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lst)))

(mapcar (function (lambda(p) (cons 11 p))) lst))))

Không explode toàn bộ chọn được một lúc

Filename: 239113_ha.lsp

Tác giả: pdle
Bài viết gốc: 196658
Tên lệnh: lbl

Trong lisp này, E nghĩ là có thể thay lệnh CHPROP bằng:

(defun c:lbl (/ ss oldqa lay lst ndxf)
(setq ss (ssget "x" (list (cons 0 "INSERT") (cons 8 "0,ff" )))
oldqa (getvar "qaflags"))
(setvar "qaflags" 1)
(setq lay (getstring "\nNhap Layer moi: "))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (acet-explode ss)))))
(foreach n lst
(setq ndxf (entget n)
...

Làm sao để chuyển line weight trong block thành bylayer?

Filename: 196658_lbl.lsp

Tác giả: KangKung
Bài viết gốc: 239782
Tên lệnh: test

Bạn thử Lisp này xem:

(defun C:TEST( / i taphop lst blocklist)
  (vl-load-com)
  (command "UNDO" "BE")
  (princ "\n Chon Block can chuyen: ")
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq i 0 lst(list))
  (while (< i (sslength taphop))
    (setq lst(append lst (list (cdr(assoc 2 (entget(ssname taphop i)))))))
    (setq i (1+ i)))
  (setq blocklist (list))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
 ...
>>

Bạn thử Lisp này xem:

(defun C:TEST( / i taphop lst blocklist)
  (vl-load-com)
  (command "UNDO" "BE")
  (princ "\n Chon Block can chuyen: ")
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq i 0 lst(list))
  (while (< i (sslength taphop))
    (setq lst(append lst (list (cdr(assoc 2 (entget(ssname taphop i)))))))
    (setq i (1+ i)))
  (setq blocklist (list))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (if (/= (vl-position (vla-get-name for-item) lst) nil)
      (setq blocklist (append blocklist (list for-item)))
      )
    )
  (foreach block blocklist
    (vlax-for aa block
      (vla-put-Lineweight aa -1)
      )
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  )

Filename: 239782_test.lsp

Tác giả: phamngoctukts
Bài viết gốc: 112421
Tên lệnh: dv

Của bạn đây.

Làm sao để chuyển line weight trong block thành bylayer?

Filename: 112421_dv.lsp

Tác giả: KangKung
Bài viết gốc: 239832
Tên lệnh: dlw

Thì sài như hướng dẫn ở trên. Cứ copy/paste vào command line thôi. Nếu muốn thành file Lisp thì dùng cái này:

(defun C:DLW()
  (vl-load-com)
  (command "UNDO" "BE")
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (vla-put-Lineweight item -1)
      )
    )
  (command "UNDO" "END")
  (princ)
  )

Filename: 239832_dlw.lsp

Tác giả: 18011985
Bài viết gốc: 95724
Tên lệnh: lb2

Đây bạn dùng thử.

PS: chỉ đúng với gốc toạ độ WORLD còn khi xoay gốc toạ độ không còn đúng nữa.
Kèm theo block này nữa nhé. (copy block trong file dưới vào bản vẽ của bạn) Chúc bạn thành công.
http://www.cadviet.com/upfiles/2/moc_hanh.dwg