Jump to content
InfoFile
Tác giả: phamngoctukts
Bài viết gốc: 111446
Tên lệnh: mahoa
chuyển chữ thành số

hì hì Các bạn viết vui ghê, mình góp ý chút xíu nếu sử dụng bảng mã ASCII thì viết không có dấu. Mình cũng đã viết để mã hoá lisp roài chia sẻ cho các bạn một...
>>
hì hì Các bạn viết vui ghê, mình góp ý chút xíu nếu sử dụng bảng mã ASCII thì viết không có dấu. Mình cũng đã viết để mã hoá lisp roài chia sẻ cho các bạn một chút hì hì. Bạn thử sử dụng đoạn code sau nhé.

(defun c:mahoa (/ kytu sokytu mahoatong mahokytu ktkytu)
 (setq kytu (getstring "\n NhËp key: "))
 (setq sokytu (strlen kytu))
 (setq i 1)
 (while (<= i sokytu)
   (setq ktkytu (substr kytu i 1))
   (setq mahoakytu (ascii ktkytu))
   (setq mahoatong (append mahoatong (list mahoakytu)))
   (setq i (+ i 1))
   )
 (princ mahoatong)
 (princ)  
 )

Còn để dịch ngược thì các bạn dùng hàm vl-list->string chúc các bạn zui zẻ.

PS: Lisp này chỉ viết được 1 đoạn ký tự nối tiếp muốn viết thành đoạn dài thì phải nhập từ DIALOG không có cứ có dấu space là nó kết thúc.

Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach ý)

;; free lisp from cadviet.com
;Chuong ma hoa chuoi theo thuat toan Ceasar
(DEFUN ENCRYPT(str n / i l str1 m)
(setq str1 "a") 
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (+ m n))
(while (< m 0)
(setq m (+ m 224))
) 
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2)) 
str1
)
(DEFUN DECRYPT (str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (- m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224)) 
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
) 
(setq str1 (substr str1 2))
str1
)

(DEFUN SETALPHA( / Li)
  (setq Li (List))
  (setq i 32)
  (while (<= i 255)
    (setq Li (append Li (List i)))
    (setq i (1+ i))
  )
  (setq LiAlpha Li)
)  
(DEFUN MOD (m n / kq)
(while (>= m n)
(setq m (- m n))
)
(setq kq m)
kq
)
(DEFUN C:ENC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can ma hoa:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (ENCRYPT str m))
      (setq str (ENC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ) 
)
(DEFUN C:DEC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can giai ma:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (DECRYPT str m))
      (setq str (DEC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ) 
)

(DEFUN ENC_MTEXT(str m / LiStr i encstr n)
  (setq LiStr (List))
  (setq encstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq encstr (strcat encstr "\\P" (ENCRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq encstr (substr encstr 4))
  encstr
)  
(DEFUN DEC_MTEXT(str m / LiStr i decstr n)
  (setq LiStr (List))
  (setq decstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq decstr (strcat decstr "\\P" (DECRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq decstr (substr decstr 4))
  decstr
)
(DEFUN GETCONTENT (obj / cont)
  (setq cont (cdr (assoc 1 (entget obj))))
  cont
)
(DEFUN POSTSTR(str0 str / vt i l0 l)
  (setq vt 0)
  (setq l0 (strlen str0))
  (setq l (strlen str))
  (setq i 1)
  (while (< i (- l0 l -1))
    (if (= (substr str0 i l) str)
      (progn             
        (setq vt i)
        (setq i l0)
      )
    )
    (setq i (1+ i))
  )
  vt
)
(DEFUN TENDOITUONG (obj / name)
  (setq name (CDR (ASSOC 0 (ENTGET obj))))  
  name  
)


<<

Filename: 111446_mahoa.lsp
Tác giả: 18011985
Bài viết gốc: 111448
Tên lệnh: enc dec
chuyển chữ thành số
Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach...
>>
Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach ý)

;; free lisp from cadviet.com
;Chuong ma hoa chuoi theo thuat toan Ceasar
(DEFUN ENCRYPT(str n / i l str1 m)
(setq str1 "a") 
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (+ m n))
(while (< m 0)
(setq m (+ m 224))
) 
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2)) 
str1
)
(DEFUN DECRYPT (str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (- m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224)) 
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
) 
(setq str1 (substr str1 2))
str1
)

(DEFUN SETALPHA( / Li)
  (setq Li (List))
  (setq i 32)
  (while (<= i 255)
    (setq Li (append Li (List i)))
    (setq i (1+ i))
  )
  (setq LiAlpha Li)
)  
(DEFUN MOD (m n / kq)
(while (>= m n)
(setq m (- m n))
)
(setq kq m)
kq
)
(DEFUN C:ENC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can ma hoa:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (ENCRYPT str m))
      (setq str (ENC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ) 
)
(DEFUN C:DEC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can giai ma:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (DECRYPT str m))
      (setq str (DEC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ) 
)

