Jump to content
InfoFile
Tác giả: Doan Van Ha
Bài viết gốc: 238672
Tên lệnh: ha
Lisp Move đối tượng hàng loạt được chọn trước

Srr, tôi viết gấp quá nên bị nhầm tí. Sửa lại đây!

;Doan Van Ha - CADViet.com - Ngay 16/6/2013
;Chuc nang: Move tung nhom doi tuong den 1 Lien.
(defun C:HA( / kieu typ lay ent ss p1 p2 pt z osm cmd)
 (command "undo" "be") (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
 (initget "P TT TD 3")
 (setq kieu (getkword "\nKieu doi tuong can Move : "))
 (cond
  ((= kieu "P")...
>>

Srr, tôi viết gấp quá nên bị nhầm tí. Sửa lại đây!

;Doan Van Ha - CADViet.com - Ngay 16/6/2013
;Chuc nang: Move tung nhom doi tuong den 1 Lien.
(defun C:HA( / kieu typ lay ent ss p1 p2 pt z osm cmd)
 (command "undo" "be") (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
 (initget "P TT TD 3")
 (setq kieu (getkword "\nKieu doi tuong can Move : "))
 (cond
  ((= kieu "P") (setq typ "Point" lay "diem"))
  ((= kieu "TT") (setq typ "Text" lay "Tendiem"))
  ((= kieu "TD") (setq typ "Text" lay "Docao"))
  ((= kieu "3") (setq typ "Point,Text" lay "diem,Tendiem,Docao")))
 (if
  (and
   (setq ent (car (entsel "\nChon Line: ")))
   (princ "\nChon cac doi tuong can Move...")
   (setq ss (ssget (list (cons 0 typ) (cons 8 lay)))))
  (progn 
   (setvar "osmode" 0) (setvar "cmdecho" 0)
   (setq p1 (cdr (assoc 10 (entget ent))))
   (setq p2 (cdr (assoc 11 (entget ent))))
   (setq z -1)
   (repeat (sslength ss)
    (setq pt (cdr (assoc 10 (entget (ssname ss (setq z (1+ z)))))))
    (command "move" (ssname ss z) "" pt (FindPerpPoint p1 p2 pt)))))
 (setvar "osmode" osm) (setvar "cmdecho" cmd) (command "undo" "e") (princ))
(defun FindPerpPoint (p1 p2 q / x1 x2 x3 y1 y2 y3 z1 z2 z3 T4)
 (setq x1 (car p1) x2 (car p2) x3 (car q)
       y1 (cadr p1) y2 (cadr p2) y3 (cadr q)
       z1 (caddr p1) z2 (caddr p2) z3 (caddr q)
       T4 (/ (+ (* (- x2 x1) (- x3 x1)) (* (- y2 y1) (- y3 y1)) (* (- z2 z1) (- z3 z1)))
             (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1)) (* (- z2 z1) (- z2 z1)))))
 (list (+ x1 (* T4 (- x2 x1))) (+ y1 (* T4 (- y2 y1))) (+ z1 (* T4 (- z2 z1)))))


<<

Filename: 238672_ha.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 108685
Tên lệnh: hcm
Viết lisp theo yêu cầu [phần 2]


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...
>>

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 với cọc bạn nhé.
3/- Lisp này chỉ chạy đúng với cấu trúc hình vẽ như cái file bạn đã upload. Cụ thể là các khoảng cách giữa các đường line ngang màu xanh của bạn phải là 2 và chiều cao các text cũng đúng y boong như vậy bạn nhé.
4/- Nếu bạn thay đổi cái cấu trúc hình này thì lisp sẽ chạy ra cái kết quả không như ý muốn. Sở dĩ vậy là do mình bố trí text căn cứ vào chiều cao hiện tại của nó và cái khoảng hở của các đường line màu xanh bạn ạ. Nếu cần thiết bạn có thể tự thay đổi các kích thước này trong lisp cho phù hợp.

Lisp đây:


Chúc bạn vui.
<<

Filename: 108685_hcm.lsp
Tác giả: cd2k44
Bài viết gốc: 238755
Tên lệnh: cr
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

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...

>>

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 0
(defun tccd ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "angbase" 0)
(setvar "angdir" 0)
)
;;;copy va xoay doi tuong
(defun c:cr (/ doituong goc dmoi gocxoay)
(prompt "\nChon doi tuong muon copy")
(setq doituong (ssget))
(setq dgoc (getpoint "\nChon diem goc:"))
(start)
(tccd)
(setq dmoi (getpoint "\nChon diem den moi:")
gocxoay (/ (* (getangle "\nNhap goc xoay:") 180) pi))
(command "copy" "P" "" dgoc dmoi "")
(command "rotate" "Last" "" dmoi gocxoay "")
(end)
)


<<

Filename: 238755_cr.lsp
Tác giả: cd2k44
Bài viết gốc: 238769
Tên lệnh: cr
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

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)...

>>

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) pi))
(command "rotate" "P" "" txoay gocxoay "")
)

Khi tâm xoay trùng với điểm gốc bạn muốn di chuyển tới thì bạn chỉ cần enter và nhập góc xoay


<<

Filename: 238769_cr.lsp
Tác giả: Chiron
Bài viết gốc: 238766
Tên lệnh: mnr
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

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
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

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 ?

@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 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
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

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)
)

<<

Filename: 238994_cr.lsp
Tác giả: gp14
Bài viết gốc: 11689
Tên lệnh: cr
Mỗi ngày một câu chuyện cười
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!
>>
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!

Tự Tử Bằng Bún Rượu

Người nọ có tính hay ăn quà vặt, vợ tần tảo buôn bán dành dụm được tiền, anh thường lấy trộm ra quán đánh chén. Vợ giận lắm khóc hết nước mắt. Anh ta không thương vợ, lại sửng cổ dọa là tự tử.

- Cứ như thế này thì sống làm sao được. Tôi sẽ chết cho bà sống một mình...

Vợ cáu lên:

- Ừ, chồng con như thế thì uống dấm thanh, ăn lá ngón mà chết quách đi cho rồi!

Anh ta nói đượm vẻ năn nỉ:

- Dấm thanh thì chua, lá ngón thì đắng, nhà cứ đưa tiền cho tôi ra chợ mua bún uống với rượu, say bí tỉ cũng chết. Chết như vậy khỏe hơn!
<<

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
[Yêu cầu] Lisp chọn nhanh block cùng nội dung ATT

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...
>>

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 (ssget))
   (repeat (setq count (sslength sset))
    (setq count (1- count) elem (ssname sset count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))
     (prompt "\nDoi tuong nay thuoc lop bi khoa. Khong the an no.")))))
 (princ))
;---------- HIEN DOI TUONG DUOC CHON, AN PHAN CON LAI
(defun C:HIEN (/ sset0 sset count elem)
 (setq sset (cadr (ssgetfirst)))
 (prompt "\nChon cac doi tuong de hien: ")
 (if (null sset)
  (setq sset (ssget)))
 (cond
  ((setq sset0 (ssget "_X"))
   (repeat (setq count (sslength sset0))
    (setq count (1- count) elem (ssname sset0 count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))))))
 (cond
  (sset
   (repeat (setq count (sslength sset))
    (setq count (1- count) elem (ssname sset count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 0) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 0))))))))))
;---------- HIEN TAT CA DOI TUONG
(defun C:HIENTC (/ WhatNextsset count elem)
 (defun DXF (Id Obj)
  (cdr (assoc Id (entget Obj))))
 (cond
  ((setq sset (ssget "_X" '((60 . 1))))
   (initget "Yes No")
   (setq WhatNext
    (cond
     ((getkword "\nTat ca doi tuong dang an se duoc hien? N/<Yes>: "))
     (T "Yes")))
  (cond
   ((= WhatNext "Yes")
    (prompt "\nVui long doi...")
     (repeat (setq count (sslength sset))
      (setq count (1- count) elem (ssname sset count))
      (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
       (entmod (subst '(60 . 0) '(60 . 1) (entget elem)))
       (prompt "\nDoi tuong nay thuoc lop bi khoa. Khong the hien no.")))
    (prompt "\nKet thuc..."))))
  (T (prompt "\nKhong co doi tuong nao duoc an."))))
;---------- DOI TUONG AN VA HIEN DOI CHO CHO NHAU
(defun C:CHUYEN (/ sset0 sset count elem)
 (setq sset (ssget "_X" '((60 . 1))))
 (cond
  ((setq sset0 (ssget "_X"))
   (repeat (setq count (sslength sset0))
    (setq count (1- count) elem (ssname sset0 count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))))))
 (cond
  (sset
   (repeat (setq count (sslength sset))
    (setq count (1- count) elem (ssname sset count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 0) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 0))))))))))
(princ "\nAn cac doi tuong duoc chon, dung lenh: AN")
(princ "\nHien cac doi tuong duoc chon, dung lenh: HIEN")
(princ "\nHien tat ca doi tuong tren ban ve, dung lenh: HIENTC")
(princ "\nChuyen doi giua doi tuong an va hien, dung lenh: CHUYEN")
(princ)
;----------
 