(DEFUN ENC_MTEXT(str m / LiStr i encstr n)
  (setq LiStr (List))
  (setq encstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq encstr (strcat encstr "\\P" (ENCRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq encstr (substr encstr 4))
  encstr
)  
(DEFUN DEC_MTEXT(str m / LiStr i decstr n)
  (setq LiStr (List))
  (setq decstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq decstr (strcat decstr "\\P" (DECRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq decstr (substr decstr 4))
  decstr
)
(DEFUN GETCONTENT (obj / cont)
  (setq cont (cdr (assoc 1 (entget obj))))
  cont
)
(DEFUN POSTSTR(str0 str / vt i l0 l)
  (setq vt 0)
  (setq l0 (strlen str0))
  (setq l (strlen str))
  (setq i 1)
  (while (< i (- l0 l -1))
    (if (= (substr str0 i l) str)
      (progn             
        (setq vt i)
        (setq i l0)
      )
    )
    (setq i (1+ i))
  )
  vt
)
(DEFUN TENDOITUONG (obj / name)
  (setq name (CDR (ASSOC 0 (ENTGET obj))))  
  name  
)

Không lỗi đâu bảng mã ASCII là bảng chữ cái không dấu bác à. Đánh không dấu nhé!


<<

Filename: 111448_enc_dec.lsp
Tác giả: dothanhdatvtchd
Bài viết gốc: 215357
Tên lệnh: ctpl
Chọn tất cả đối tượng nằm trong polyline khép kín hoặc wipe out

Dùng lisp hiệu chỉnh này:

(defun c:ctpl( / plst sst)
(setq plst (acet-geom-vertex-list (car (entsel "\nChon pline khep...
>>

Dùng lisp hiệu chỉnh này:

(defun c:ctpl( / plst sst)
(setq plst (acet-geom-vertex-list (car (entsel "\nChon pline khep kin: "))))
(setq plst (LM:UniqueFuzz plst 1E-8))
(setq sst (ssget "wp" plst))
(sssetfirst nil sst))
(defun LM:UniqueFuzz ( l fz )
(if l (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda ( x ) (equal x (car l) fz)) (cdr l)) fz))))

Anh Hà có thể cho em nick yahoo để em hỏi anh một số vấn đề không ạ. Có gì anh chỉ giáo :D

anh gửi mail em nhé: thangt0407@gmail.com


<<

Filename: 215357_ctpl.lsp
Tác giả: duy782006
Bài viết gốc: 426281
Tên lệnh: cpm
LISP Rải cốt thép sàn

Cái này viết lâu rồi xem dùng được không

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchiencopy ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(repeat solanthuchien
(setq index (1+ index))
(command ".copy" doituong "" p1 (polar p1 goc (* kc index)))
)
(setvar "osmode"...
>>

Cái này viết lâu rồi xem dùng được không

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchiencopy ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(repeat solanthuchien
(setq index (1+ index))
(command ".copy" doituong "" p1 (polar p1 goc (* kc index)))
)
(setvar "osmode" luubatdiem)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieunhan ()
(setq index 1)
(setq solanthuchien (- (atoi kytuconlai) 1)) 
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieuchia ()
(setq index 0)
(setq kc (/ kc (atoi kytuconlai)))
(setq solanthuchien (- (atoi kytuconlai) 1)) 
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieutrong ()
(setq p3 (getpoint p1 "\nRai trong khoang: "))
(setq kc1 (distance p1 p3))
(setq index 1)
(setq solanthuchien (- (fix (/ kc1 kc)) 1)) 
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tinhtoankieu ()
(setq ddkc (strlen kieuchep))
(setq skytuconlai (- ddkc 1))
(setq kytuconlai (substr kieuchep 2 skytuconlai))
(setq kytudautien (substr kieuchep 1 1))

(if (= kytudautien "*")
(progn
(kieunhan)
))
(if (= kytudautien ":")
(progn
(kieuchia)
))
(if (= kytudautien "<")
(progn
(kieutrong)
))
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cpm ()
(command "undo" "be")
(setvar "MODEMACRO" "RAI DOI TUONG THEO QUY LUAT CHO TRUOC")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(Prompt "\nChon doi tuong muon chep...")
(setq doituong (ssget)
p1 (getpoint "\nDiem bat dau: ")
p2 (getpoint p1 "\nDiem ket thuc: ")
goc (angle p1 p2)
kc (distance p1 p2)
index 0
)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" doituong "" p1 p2)
(setvar "osmode" luubatdiem)
(setq kieuchep (getstring "\n*N/:N/<: "))
(tinhtoankieu)
(command "undo" "end")
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
(Princ))

-Tên lệnh: pcm
-Thao tác: 
+Nhập lệnh. 
+Chọn đối tượng cần copy.
+Chọn điểm xuất phát.
+Chọn điểm đến. 
*Lisp thực hiện copy nhóm đối tượng từ điểm xuất phát đến điểm đến và đưa ra 3 lựa chọn. *N/:N/<: trong đó N là số tuỳ ý (nhập trực tiếp luôn nhé ví dụ *5 lisp sẽ tự lọc lấy số để thực hiện).
+Lựa chọn *N thì đối tượng sẽ được copy thêm N lần với khoảng cách từ từ đối tượng này đến đối tượng kia bằng điểm xuất phát đến điểm đến.
+Lựa chọn :N Thì khoảng cách từ điểm xuất phát đến điểm đến sẽ được chia làm N lần và đối tượng sẽ được copy đến các điểm nút này.
+Lựa chọn < thì sau khi enter lisp hỏi khoảng cách giới hạn và tính toán rãi trong khoảng cách này phần dư thì bỏ. (kiểu như MEASURE của cad ấy)


<<

Filename: 426281_cpm.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 80492
Tên lệnh: chla
Viết lisp theo yêu cầu [phần 2]
Bạn thay dòng này :

(command "change" ss "" "p" "la" nla "")

Bằng dòng này :

(command "change" ss "" "p" "la" nla "LT" (cdr(assoc 6 lsol)) "")

là...

>>
Bạn thay dòng này :

(command "change" ss "" "p" "la" nla "")

Bằng dòng này :

(command "change" ss "" "p" "la" nla "LT" (cdr(assoc 6 lsol)) "")

là được

Chào bác Tue_NV,

Bác xem lại xem vì dòng code (command "change" ss "" "p" "la" nla "LT" (cdr(assoc 6 lsol)) "") này nằm ngoài vòng lặp Whlie cho nên hàm (cdr(assoc 6 lsol)) sẽ nhận giá trị của linetype ở lớp cuối cùng chứa đối tượng có màu là bylayer.

Do vậy tất cả tập chọn ss đều bị đổi thành linetype này chứ không giữ nguyên được linetype của nó như cũ bác ạ.

Cái lisp của mình sẽ giữ nguyên linetype của đối tượng nếu như nó không phải là bylayer.

Để có thể thỏa mãn yêu cầu của bạn chandatn theo mình hiểu thì cũng phải làm y như đối với việc giữ màu của đối tượng vậy, nghĩa là trước hết phải đổi linetype của đối tượng từ bylayer thành linetype có tên tương ứng, tức là làm cho đối tượng có thêm mã DXF số 6 bác ạ.

Muốn vậy ta thêm một hàm điều kiện if nữa vào trong vòng lặp while.

(if (= (assoc 6 lst) nil)

(progn

(setq la (cdr (assoc 8 lst)))

(setq lsol (tblnext "layer" T))

(while (/= la (cdr (assoc 2 lsol)))

(setq lsol (tblnext "layer"))

)

(setq k (cdr(assoc 6 lsol)))

(setq lst (append lst (list (cons 6 k))))

(entmod lst)

)

)

Và như vậy cái lisp cũ trở thành:

(defun c:chla (/ nla ss n i lst ent la lsol m k)
(setq nla (getstring "\n Nhap ten layer dich: "))
(if (not (tblsearch "layer" nla))
(command "layer" "n" nla "c" "red" nla "")
)
(setq ss (ssget)
     n (sslength ss)
     i 0 )
(while ((setq ent (ssname ss i)
     lst (entget ent))
(setq la (cdr (assoc 8 lst)))
(setq lsol (tblsearch "layer" la))
(if (= (assoc 62 lst) nil)
(progn
(setq m (cdr(assoc 62 lsol)))
(setq lst (append lst (list (cons 62 m))))
(entmod lst)
)
)
(if (= (assoc 6 lst) nil)
(progn
(setq k (cdr(assoc 6 lsol)))
(setq lst (append lst (list (cons 6 k))))
(entmod lst)
)
)
(setq i (1+ i))
)
(command "change" ss "" "p" "la" nla "")
(princ)
)

 

@ ban chandatn: Bạn hãy thử lisp này xem còn phải chỉnh sửa gì nữa không nhé.

 

Bài được edit bởi Phạm Thanh Bình theo sự góp ý của bác Giabach


<<

Filename: 80492_chla.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 52389
Tên lệnh: fn
Giúp tôi: Ghi tên file vào bản vẽ
Lâu quá ko thấy bác nào giúp cả, diễn đàn minhg thiếu nhiệt tình nhỉ. Tự mò mẫm với Lisp FN trên diễn đàn được thế này mong các bác chỉnh sửa lại cho hay...
>>
Lâu quá ko thấy bác nào giúp cả, diễn đàn minhg thiếu nhiệt tình nhỉ. Tự mò mẫm với Lisp FN trên diễn đàn được thế này mong các bác chỉnh sửa lại cho hay nhất

;;; ====== Ghi duong dan File vao ban ve CAD =======
;;;-------------------------------------------------------
(defun wtxt (txt p )
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------
(defun C:FN ( / logn fname mt txt)
(setq
logn (getvar "loginname")
fname (findfile (getvar "dwgname"))
mt (menucmd "M=$(edtime,$(getvar,tdupdate),HH:MM_DD/MO/YY)")
txt (strcat " " fname)
)
(command ".layer" "n" "TEXTfn" "c" "8" "TEXTfn" "s" "TEXTfn" "")
(command ".style" "TEXTfn" "vnsimple" "2" "0.7" "" "" "")

(wtxt txt (getpoint "\nChon diem dat:"))

(command ".rotate" "l" "" (getpoint "\nChon diem xoay:") "r" "0" )
(princ)
(prompt "\nBan da hoan thanh_Chuc thanh cong")
(princ)
)
;;;-------------------------------------------------------

Chào bạn philipdn,

Có vài điều góp ý với bạn như sau:

1/- Bạn đã chứng tỏ rằng bạn có một kiến thức về lisp không tồi. Hơn nữa bạn cũng đã là thành viên khá lâu của diễn đàn này. Chắc bạn cũng đã hiểu khá rõ về mục đích của diễn đàn này. Đó là giúp nhau cùng tiến bộ chứ không phải là làm hộ nhau hay là để ỷ lại vào nhau.

Việc bạn trách móc như vậy chưa hẳn đúng đâu. Rõ ràng là bạn có khả năng chỉnh sửa lisp và có thể làm được cái điều không quá khó mà bạn đã post. Vậy mà bạn vẫn yêu cầu người khác giúp. Không những thế bạn lại hơi quá đáng khi chỉ một yêu cầu của bạn mà bạn không nói rõ ràng đầy đủ ngay từ đầu, lại post lắt nhắt, mỗi lần một tí như kiểu trẻ con vậy. Bác SSG đã từng nói trên diễn đàn yêu cầu mọi ngừoi có yêu cầu viết lisp cần phải suy nghĩ đầy đủ và nghiêm túc để chỉ post yêu cầu một lần. Khi đã viết lisp đúng với yêu cầu đặt ra thì bác ấy sẽ không chấp nhận viết thêm các yêu cầu phụ mà người yêu cầu viết muốn thêm nữa vì điều đó chứng tỏ người yêu cầu không tôn trọng người viết. Với bạn bác ấy đã cảnh báo một lần rồi mà. Bạn nên tự rút kinh nghiệm thì hơn là trách móc mọi người.

2/- Thực ra mình thấy cách suy luận của bạn chưa hay lắm khi làm lisp. Rõ ràng trong bộ mã DXF của một text đã có đầy đủ các mã tương ứng với yêu cầu của bạn. Vì thế bạn chỉ cần bổ sung hay thay thế các mã tương ứng với các yêu cầu của bạn trong hàm entmake là được không cần phải sử dụng phức tạp như bạn là dùng hàm lệnh style, lệnh rotate. Cụ thể:

mã 62 chỉ thị màu của text, mã 50 chỉ thị góc xoay text, mã 8 chỉ thị lớp của text, mã 1 chỉ nội dung text, mã 40 chỉ chiều cao text, mã 41 chỉ hệ số chiều rông text, .......

Do đó, với cái líp của bác SSG, bạn chỉ cần bổ sung biến logn như bạn đã làm, bổ sung hàm đặt tên lớp mà bạn muốn chọn, bổ sung hàm lệnh layer để tạo lớp có tên như bạn chọn và cuối cùng là bổ sung và thay thế các bộ mã tương ứng với yêu cầu của bạn vào trong list các mã của hàm enmake là OK.

Như vậy lisp sẽ gọn và mạch lạc hơn bạn ạ.

Bạn hãy thử làm như mình gợi ý xem nhé. Nếu gặp khó khăn thì bạn hãy post lên mình sẽ giúp.

Chúc bạn vui.


<<

Filename: 52389_fn.lsp
Tác giả: hoacomay70
Bài viết gốc: 358335
Tên lệnh: test
Nhờ viết lisp vẽ đường thẳng vuông góc với Pline

 

Của bạn đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (-...
>>

 

Của bạn đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
dd (getpoint "\nDiem cuoi cua Polyline:")
cd (getreal "\nNhap buoc de rai:")
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
sl (getint "\nSo luong coc rai")
ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)

Bác ơi có thể giúp em thêm một chút là không phải chọn điểm đầu hoặc cuối của pline, lisp tu vẽ ra duong vuông goc ve hai phia duoc khong a, em hay lam tren layout, moi lan rai lai phai quay qua model de chon diem dau va diem cuoi kho qua.


<<

Filename: 358335_test.lsp
Tác giả: hieuhx68
Bài viết gốc: 298027
Tên lệnh: rvx tmp
Nhờ viết lisp vẽ đường thẳng vuông góc với Pline

 

Hôm nay test lại cái lisp ở #31 thì có vấn đề nảy sinh là nếu rải từ cuối pline ngược lên đầu pline sẽ bị lỗi hoặc không...

>>

 

Hôm nay test lại cái lisp ở #31 thì có vấn đề nảy sinh là nếu rải từ cuối pline ngược lên đầu pline sẽ bị lỗi hoặc không làm gì cả. Cho nên sửa lại như dưới đây (tên lệnh rvx).

Đồng thời hôm qua có thấy bác Duy xuất hiện, có nhờ bác ấy sửa. Trong lúc chờ đợi thì bạn xài tạm cái lisp dưới đây (tên lệnh tmp)

 

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
(defun thgoc (ent pt / param)
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
nil)
)
(setq pl (car (entsel "\nChon Polyline:")))
(prompt "\nChon doi tuong can rai:")
(setq ss (ssget)
dd (getpoint "\nDiem bat dau rai (nam tren Polyline) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren Polyline) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE"))  
(setvar "OSMODE" 0)
(repeat sl
(setq el (entlast)
ang (thgoc pl dd))
(command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) cd))))
(setq ss (ssadd)
dd dd1
ang1 (thgoc pl dd))
(while (setq en (entnext el))
(ssadd en ss)
(setq el en))
(command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
)  
(setvar "OSMODE" os)
(princ)
)
 
(defun c:tmp(/)
(defun ttuyen(ent pt / param) 
(if (setq param (vlax-curve-getParamAtPoint ent pt))
(angle '(0 0 0) (vlax-curve-getFirstDeriv ent param))
nil
)
)
(setq pl (car (entsel "\nChon duong dan:"))
en (car (entsel "\nChon block can rai:"))
tt10 (cdr (assoc 10 (entget en)))
ang (cdr (assoc 50 (entget en)))
dd (getpoint "\nDiem bat dau rai (nam tren duong dan) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren duong dan) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
(if (< tm 0) (setq lenh '-) (setq lenh '+))
(if (not cd)
(setq sl (getint "\nNhap so khoang rai:")
cd (/ (abs tm) sl))
(setq sl (fix (/ (abs tm) cd))))
 
(setq os (getvar "OSMODE")
ck (getkword "\nCo xoay block theo duong dan khong? <Enter = co / K= khong> :"))
 
(setvar "OSMODE" 0)
(command "copy" en "" tt10 dd) (setq tm (entlast) n 0)
(if (not ck) (command "rotate" tm "" dd "r" dd (polar dd ang 1) (polar dd (ttuyen pl dd) 1)))
(repeat sl    
(command "copy" tm "" dd (setq dd1 (vlax-curve-getPointAtDist pl ((eval lenh) (vlax-curve-getDistAtPoint pl dd) (* (setq n (1+ n)) cd)))))
(if (not ck) (command "rotate" (entlast) "" dd1 "r" dd1 (polar dd1 (cdr (assoc 50 (entget (entlast)))) 1) (polar dd1 (ttuyen pl dd1) 1)))
)
(setvar "OSMODE" os)
(princ)
)
 

Thanks bác nhiều ah. Lips này ngon rồi ạh. Bác mà ko nói em cũng ko rõ là nó bị lộn như vậy. 


<<

Filename: 298027_rvx_tmp.lsp
Tác giả: Tue_NV
Bài viết gốc: 129278
Tên lệnh: sct
lisp thay đổi cỡ chữ hàng loạt trong bản vẽ
Hề hề,Tiết kiệm đc 1 bước trong trường hợp cụ thể mà bác ^^

Scaletext dùng trong t/h tổng quát

Nếu dùng Scaletext thì rút lệnh lại như vầy, mí lị bỏ qua basepoint...

>>
Hề hề,Tiết kiệm đc 1 bước trong trường hợp cụ thể mà bác ^^

Scaletext dùng trong t/h tổng quát

Nếu dùng Scaletext thì rút lệnh lại như vầy, mí lị bỏ qua basepoint cho tiện

(defun c:sct()(command ".scaletext" (ssget (list (cons 0 "TEXT"))) "" ""))

P/S : bạn Chí nên tìm hiểu cách đặt lệnh tắt trên diễn đàn :s_big:

Cái bạn này lạm dụng Lisp quá. Lisp trên cũng chưa sử dụng cho mọi trường hợp được

Bạn thử cái này nhé :

 

Command: scaletext

 

Select objects: 'fi

.....

 

Nó áp dụng cho mọi trường hợp cụ thể. Trường hợp này Nên sử dụng lệnh scaletext


<<

Filename: 129278_sct.lsp
Tác giả: pfievxd
Bài viết gốc: 129519
Tên lệnh: vg
Vẽ vuông góc với 1 Pline bất kì

pfievxd thử lisp này :

(defun c:Vg (/ curve pt ang vs)
 (if (and
(setq curve (car (entsel "\nChon Curve : ")))
(setq pt...
>>

pfievxd thử lisp này :

(defun c:Vg (/ curve pt ang vs)
 (if (and
(setq curve (car (entsel "\nChon Curve : ")))
(setq pt (getpoint "\n Chon diem tren Curve : ")))
   (progn
     (setq VS (* 0.1 (getvar "Viewsize")))
     (setq pt (vlax-curve-getClosestPointTo curve (trans pt 1 0))
    ang (angle '(0 0) (Vlax-curve-getfirstderiv curve (vlax-curve-getParamAtPoint curve pt))) )
     (entmake (list '(0 . "LINE")(cons 10 pt)(cons 11 (polar pt (+ ang (/ pi 2) ) vs))(cons 62 3) ))
     (entmake (list '(0 . "LINE")(cons 10 pt)(cons 11 (polar pt (- ang (/ pi 2) ) vs))(cons 62 4) ))
     ))
 (princ) )

;-------------------------

Vừa từ quê lên, chúc cả nhà 1 năm mới may mắn và thành công!

HX,cách code lisp của cao thủ có khác, thật đáng học hỏi ...

Em đoán rằng sự khác biệt ở đây nằm ở : (vlax-curve-getClosestPointTo curve (trans pt 1 0)) nên đã đọc lại Help, tiếc là ko hiểu lắm về cái hàm trans, bác có thể chỉ bảo thêm được ko ah


<<

Filename: 129519_vg.lsp
Tác giả: Tue_NV
Bài viết gốc: 125632
Tên lệnh: ddd
Vẽ vuông góc với 1 Pline bất kì
@Phamthanhbinh: em cứ tưởng cái vlax-curve-getSecondDeriv là lấy đạo hàm bậc 2 chứ biggrin.gif nhưng mà hình học 12 quên quên rồi, để em ôn lại cái đã

@DuongTrungHuy : Ý...

>>
@Phamthanhbinh: em cứ tưởng cái vlax-curve-getSecondDeriv là lấy đạo hàm bậc 2 chứ biggrin.gif nhưng mà hình học 12 quên quên rồi, để em ôn lại cái đã

@DuongTrungHuy : Ý mình là từ điểm trên Pline mà còn điểm ở ngoài pline vẽ vuông góc thì okie roài

(Defun c:ddd()
 (Vl-load-com)
 (Setq Pline (Car(Entsel"\n Pline : "))
Point (Getpoint"\n Chon diem : ")
Param (Vlax-curve-getparamatpoint Pline Point)
Pt    (Vlax-curve-getsecondderiv Pline Param)
)
 (Princ))

Kết quả là bao h cũng là (0 0 0)! Hay là dùng FirstDeriv các bác nhỉ

Kết quả là bao h cũng là (0 0 0)!

=> Thiệt không?

Bạn đã thử lấy biến Point trên phân đoạn cong của 1 Curve chưa?

Đây là kiến thức cơ bản cửa lớp 12. Đề nghị bạn về ôn lại


<<

Filename: 125632_ddd.lsp
Tác giả: hieuhx68
Bài viết gốc: 297129
Tên lệnh: vg
Vẽ vuông góc với 1 Pline bất kì

 

Okie, bài toán đã giải xong, giai đoạn tiếp theo mình muốn vẽ sang trái và sang phải (1 cách tương đối thôi nha)

Dưới đây...

>>

 

Okie, bài toán đã giải xong, giai đoạn tiếp theo mình muốn vẽ sang trái và sang phải (1 cách tương đối thôi nha)

Dưới đây là code mình viết, sai nhoe laugh.gif( các bác chỉ giáo cho với ah

 

(Defun AngP(Pl Pt / Goc P 1st)  (Vl-load-com)  (Setq P    (Vlax-curve-getparamatpoint Pl Pt)	1st  (Vlax-curve-getfirstderiv Pl P)	)  (If (=(Car 1st)0)    (Setq Goc(/ pi 2))    (If (>=(Cadr 1st)0)      (Setq Goc(Atan (/(Cadr 1st)(Car 1st))))      (Setq Goc(+ pi(Atan (/(Cadr 1st)(Car 1st)))))      ))  Goc)(Defun VGT(Pline Point Dist)(Polar Point (+(AngP Pline Point)(* pi 0.5)) Dist))(Defun VGP(Pline Point Dist)(Polar Point (-(AngP Pline Point)(* pi 0.5)) Dist))(Defun c:VG()  (Setq Pline (Car(Entsel "\n Chon Polyline : "))	Point (Getpoint "\n Chon diem tren Polyline : ")	Ag    (AngP Pline Point))  ;(Princ Ag)  (COmmand "LINE" Point (VGT Pline Point 100) "")  (COmmand "LINE" Point (VGP Pline Point 10)  "")  (Princ))

Xin lỗi mọi người em lại đào mộ topic này lên. Nhưng thực tế líp trên của bác Gia_bach quá hay, tiện lợi. Em mong bác bổ sung thêm 1 ứng dụng nữa thì quá tuyệt ạ, bác cho chọn thêm chiều dài của đuờng vuông góc cần vẽ, còn nó nằm về cả 2 bên cũng không sao chỉ cần del nó đi cũng ko vấn đề gì. Em cảm ơn mọi người


<<

Filename: 297129_vg.lsp
Tác giả: Kieu Tan
Bài viết gốc: 378509
Tên lệnh: tkt%C2%A0
cho em xin lisp đếm text

Thử cái này xem:

(defun c:tkt  (/ lst msp pt ss str txtsiz-0 txtsiz doc)

  (vl-load-com)

  (if...

>>

Thử cái này xem:

(defun c:tkt  (/ lst msp pt ss str txtsiz-0 txtsiz doc)

  (vl-load-com)

  (if (setq ss (ssget (list (cons 0 "TEXT"))))

    (progn (foreach e  (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

             (setq str      (vla-get-TextString e)

                   txtsiz-0 (vla-get-height e))

             (if (not (assoc str lst))

               (setq lst (cons (cons str 1) lst))

               (setq lst (subst (cons str (1+ (cdr (assoc str lst)))) (assoc str lst) lst))))

           (or (setq txtsiz (getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos txtsiz-0 2 2) ">: ")))

               (setq txtsiz txtsiz-0))

           (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))

                 pt  (getpoint "\nDiem dat Bang :")

                 doc (vla-get-ActiveDocument (vlax-get-Acad-Object))

                 msp (if (zerop (vla-get-activespace doc))

                       (if (= (vla-get-mspace doc) :vlax-true)

                         (vla-get-modelspace doc)

                         (vla-get-paperspace doc))

                       (vla-get-modelspace doc)))

           (foreach e  lst

             (vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz)

             (vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz)

             (setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))))

    (alert "Khong chon duoc Text."))

  (princ))​

Lsp này ok rồi. thanks bạn quocmanh04tt nhiều lắm


<<

Filename: 378509_tkt%C2%A0.lsp
Tác giả: cd2k44
Bài viết gốc: 202891
Tên lệnh: tdn
Nhờ các cao thủ sửa hộ lisp thống kê tọa độ theo ý muốn

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là...

>>

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là "X=582027.2825 Y=2187655.3823" nhưng mình muốn ghi ra trên bản vẽ là "X=2187655.3823 Y=582027.2825". Bạn xem giúp mình được không.

@ Doan Van Ha: Code của lisp gốc là:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
 	ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq   D1 (getpoint "\nPick diem toa do:"))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint "\nDiem dat text:" D1)
   	x   (rtos (car D1) 2 4)
   	y   (rtos (cadr D1) 2 4)
TX (strcat "X="(rtos (Car D1) 2 4))
TY (strcat "Y="(rtos (Cadr D1) 2 4))
  	tapx (append tapx (list x))
  	tapy (append tapy (list y))
   	k   (+ 1 k)
   	N   (strcat ten (rtos k 2 0))
   	stt (append stt (list N))
 );setq
 (if (>= (car DX) (car D1))
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BL" D2 h 0 tX)
  (setq   TB  (textbox (entget(entlast)))
 	LC  (car TB)
RC  (cadr TB)
 	di  (distance LC RC)
 PT3 (polar D2 0 (+ di (* 0.6 h)))
 pt4 (list (car D2) (- (cadr D2) (* 1.4 h)))
 pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 h)))
 C   (polar PT3 0 (* 1.5 h))
  );setq
  (command "text" "F" PT4 PT5 h ty
			"pline" D1 DX PT3 ""
			"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
			"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
			"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
			"CECOLOR" 8
  "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1))
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))  
(command "text" "BR" D2 h 0 tx)
(setq   TB  (textbox (entget(entlast)))
   	LC  (car TB)
  	RC  (cadr TB)
   	di  (distance LC RC)
PT3 (polar D2 0 (- (+ di (* 0.6 h))))
pt4 (list (- (car D2) di) (- (cadr D2) (* 1.4 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.4 h)))
PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h TY
  			"pline" D1 DX PT3 ""
  			"circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
  			"text" "m" (polar PT6 0 (* 1.5 h)) h 0 N
  			"CECOLOR" 8
"circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
);command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
;=============================================
;tao bang thong ke
 (setq di (- di (* 2 h))
kc (* 2 di)
   	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
  	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
  	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
  	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
 	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 	PTY (list (+ kc (car PTX)) (cadr PTX))
  	p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  	p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  	p33 (list (+ kc (car p22)) (cadr p22))
  	L1 (list (+ di (car p3))(cadr p3))
  	L2 (list (+ kc (car L1))(cadr L1))
PTB (list (+ (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
 	n (length tapx)
 	k 0
);setq
 (setvar "osmode" 0)
 (command "CECOLOR" 3
"line" p1 p2 ""
   	"line" p3 p4 ""
   	"CECOLOR" 2
   	"text" "m" p11 h 0 "STT"
   	"text" "m" p22 h 0 "Täa ®é X"
   	"text" "m" p33 h 0 "Täa ®é Y"
   	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")  
 (while (< k n)
(setq xx (nth k tapx)
 	yy (nth k tapy)
tstt(nth k stt))
(command "CECOLOR" 2
 	"text" "m" PTD h 0 tstt
			"text" "m" PTX h 0 xx
			"text" "m" PTY h 0 yy
 	"CECOLOR" 3
			"line" PT PTC "")  
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
     	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
     	PTY (list (+ kc (car PTX)) (cadr PTX))
     	k (+ 1 k));setq
 );while
 (if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
     	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     	L11 (list (+ di (car PT))(cadr PT))
     	L22 (list (+ kc (car L11))(cadr L11))
);setq
  );if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

Bạn xem giúp mình với. Cám ơn nhiều.

đoạn code lấy tọa độ điểm của bạn chính là đoạn mình ghi ở trên.Theo lisp của bác Thai thì nó lấy x, y như vậy, khi bạn đổi vị trí này thì kết quả sẽ như bạn muốn


<<

Filename: 202891_tdn.lsp
Tác giả: Danh Cong
Bài viết gốc: 427288
Tên lệnh: test
Xin hỗ trợ về việc lên cao độ mặt ga cho mạng lướt thoát nước
14 giờ trước, đình phán đã nói:

da, em cảm...

>>
14 giờ trước, đình phán đã nói:

da, em cảm ơn.

như đã giải thích thì 0.6m là đường kính cống, 0.3m là chiều sâu đáy ga thu cặn nên sẽ thay đổi tùy chọn. 

 

Dùng thử cái này:



(defun c:test ( / DAYHG DINHHG DIS DIS1 DIS2 DUONGDO DXF1 PT1 PT11 PT2 PT22 OLDOS)
      (princ "Produc by: Danh Cong - 01636 760 750")
      (setq oldos (getvar "osmode"))
  
    (or     docdoc (setq docdoc 0.02))
    (setq     docdoc (cond ((getreal (strcat "\nNhap do doc Trac Doc: <" (rtos docdoc 2 2) ">:")))(docdoc)))

      (or     docngang (setq docngang 0.02))
    (setq     docngang (cond ((getreal (strcat "\nNhap do doc Trac Ngang: < " (rtos docngang 2 2) " >:")))(docngang)))

      (or     kctracngang (setq kctracngang 3))
    (setq     kctracngang (cond ((getreal (strcat "\nNhap k/c Trac Ngang: < " (rtos kctracngang 2 2) " >:")))(kctracngang)))


      (setq duongdo (car (entsel "\nPick Pline:"))
          pt1 (getpoint "\nPick toa do tim duong:")
          pt11 (vlax-curve-getClosestPointTo duongdo pt1)
          dis1 (vlax-curve-getDistAtPoint duongdo pt11))
  
      (or     caodotim (setq caodotim 10))
    (setq     caodotim (cond ((getreal (strcat "\nNhap Cao do tim duong: < " (rtos caodotim 2 2) " >:")))(caodotim)))

      (setq dxf1 (entget (car (entsel "\nChon text mau: "))))

      (while     (setq pt2 (getpoint "\nPick toa do Ho ga:"))
          (progn

              (setq pt22 (vlax-curve-getClosestPointTo duongdo pt2)
                  dis2 (vlax-curve-getDistAtPoint duongdo pt22)
                  dis (abs (- dis1 dis2)))
              (setq DinhHG (- caodotim (* docdoc dis) (* docngang kctracngang))
                  
    ;;;;;;;; Nhap gia tri tinh tu dinh Ho Ga Vao cong thuc ben duoi !!!!
                  DayHG  (- DinhHG 0.7 0.6 0.3)) 
              (setvar "osmode" 0)
              (entmake
                (list
                  (cons 0 "Text")
                  (cons 1 (rtos DinhHG 2 2))
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbText")
                  (assoc 8 dxf1)
                  (assoc 7 dxf1)
                  (cons 10 pt2)
                  (cons 11 pt2)
                  (assoc 40 dxf1)
                  (assoc 50 dxf1)
                  (assoc 71 dxf1)
                  (assoc 72 dxf1)
                  (cons  73 1)
                  ))
          
              (entmake
                (list
                  (cons 0 "Text")
                  (cons 1 (rtos DayHG 2 2))
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbText")
                  (assoc 8 dxf1)
                  (assoc 7 dxf1)
                  (cons 10 pt2)
                  (cons 11 pt2)
                  (assoc 40 dxf1)
                  (assoc 50 dxf1)
                  (assoc 71 dxf1)
                  (assoc 72 dxf1)
                  (cons  73 3)
                  ))              
              (setvar "osmode" oldos)
          ); End Progn
      );end While
     (princ))


<<

Filename: 427288_test.lsp
Tác giả: Danh Cong
Bài viết gốc: 403672
Tên lệnh: tt%C2%A0
Nhờ Mọi Người Sửa Hộ Lisp Leader.

 

Điểm C chỉ là để lấy khoảng cách và góc hợp giữa đoạn thẳng nối A-C với khúc đầu của leader. Hướng rải...

>>

 

Điểm C chỉ là để lấy khoảng cách và góc hợp giữa đoạn thẳng nối A-C với khúc đầu của leader. Hướng rải luôn theo hướng mũi tên leader, nếu góc ở trên < 90 thì rải giật lùi và ngược lại.

(defun c:tt  (/ ang apt dis ele ent i lea len lsc lsm lsp pt pt1 pt2)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
          (setq ent (ssname ele 0)
                lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                lsc (vlax-get-property (vlax-ename->vla-object ent) 'ScaleFactor))
          (setq pt1 (cdr (car lsp)))
          (setq dis (getdist "\nKhoang cach giua cac Leader: " pt1))
          (setq pt2 (getpoint "\nDiem ket thuc: " pt1)))
  (progn (setq lsm (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10 330 340))) (entget ent))
               ang (angle pt1 (cdr (cadr lsp)))
               len (distance pt1 pt2)
               i   0)
         (setq apt (angle pt1 pt2))
         (if (or (< (- apt ang) (* 0.5 pi)) (> (- apt ang) (* 1.5 pi)))
          (setq ang ang)
          (setq ang (+ ang pi)))
         (repeat (fix (/ len dis))
          (setq pt (polar pt1 ang (* dis (setq i (1+ i)))))
          (setq lea (entmakex (append lsm (subst (cons 10 pt) (assoc 10 lsp) lsp))))
          (vlax-put-property (vlax-ename->vla-object lea) 'ScaleFactor lsc))))
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ))

 

Em thử nghiệm và đạt kết quả cao :))) Nhưng đoc lisp của bác mà em chưa hiểu gì hết. 

Chắc tại trình độ mình còn kém quá, còn phải học dài dài.....


<<

Filename: 403672_tt%C2%A0.lsp
Tác giả: Tue_NV
Bài viết gốc: 238957
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:

>>

 

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

Chào bạn hiepttr!

Bạn viết dựa trên (command ".mocoro".....)

Tuy nhiên, với mocoro thì khi copy đối tượng có thể hiện được "hình ảnh động" của đối tượng mới sinh. Còn bạn viết lại như thế thì vô tình bỏ mất "hình ảnh động" khi copy rồi.

 

@Chiron: Lisp bạn viết ở bài #6 ok, có điều không có dòng nhắc chi hết trơn.......

 

@cd2k44: Bạn đã sử dụng hàm (ssget) để chọn đối tượng rồi thì không nên sử dụng tuỳ chọn "P"  của select object để chọn đối tượng. Vì lỡ nếu khi không chọn được đối tượng nào thì Lisp hiểu "p" là đối tượng trước đó thì không đúng nữa. Bên cạnh đó, chú ý thêm góp ý của Ketxu "Copy xong, move "p" thì không phải tập mới sinh"


<<

Filename: 238957_cr.lsp
Tác giả: qh2qa06
Bài viết gốc: 316633
Tên lệnh: cca
tính chênh cao cho mắt lưới

 

Bạn dùng cái này. Nó chỉ hỏi 1 lần thôi.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
 ...
>>

 

Bạn dùng cái này. Nó chỉ hỏi 1 lần thôi.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
   (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (if (not laylist)
    (setq laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do thiet ke :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do tu nhien :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Chenh cao :"))) laylist)
    )
  )      
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" (list '(0 . "TEXT") (cons 8 (strcat (car laylist)"," (cadr laylist) "," (last laylist))))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (last laylist))) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (cadr laylist))) ss)
sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (car laylist))) ss))
(while sstk
 (setq v (car sstk)
       sstk (cdr sstk)
       cdtk (atof (dxf 1 v))
       tm (gan v sstn)
       cc (gan v sscc))
 (if (and tm cc)
    (setq cdtn (atof (dxf 1 tm))
 sstn (vl-remove tm sstn)
 sscc (vl-remove cc sscc)
 tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
  )
 )
)
(princ)
)

Em cảm ơn anh!


<<

Filename: 316633_cca.lsp
Tác giả: hoquangvinh
Bài viết gốc: 374298
Tên lệnh: acs
Lisp Xoay Viewport tùy ý

Bạn xem lại dòng này: AB trùng AC ==> view đc xoay 1 góc BAC ==> góc quay luôn dương (??). Mình viết theo kiểu Align space của cad:

>>

Bạn xem lại dòng này: AB trùng AC ==> view đc xoay 1 góc BAC ==> góc quay luôn dương (??). Mình viết theo kiểu Align space của cad:

(defun c:ACS(/ p1 p2 p3 goc vs)
  (setq p1 (getpoint "\nChon Tam")
p2 (getpoint p1 "\nChon Phuong hien tai")
p3 (getpoint p1 "\nChon Phuong moi")
goc (-(angle p3 p1)(angle p2 p1))
vs (getvar "viewsize")
p1 (trans p1 1 0))
  (command "ucs" "z" (/(* 180 goc)pi) "")
  (command "plan" "")
  (command "zoom" "c" (trans p1 0 1) vs)
  (princ)
  )
P/s Có bác lo cho topic này em sướng rồi , cảm ơn bác nhiều bạn mà viết như thế này là đã bỏ qua biết bao ý kiến của nhiều bác khác trong diễn đàn, mà cách giải quyết của họ có thể nhanh gọn và hay hơn của mình gấp nhiều lần. Bạn rút kinh nghiệm nhá!

 

đúng là hôm nay mới thấy cái này hay hơn hẳn mấy cái mặc định ucs và mvsetup của cad nhưng bác có thể phát triển nó lên nữa ko ạ

em có biết cad 2014 nó quay viewport bằng lệnh ro luôn, đời của nó cao quá mà máy thì hơi cùi nên ko theo được

lisp mình có thể làm được tương tự như vậy không ạ


<<

Filename: 374298_acs.lsp
Tác giả: tungquach165
Bài viết gốc: 268168
Tên lệnh: ciso cuniso
Ẩn hiện đối tượng theo màu

Tí quên ^^ Của bạn đây. Mình quick code iso 1 màu thôi nhé :)  1 cái CISO và 1 cái CUNISO

(defun get_col(e)(setq e...
>>

Tí quên ^^ Của bạn đây. Mình quick code iso 1 màu thôi nhé :)  1 cái CISO và 1 cái CUNISO

(defun get_col(e)(setq e (entget e))(cdr (cond ((assoc 62 e))((assoc 62 (tblsearch "layer"  (cdr (assoc 8 e))))))))
(defun C:ciso(/ e col s o)
	(while (not (setq e (nentsel "\nSelect object :"))))
	(cond
		(
			(and
				(setq col (get_col  (car e)))
				(setq s (ssget "X") i -1)
			)
			(while (setq o (ssname s (setq i (1+ i))))
				(if (/= (get_col o) col)(entmod (append (entget o) (list (cons 60 1)))))
			)
		)
	)
	(princ)
)
(defun c:cuniso(/ s o)
(setq s (ssget "_X" '((60 . 1))))
(or
	(and acet-ss-visible (acet-ss-visible s 0))
	(while (setq o (ssname s (setq i (1+ i))))(entmod (append (entget o) (list (cons 60 0)))))
)

(prompt (strcat "Hi\U+1EC7n l\U+1EA1i c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+00E3 b\U+1ECB \U+1EA9n :" (vl-princ-to-string (sslength s))))
(princ)
)
			

em chạy sao nó nặng thế bác, nó thực hiện lệnh lâu lắm bác, đơ 1 lúc rồi đc@@!


<<

Filename: 268168_ciso_cuniso.lsp

Trang 270/330

270