<<

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
Lisp chọn nhanh block cùng nội dung ATT

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...
>>

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 count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))
     (prompt "\nDoi tuong nay thuoc lop bi khoa. Khong the an no.")))))
 (princ))
;---------- HIEN DOI TUONG DUOC CHON, AN PHAN CON LAI
(defun C:HIEN (/ sset0 sset count elem)
 (setq sset (cadr (ssgetfirst)))
 (prompt "\nChon cac doi tuong de hien: ")
 (if (null sset)
  (setq sset (ssget)))
 (cond
  ((setq sset0 (ssget "_X"))
   (repeat (setq count (sslength sset0))
    (setq count (1- count) elem (ssname sset0 count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))))))
 (cond
  (sset
   (repeat (setq count (sslength sset))
    (setq count (1- count) elem (ssname sset count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 0) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 0))))))))))
;---------- HIEN TAT CA DOI TUONG
(defun C:HIENTC (/ WhatNextsset count elem)
 (cond
  ((setq sset (ssget "_X" '((60 . 1))))
   (initget "Yes No")
   (setq WhatNext
    (cond
     ((getkword "\nTat ca doi tuong dang an se duoc hien? N/<Yes>: "))
     (T "Yes")))
  (cond
   ((= WhatNext "Yes")
    (prompt "\nVui long doi...")
     (repeat (setq count (sslength sset))
      (setq count (1- count) elem (ssname sset count))
      (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
       (entmod (subst '(60 . 0) '(60 . 1) (entget elem)))
       (prompt "\nDoi tuong nay thuoc lop bi khoa. Khong the hien no.")))
    (prompt "\nKet thuc..."))))
  (T (prompt "\nKhong co doi tuong nao duoc an."))))
;---------- DOI TUONG AN VA HIEN DOI CHO CHO NHAU
(defun C:CHUYEN (/ sset0 sset count elem)
 (setq sset (ssget "_X" '((60 . 1))))
 (cond
  ((setq sset0 (ssget "_X"))
   (repeat (setq count (sslength sset0))
    (setq count (1- count) elem (ssname sset0 count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 1) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 1)))))))))
 (cond
  (sset
   (repeat (setq count (sslength sset))
    (setq count (1- count) elem (ssname sset count))
    (if (/= 4 (logand 4 (DXF 70 (tblobjname "layer" (DXF 8 elem)))))
     (if (DXF 60 elem)
      (entmod (subst '(60 . 0) (assoc 60 (entget elem)) (entget elem)))
      (entmod (append (entget elem) (list '(60 . 0))))))))))
(princ "\nAn cac doi tuong duoc chon, dung lenh: AN")
(princ "\nHien cac doi tuong duoc chon, dung lenh: HIEN")
(princ "\nHien tat ca doi tuong tren ban ve, dung lenh: HIENTC")
(princ "\nChuyen doi giua doi tuong an va hien, dung lenh: CHUYEN")
(princ)
;----------
 


<<

Filename: 239201_an_hien_hientc_chuyen.lsp
Tác giả: quansla
Bài viết gốc: 239194
Tên lệnh: 1234
Help - Rắc rối do lạm dụng annotative !

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)
)

<<

Filename: 239194_1234.lsp
Tác giả: hoangkimoanh
Bài viết gốc: 239349
Tên lệnh: test
[yêu cầu] Nhờ sửa code copy sang bản vẽ mới

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
Viết lisp theo yêu cầu [phần 2]
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.

Filename: 120081_dx.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 239113
Tên lệnh: ha
Nhờ lisp vẽ đường SPL dựa theo 2 SPL hoặc PL có sẵn

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))))
 


<<

Filename: 239113_ha.lsp
Tác giả: pdle
Bài viết gốc: 196658
Tên lệnh: lbl
Không explode toàn bộ chọn được một lúc
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)
...
>>
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)
ndxf (subst (cons 8 lay) (assoc 8 ndxf) ndxf)
)
(entmod ndxf)
)
(setvar "qaflags" oldqa)
(princ)
)

<<

Filename: 196658_lbl.lsp
Tác giả: KangKung
Bài viết gốc: 239782
Tên lệnh: test
Làm sao để chuyển line weight trong block thành bylayer?

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
Viết lisp theo yêu cầu [phần 2]

Của bạn đây.

Filename: 112421_dv.lsp
Tác giả: KangKung
Bài viết gốc: 239832
Tên lệnh: dlw
Làm sao để chuyển line weight trong block thành bylayer?

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
Viết lisp theo yêu cầu [phần 2]

Đâ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

Filename: 95724_lb2.lsp

Trang 134/330

134