Jump to content
InfoFile
Tác giả: hieuhx68
Bài viết gốc: 297171
Tên lệnh: vg
Lips cắt nhanh hàng đường thẳng

Vậy dùng thử cái này.

 

Em tham lam nhờ bác giúp luôn em vụ này với ạ.

 

http://www.cadviet.com/forum/topic/31600-ve-vuong-goc-voi-1-pline-bat-ki/

 

lips...

>>

Vậy dùng thử cái này.

 

Em tham lam nhờ bác giúp luôn em vụ này với ạ.

 

http://www.cadviet.com/forum/topic/31600-ve-vuong-goc-voi-1-pline-bat-ki/

 

lips của bác Gia_Bach

 

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

 

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: 297171_vg.lsp
Tác giả: Tot77
Bài viết gốc: 297189
Tên lệnh: vg
[yêu cầu] Lips cắt nhanh hàng đường thẳng

Của bạn đây.

(defun c:Vg (/ curve pt dai ang)
  (if (setq curve (car (entsel "\nChon Curve : "))
   pt (getpoint "\nChon diem tren Curve : ")
   dai (getreal "\nChieu dai line: ")) 
 
    (progn (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))...
>>

Của bạn đây.

(defun c:Vg (/ curve pt dai ang)
  (if (setq curve (car (entsel "\nChon Curve : "))
   pt (getpoint "\nChon diem tren Curve : ")
   dai (getreal "\nChieu dai line: ")) 
 
    (progn (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)) dai))  (cons 62 3)))
  (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 (polar pt (- ang (/ pi 2)) dai))  (cons 62 4)))
    )
  )
  (princ)
)

<<

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

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

>>

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

Update theo yêu cầu :

(defun c:Vg (/ curve pt ang )
  (if (setq curve (car (entsel "\nChon Curve : ")))
    (progn
      (or *len (setq *len 50))
      (initget 6)
      (setq *len (cond ((getdist (strcat "\nChieu dai <" (rtos *len) "> :"))) (*len)))
      (while (setq pt (getpoint "\n Chon diem tren Curve : "))
	(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) ) *len))(cons 62 3) ))
	(entmake (list '(0 . "LINE")(cons 10 pt)(cons 11 (polar pt (- ang (/ pi 2) ) *len))(cons 62 4) )) )))
  (princ) )

<<

Filename: 297187_vg.lsp
Tác giả: Tot77
Bài viết gốc: 297282
Tên lệnh: cpy
Lisp copy nhanh đối tượng theo nhiều khoảng cách

Bạn dùng cái này. Sau khi copy xong nếu bạn dùng lệnh khác mà có select objects thì có thể đánh chữ "P" để lấy các đối tượng cuối cùng.

(defun c:cpy(/ ss pt hg os el en)
  (prompt "\nChon cac doi tuong de copy:")
  (setq ss (ssget) 
pt (getpoint "\nDiem goc:")
hg (getangle pt "\nTheo huong:")
os (getvar 'osmode))
  (setvar 'osmode 0)
  (while (setq kc (getreal "\nKhoang cach:"))
    (setq el...
>>

Bạn dùng cái này. Sau khi copy xong nếu bạn dùng lệnh khác mà có select objects thì có thể đánh chữ "P" để lấy các đối tượng cuối cùng.

(defun c:cpy(/ ss pt hg os el en)
  (prompt "\nChon cac doi tuong de copy:")
  (setq ss (ssget) 
pt (getpoint "\nDiem goc:")
hg (getangle pt "\nTheo huong:")
os (getvar 'osmode))
  (setvar 'osmode 0)
  (while (setq kc (getreal "\nKhoang cach:"))
    (setq el (entlast))
    (command "copy" ss "" pt (polar pt hg kc))
    (setq ss (ssadd))
    (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
  ) 
  (command "select" ss "")
  (setvar 'osmode os) (princ)
)

<<

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

Lisp trên là theo yêu cầu của hoacomay70 cho nên nó vẽ (chứ không phải copy) đường vuông góc, do đó chỉ chọn 1 line để lấy điểm đầu, và nhập số cọc rải để hạn chế số lần rải, nếu không sẽ rải tới cuối đường pline.

Còn nếu bạn chọn nhiều đt tức là bạn muốn copy, rải và xoay theo hướng vuông góc với pline thì dùng cái lisp dưới đây.

>>

Lisp trên là theo yêu cầu của hoacomay70 cho nên nó vẽ (chứ không phải copy) đường vuông góc, do đó chỉ chọn 1 line để lấy điểm đầu, và nhập số cọc rải để hạn chế số lần rải, nếu không sẽ rải tới cuối đường pline.

Còn nếu bạn chọn nhiều đt tức là bạn muốn copy, rải và xoay theo hướng vuông góc với pline thì dùng cái lisp dưới đây.

(defun c:test(/ cd pl obj dd dait cl sl n os ki )  
  (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:")
sl (fix (/ (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)) cd))
        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 (+ cd (vlax-curve-getDistAtPoint pl dd)))))
   (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)
)

<<

Filename: 297394_test.lsp
Tác giả: mrphuocvie
Bài viết gốc: 297476
Tên lệnh: od
Cải tiến lệnh OD!

Sorry, em quên!

Em download theo link này: http://www.cadviet.com/forum/topic/34029-can-lisp-danh-so-thu-tu-theo-dang-block-att/

Theo lời của anh ketxu: "Bạn dùng thử lisp của bác ssg viết cách đây...3 năm", em xin trích lại 1 đoạn thôi....

>>

Sorry, em quên!

Em download theo link này: http://www.cadviet.com/forum/topic/34029-can-lisp-danh-so-thu-tu-theo-dang-block-att/

Theo lời của anh ketxu: "Bạn dùng thử lisp của bác ssg viết cách đây...3 năm", em xin trích lại 1 đoạn thôi. Mong anh đừng buồn nhé!

Em đọc đoạn ghi chú trong lisp song em vẫn muốn tách rời thành 3 phần(tiền tố - phần thay đổi tự động - hậu tố) cho tiện trong việc nhập text.

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************
;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(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 incN (n dn / n2 i n1) ;;;Increase number n
(setq
    n2 (itoa (+ dn (atoi n)))
    i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
    (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
    (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
    cn (getstring "\nBegin at <1>: " T)
    dn (getint "\nIncrement <1>: ")
	be (getstring "\nBefore text:"); mrphuocvie mong muon them vao
	af (getstring "\nAfter text:"); mrphuocvie mong muon them vao
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
    (wtxt cn p)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
)
(princ)
)

<<

Filename: 297476_od.lsp
Tác giả: Tot77
Bài viết gốc: 297583
Tên lệnh: cat
Lisp trim đối tượng

Bạn dùng thử cái này. Cần lưu ý:

1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.

2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.

3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.

Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán"...

>>

Bạn dùng thử cái này. Cần lưu ý:

1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.

2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.

3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.

Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).

(defun c:cat()
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun midp(d1 d2)  (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
(defun gan(pt v) (if (< (distance (dxf 10 v) pt) (distance (dxf 11 v) pt)) (dxf 10 v) (dxf 11 v)))
 
(defun cdd(v1 v2)
(or (equal (angle (dxf 10 v1) (dxf 11 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001)
(equal (angle (dxf 11 v1) (dxf 10 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001))
)
 
(defun trim(v l / ll)
(if (setq ll (mapcar '(lambda(x) (inters (dxf 10 v) (dxf 11 v) (dxf 10 x) (dxf 11 x) nil)) l))      
(command "trim" (acet-list-to-ss l) "" (list v (midp (car ll) (last ll))) "")
nil)
)
 
(defun cat(l1 l2)
(cond ((and (= (length l1) 1) (= (length l2) 1))    
(setq phia (getpoint "\nPhia bi cat:"))
(command "trim" (acet-list-to-ss l2) "" (list (car l1) (gan phia (car l1))) "")
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) ""))
 
((and (= (length l1) 1) (= (length l2) 2))    
(setq phia (getpoint "\nPhia bi cat:")) (trim (car l1) l2)     
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) "")
(command "trim" (acet-list-to-ss l1) "" (list (last l2) (gan phia (last l2))) ""))
 
((and (= (length l1) 2) (= (length l2) 2)) 
(trim (car l1) l2) (trim (last l1) l2) 
(trim (car l2) l1) (trim (last l2) l1))
)
)
;;;
(setvar 'edgemode 1)
(command "undo" "be")
(setq ss (acet-ss-to-list (ssget '((0 . "LINE"))))
ss1 nil
os (getvar 'osmode))
(setvar 'osmode 0)
(while ss
(setq ss1 (if (setq tm (vl-remove-if-not '(lambda(x) (cdd (car ss) x)) ss))
(cons tm ss1) (cons (list (car ss)) ss1))
ss  (vl-remove-if '(lambda(x) (cdd (car ss) x)) ss))
)
(setq ss1 (vl-sort ss1 '(lambda(x y) (< (length x) (length y)))))
(cat (car ss1) (last ss1))
(command "undo" "e")
(setvar 'osmode os) (princ)
)

<<

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

Bạn thử cái dưới đây, nếu không muốn nhập khoảng cách rải thì enter để nhập số khoảng rải.

Bạn có thể chọn bất cứ đối tượng nào kể cả text, block... Nhưng chú ý đến góc ban đầu của nó với điểm đầu, các bản sao kế tiếp cũng có góc tương tự so với điểm copy.

(defun c:test(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt /...
>>

Bạn thử cái dưới đây, nếu không muốn nhập khoảng cách rải thì enter để nhập số khoảng rải.

Bạn có thể chọn bất cứ đối tượng nào kể cả text, block... Nhưng chú ý đến góc ban đầu của nó với điểm đầu, các bản sao kế tiếp cũng có góc tương tự so với điểm copy.

(defun c:test(/ 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 (not cd)
    (setq sl (getint "\nNhap so khoang rai:")
 cd (/ tm sl))
    (setq sl (fix (/ 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 (+ cd (vlax-curve-getDistAtPoint pl dd)))))
   (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)
)

<<

Filename: 297510_test.lsp
Tác giả: Tot77
Bài viết gốc: 297588
Tên lệnh: cat
Lisp trim đối tượng

Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:

Bạn dùng thử cái này. Cần lưu ý:

1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.

2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.

3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.

Sở dĩ phải...

>>
Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:

Bạn dùng thử cái này. Cần lưu ý:

1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.

2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.

3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.

Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).

(defun c:cat()
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun midp(d1 d2)  (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
(defun gan(pt v) (inters (dxf 10 v) (dxf 11 v) pt (polar pt (+ 1.5708 (angle (dxf 10 v) (dxf 11 v))) 1) nil))
 
(defun cdd(v1 v2)
(or (equal (angle (dxf 10 v1) (dxf 11 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001)
(equal (angle (dxf 11 v1) (dxf 10 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001))
)
 
(defun trim(v l / ll)
(if (setq ll (mapcar '(lambda(x) (inters (dxf 10 v) (dxf 11 v) (dxf 10 x) (dxf 11 x) nil)) l))      
(command "trim" (acet-list-to-ss l) "" (list v (midp (car ll) (last ll))) "")
nil)
)
 
(defun cat(l1 l2)
(cond ((and (= (length l1) 1) (= (length l2) 1))    
(setq phia (getpoint "\nPhia bi cat:"))
(command "trim" (acet-list-to-ss l2) "" (list (car l1) (gan phia (car l1))) "")
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) ""))
 
((and (= (length l1) 1) (= (length l2) 2))    
(setq phia (getpoint "\nPhia bi cat:")) (trim (car l1) l2)     
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) "")
(command "trim" (acet-list-to-ss l1) "" (list (last l2) (gan phia (last l2))) ""))
 
((and (= (length l1) 2) (= (length l2) 2)) 
(trim (car l1) l2) (trim (last l1) l2) 
(trim (car l2) l1) (trim (last l2) l1))
)
)
;;;
(setvar 'edgemode 1)
(command "undo" "be")
(setq ss (acet-ss-to-list (ssget '((0 . "LINE"))))
ss1 nil
os (getvar 'osmode))
(setvar 'osmode 0)
(while ss
(setq ss1 (if (setq tm (vl-remove-if-not '(lambda(x) (cdd (car ss) x)) ss))
(cons tm ss1) (cons (list (car ss)) ss1))
ss  (vl-remove-if '(lambda(x) (cdd (car ss) x)) ss))
)
(setq ss1 (vl-sort ss1 '(lambda(x y) (< (length x) (length y)))))
(cat (car ss1) (last ss1))
(command "undo" "e")
(setvar 'osmode os) (princ)
)
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
 
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).

<<

Filename: 297588_cat.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 297793
Tên lệnh: %60cr1 %60cr2
Tư vấn hiệu chỉnh giúp đoạn lisp về lệnh COPY!

Cũng không có Cad2015, nhưng độ là vầy:

(defun C:`CR1( / ss p1 p2 nb)
 (setq ss (ssget))
 (setq p1 (getpoint "\nPick first point!"))
 (setq p2 (getpoint "\nPick second point!"))
 (setq nb (getint "\nInput number <10>:"))
 (if (not nb) (setq nb 10))
 (command "copy" ss "" p1 "a" nb "f" p2 ""))
(defun C:`CR2( / ss p1 p2 dt nb)
 (setq ss (ssget))
 (setq p1...
>>

Cũng không có Cad2015, nhưng độ là vầy:

(defun C:`CR1( / ss p1 p2 nb)
 (setq ss (ssget))
 (setq p1 (getpoint "\nPick first point!"))
 (setq p2 (getpoint "\nPick second point!"))
 (setq nb (getint "\nInput number <10>:"))
 (if (not nb) (setq nb 10))
 (command "copy" ss "" p1 "a" nb "f" p2 ""))
(defun C:`CR2( / ss p1 p2 dt nb)
 (setq ss (ssget))
 (setq p1 (getpoint "\nPick first point!"))
 (setq p2 (getpoint "\nPick second point!"))
 (setq dt (getreal "\nInput distance <100>:"))
 (if (not dt) (setq dt 100))
 (setq nb (+ (fix (/ (distance p1 p2) dt)) 1))
 (command "copy" ss "" p1 "a"  nb p2 ""))
 


<<

Filename: 297793_%60cr1_%60cr2.lsp
Tác giả: Tot77
Bài viết gốc: 297843
Tên lệnh: tmp
Lips move line; pline; vuông góc với line hay pline có sẵn

Bạn thử cái này xem sao.

(defun c:tmp()
(defun dxf (id v) (cdr (assoc id (entget v))))
(defun getNear(v ent)
(setq tm (vl-sort (list (vlax-curve-getStartPoint v) (vlax-curve-getEndPoint v))
'(lambda(x y) (< (distance x (vlax-curve-getClosestPointTo ent x))
(distance y (vlax-curve-getClosestPointTo ent y)))))
tm1 (vlax-curve-getClosestPointTo ent (car tm)))
)
(defun thgoc (ent pt / param)
(if (setq param (vlax-curve-getParamAtPoint...
>>

Bạn thử cái này xem sao.

(defun c:tmp()
(defun dxf (id v) (cdr (assoc id (entget v))))
(defun getNear(v ent)
(setq tm (vl-sort (list (vlax-curve-getStartPoint v) (vlax-curve-getEndPoint v))
'(lambda(x y) (< (distance x (vlax-curve-getClosestPointTo ent x))
(distance y (vlax-curve-getClosestPointTo ent y)))))
tm1 (vlax-curve-getClosestPointTo ent (car tm)))
)
(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)
)
(defun laydinh(v / n L node)
(setq v (vlax-ename->vla-object v)
n -1 L nil)
(vl-catch-all-error-p (vl-catch-all-apply '(lambda() 
(while (setq node (vla-get-Coordinate v (setq n (1+ n)))) 
(setq L (append L (list (vlax-safearray->list (vlax-variant-value node)))))))))
L
)
 
;;;
(vl-load-com)
(command "undo" "be")
(setq ent (car (entsel "\nChon duong dan:"))
os (getvar 'osmode))
(setvar 'osmode 0)
(prompt "\nChon doi tuong can move:")  
(mapcar '(lambda(x) 
(cond ((= "LINE" (dxf 0 x)) (getNear x ent)
(command "move" x "" (car tm) tm1)
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (angle (car tm) (last tm)) 1) (polar tm1 (thgoc ent tm1) 1)))
 
((vl-string-search "LINE" (dxf 0 x)) (getNear x ent)    
(setq tm2 (if (equal (car tm) (car (setq tm3 (laydinh x))) 0.1) (nth 1 tm3) (nth (- (length tm3) 2) tm3)))
(command "move" x "" (car tm) tm1)
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (angle (car tm) tm2) 1)
(polar tm1 (thgoc ent tm1) 1)))
 
((vl-string-search "TEXT" (dxf 0 x)) 
(command "move" x "" (dxf 10 x) (setq tm1 (vlax-curve-getClosestPointTo ent (dxf 10 x))))    
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (dxf 50 x) 1) (polar tm1 (thgoc ent tm1) 1)))
 
)) (acet-ss-to-list (ssget '((0 . "*LINE,*TEXT"))))
)
(command "undo" "e") (setvar 'osmode os) (princ)
)

<<

Filename: 297843_tmp.lsp
Tác giả: Tot77
Bài viết gốc: 297873
Tên lệnh: %60cr1 %60cr2
Tư vấn hiệu chỉnh giúp đoạn lisp về lệnh COPY!

Viết lại cái của bạn.

(defun C:`CR1()  
  (setq ss (ssget))
  (setq p1 (getpoint "\nPick first point!"))
  (setq p2 (getpoint p1 "\nPick second point!"))
  
  (if (not nb) (setq nb 10))
  (setq nb1 (getint (strcat "\nInput number <" (itoa nb) ">:"))) 
  (if nb1 (setq nb nb1))
  
  (setq dt (/ (distance p1 p2) nb 1.0)
os (getvar 'osmode)
n 0)
  (setvar 'osmode 0)
  (repeat nb (command "copy" ss "" p1 (polar p1...
>>

Viết lại cái của bạn.

(defun C:`CR1()  
  (setq ss (ssget))
  (setq p1 (getpoint "\nPick first point!"))
  (setq p2 (getpoint p1 "\nPick second point!"))
  
  (if (not nb) (setq nb 10))
  (setq nb1 (getint (strcat "\nInput number <" (itoa nb) ">:"))) 
  (if nb1 (setq nb nb1))
  
  (setq dt (/ (distance p1 p2) nb 1.0)
os (getvar 'osmode)
n 0)
  (setvar 'osmode 0)
  (repeat nb (command "copy" ss "" p1 (polar p1 (angle p1 p2) (* (setq n (1+ n)) dt))))
  (setvar 'osmode os)
  
)
 
(defun C:`CR2()
  (setq ss (ssget))
  (setq p1 (getpoint "\nPick first point!"))
  (setq p2 (getpoint p1 "\nPick second point!"))
  
  (if (not dt) (setq dt 100))
  (setq dt1 (getreal (strcat "\nInput distance <" (rtos dt) ">:")))
  (if dt1 (setq dt dt1))
    
  (setq nb (fix (/ (distance p1 p2) dt))
os (getvar 'osmode)
n 0)
  (setvar 'osmode 0)
  (repeat nb (command "copy" ss "" p1 (polar p1 (angle p1 p2) (* (setq n (1+ n)) dt))))
  (setvar 'osmode os)
)
 

<<

Filename: 297873_%60cr1_%60cr2.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 297893
Tên lệnh: ha
Nhờ viết lisp tính diện tích ...

Đây!

(defun C:HA( / ent1 ent2 dt1 dt2 obj2)
 (while
  (and
   (setq ent1 (car (entsel "\nChon doi tuong can tinh dien tich: ")))
   (setq ent2 (car (entsel "\nChon text can hieu chinh gia tri: "))))
  (setq dt1 (vla-get-Area (vlax-ename->vla-object ent1)))
  (setq dt2 (atof (vla-get-textstring (setq obj2 (vlax-ename->vla-object ent2)))))
  (vla-put-textstring obj2 (rtos (- dt2 dt1)...
>>

Đây!

(defun C:HA( / ent1 ent2 dt1 dt2 obj2)
 (while
  (and
   (setq ent1 (car (entsel "\nChon doi tuong can tinh dien tich: ")))
   (setq ent2 (car (entsel "\nChon text can hieu chinh gia tri: "))))
  (setq dt1 (vla-get-Area (vlax-ename->vla-object ent1)))
  (setq dt2 (atof (vla-get-textstring (setq obj2 (vlax-ename->vla-object ent2)))))
  (vla-put-textstring obj2 (rtos (- dt2 dt1) 2))))
 


<<

Filename: 297893_ha.lsp
Tác giả: Tot77
Bài viết gốc: 297915
Tên lệnh: tmp
[yêu cầu] Lips move line; pline; vuông góc với line hay pline có sẵn

Sửa lại. Không thấy bạn test với text thế nào?

(defun c:tmp()
(defun dxf (id v) (cdr (assoc id (entget v))))
(defun getNear(v ent)
(setq tm (vl-sort (list (vlax-curve-getStartPoint v) (vlax-curve-getEndPoint v))
'(lambda(x y) (< (distance x (vlax-curve-getClosestPointTo ent x))
(distance y (vlax-curve-getClosestPointTo ent y)))))
tm1 (vlax-curve-getClosestPointTo ent (car tm)))
)
 
(defun thgoc (ent pt / param)
(if (setq...
>>

Sửa lại. Không thấy bạn test với text thế nào?

(defun c:tmp()
(defun dxf (id v) (cdr (assoc id (entget v))))
(defun getNear(v ent)
(setq tm (vl-sort (list (vlax-curve-getStartPoint v) (vlax-curve-getEndPoint v))
'(lambda(x y) (< (distance x (vlax-curve-getClosestPointTo ent x))
(distance y (vlax-curve-getClosestPointTo ent y)))))
tm1 (vlax-curve-getClosestPointTo ent (car tm)))
)
 
(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)
)
(defun laydinh(v / n L node)
(setq v (vlax-ename->vla-object v)
n -1 L nil)
(vl-catch-all-error-p (vl-catch-all-apply '(lambda() 
(while (setq node (vla-get-Coordinate v (setq n (1+ n)))) 
(setq L (append L (list (vlax-safearray->list (vlax-variant-value node)))))))))
L
)
 
;;;
(vl-load-com)
(command "undo" "be")
(setq ent (car (entsel "\nChon duong dan:"))
os (getvar 'osmode))
(setvar 'osmode 0)
(prompt "\nChon doi tuong can move:")  
(mapcar '(lambda(x)
(cond ((= "LINE" (dxf 0 x)) (getNear x ent)
(command "move" x "" (car tm) tm1)
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (angle (car tm) (last tm)) 1) (polar tm1 (thgoc ent tm1) 1)))
 
((vl-string-search "LINE" (dxf 0 x)) (getNear x ent) 
(command "move" x "" (car tm) tm1)
(setq tm2 (if (< (distance tm1 (car (setq tm3 (laydinh x)))) 0.1) (nth 1 tm3) (nth (- (length tm3) 2) tm3)))
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (angle tm1 tm2) 1)
(polar tm1 (thgoc ent tm1) 1)))
 
((vl-string-search "TEXT" (dxf 0 x))
(command "move" x "" (dxf 10 x) (setq tm1 (vlax-curve-getClosestPointTo ent (dxf 10 x))))
(command "rotate" x "" tm1 "r" tm1 (polar tm1 (dxf 50 x) 1) (polar tm1 (thgoc ent tm1) 1)))
 
)) (acet-ss-to-list (ssget '((0 . "*LINE,*TEXT"))))
)
(command "undo" "e") (setvar 'osmode os) (princ)
)

<<

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

Bác ơi. em chỉ có thể nói một câu nữa. Là quá tuyệt vời bác ạ. Em nghĩ không thể làm tốt hơn được nữa. Em chân thành cảm ơn bác.

 

PS: bác ơi bác giúp em thêm lựa chọn cho phép rải cả block vào lips ##66 của bác Pham quoc Duy được không ạ? em chờ đợi

mà ko thấy...

>>

Bác ơi. em chỉ có thể nói một câu nữa. Là quá tuyệt vời bác ạ. Em nghĩ không thể làm tốt hơn được nữa. Em chân thành cảm ơn bác.

 

PS: bác ơi bác giúp em thêm lựa chọn cho phép rải cả block vào lips ##66 của bác Pham quoc Duy được không ạ? em chờ đợi

mà ko thấy mọi người trả lời.

http://www.cadviet.com/forum/topic/42771-da-xong-lisp-rai-doi-tuong-theo-doong-dan/page-4

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

<<

Filename: 297946_rvx_tmp.lsp
Tác giả: sonhaxatac
Bài viết gốc: 297998
Tên lệnh: n
Nhờ viết lisp tính diện tích ...

Đây!

thank bác nhưng bác sửa cho e phần tính diện tích bằng cách pick vào vùng cần tính diện tích như lisp này được không ạ, phần tính diện tích của bác chỉ tính diện tích được 1 vùng, không linh hoạt lắm 

(defun c:N()
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing...
>>

Đây!

thank bác nhưng bác sửa cho e phần tính diện tích bằng cách pick vào vùng cần tính diện tích như lisp này được không ạ, phần tính diện tích của bác chỉ tính diện tích được 1 vùng, không linh hoạt lắm 

(defun c:N()
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
    (setq ntl (/ 100 tl))
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (setq dtl (/ dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 2)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun


<<

Filename: 297998_n.lsp
Tác giả: Tot77
Bài viết gốc: 298107
Tên lệnh: 4
Lisp tính cao độ

Có phải là như vầy không?

(defun C:4 (/ L te p1 p2)
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(while (setq p2 (getpoint p1 "\n Chon diem thu hai :"))
(setq L (distance p1 p2))
(setq te (entget (car (entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)    
(princ)
)

Filename: 298107_4.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 298092
Tên lệnh: ha
lisp chuyển region sang pline!!

Lisp chuyển các đối tượng thành Region, sau đó chuyển Region về Pline.

; Doan Van Ha - CadViet.com - Ngay 14/6/2014
; Lisp: chuyen cac doi tuong thanh Region, sao do chuyen qua Pline.
(defun C:HA( / ssnho sslon ss i ent objArr)
 (vl-load-com) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "undo" "be")
 (setq ssnho (ssget "_X" '((0 . "REGION"))))
 (princ "\nChon cac doi tuong muon chuyen...
>>

Lisp chuyển các đối tượng thành Region, sau đó chuyển Region về Pline.

; Doan Van Ha - CadViet.com - Ngay 14/6/2014
; Lisp: chuyen cac doi tuong thanh Region, sao do chuyen qua Pline.
(defun C:HA( / ssnho sslon ss i ent objArr)
 (vl-load-com) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "undo" "be")
 (setq ssnho (ssget "_X" '((0 . "REGION"))))
 (princ "\nChon cac doi tuong muon chuyen thanh Region...")
 (command "region" (ssget) "")
 (setq sslon (ssget "_X" '((0 . "REGION"))))
 (repeat (setq i (sslength ssnho))
  (ssdel (ssname sslon (setq i (1- i))) sslon))
 (while (setq ent (ssname sslon 0))
  (setq ss (ssadd)
        obj (vlax-ename->vla-object ent)
        objArr (vlax-safearray->list (vlax-variant-value (vla-Explode obj))))
  (foreach memb objArr
   (setq ss (ssadd (vlax-vla-object->ename memb) ss)))
  (command "_.PEDIT" (ssname ss 0) "_YES" "_JOIN" ss "" "")
  (ssdel ent sslon))
 (setvar 'cmdecho cmd) (command "undo" "e") 
 (princ))
 


<<

Filename: 298092_ha.lsp
Tác giả: phamhung12
Bài viết gốc: 298134
Tên lệnh: ctt ctk dh dhh hk
Lisp tính cao độ
;;;Ve duong han
=========================
;;CHUONG TRINH HAN THEP
; Duong han cong truong thuong
(defun C:CTT ( / )
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil)...
>>
;;;Ve duong han
=========================
;;CHUONG TRINH HAN THEP
; Duong han cong truong thuong
(defun C:CTT ( / )
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
	   (if (= b nil) (setq b (* 0.75 a)))
	   (setq l  (distance p1 p2) )
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX ( - (car p2) (car p1) ) )
	   (setq deltaY ( - (cadr p2) (cadr p1) ) )
	   (setq i 0)
; Luu bien he thong
	   (setq osmodeold (getvar "osmode")) 
	   (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
	   (command "_UNDO" "_GROUP")
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
; Them mot vong lap cho i
	   (while (<= i n )
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX ))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1) )
		(setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l)))) (* b (/ deltaX l)))) 
		(setq y2 ( + (+ y1 (* b (/ deltaX l))) (* b (/ deltaY l))))
		(setq p4 (list x2 y2))
		(setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y5 ( + y1 (* b (/ deltaX l)))) 
		(setq p5 (list x5 y5))
		(setq x6 ( + x1  (* b (/ deltaX l)))) 
		(setq y6 ( + y1 (* b (/ deltaY l)))) 
		(setq p6 (list x6 y6) )
		(command "LINE" p3 p4 "")
		(command "LINE" p5 p6 "")
		(setq i (+ i 1))
	   )
	   (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
	   (setvar "BLIPMODE" blipmodeold)		
	   (setvar "OSMODE" osmodeold)
	   (princ)
)
;;==============================================================================

=========================
; Duong han cong truong net khuat
(defun C:CTK ( / )
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "OK\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
	   (if (= b nil) (setq b (* 0.75 a)))
	   (setq l  (distance p1 p2))
	   (setq n (fix ( / l a )))
	   (setq deltaX (- (car p2) (car p1)))
	   (setq deltaY (- (cadr p2) (cadr p1)))
	   (setq i 0)
; Luu bien he thong
	   (setq osmodeold (getvar "osmode")) 
	   (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
	   (command "_UNDO" "_GROUP")
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
; Them mot vong lap cho i
	   (while (<= i n )
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY ))))
		(setq p3 (list x1 y1))
		(setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
		(setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
		(setq p4 (list x2 y2))
		(setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y5 ( + y1 (* b (/ deltaX l)))) 
		(setq p5 (list x5 y5))
		(setq x6 ( + x1  (* b (/ deltaX l)))) 
		(setq y6 ( + y1 (* b (/ deltaY l)))) 
		(setq p6 (list x6 y6) )
	(if (< (rem i 6) 4)		
	   	(progn
		 (command "LINE" p3 p4 "")
		   	 (command "LINE" p5 p6 "")
		)
		) 
	(setq i (+ i 1))
	   )
	   (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
	   (setvar "BLIPMODE" blipmodeold)		
	   (setvar "OSMODE" osmodeold)
	   (princ)
)
;;==============================================================================
(defun C:DH()
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho")) )
(setvar "cmdecho" 0)
   (setq P1 (getpoint "\nDiem dau : "))
   (setq P2 (getpoint p1 "\nDiem cuoi : "))
   (setq P3 (getpoint p1 "\nPhia co duong han : "))
   (setq  l (getreal  "\nChieu cao duong han : "))
   (setq goc (angle p1 p2))
   (setq xA (car P1))
   (setq yA (cadr P1))
   (setq xB (car P2))
   (setq yB (cadr P2))
   (setq xC (car P3))
   (setq yC (cadr P3))
   (setq dau (- (* (- xC xA) (- yB yA)) (* (- xB xA) (- yC yA))))
   (setq n (distance P1 P2))
   (setq x1 (- xA (* l (cos goc))))
   (setq y1 (- yA (* l (sin goc))))
(setvar "osmode" 0)
   (While (> n 0)
	  (setq x1 (+ x1 (* l (cos goc))))
	  (setq y1 (+ y1 (* l (sin goc))))
	  (setq x2 (- x1 (* l (sin goc))))
	  (setq y2 (+ y1 (* l (cos goc))))
	  (setq x3 (+ x1 (* l (sin goc))))
	  (setq y3 (- y1 (* l (cos goc))))
	  (setq dau2 (- (* (- x2 xA) (- yB yA)) (* (- xB xA) (- y2 yA))))
	  (if (> (* dau2 dau) 0)	   
		(command "line" (list x1 y1) (list x2 y2) "")
		(command "line" (list x1 y1) (list x3 y3) "")
	  )
	  (setq n (- n l))
   );of while
(mapcar 'setvar (list "osmode" "cmdecho") om)
(command "undo" "e")
(PRINC)
); of defun
;;==============================================================================

=========================
;bo sung duong han net khuat
; Duong han
(defun C:DHH ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
	   (setq l  (distance p1 p2))
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX (- (car p2) (car p1)))
	   (setq deltaY (- (cadr p2) (cadr p1)))
	   (setq i 0)
	   (setvar "osmode" 0)
	   (setvar "BLIPMODE" 0)		
	   ;(command "_UNDO" "_GROUP");
	   (while (<= i n)
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1))
		(setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y2 ( + y1 (* b (/ deltaX l)))) 
		(setq p4 (list x2 y2))
		(command "LINE" p3 p4 "")
		(setq i (+ i 1))
	   )
	  (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
	   (princ)
)
;;==============================================================================

=========================
; Duong han net khuat
(defun C:HK ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
 
	   (setq l  (distance p1 p2) )
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX ( - (car p2) (car p1) ) )
	   (setq deltaY ( - (cadr p2) (cadr p1) ) )
	   (setq i 0)
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
	   ;(command "_UNDO" "_GROUP");
	   (while (<= i n)
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1))
		(setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y2 ( + y1 (* b (/ deltaX l)))) 
		(setq p4 (list x2 y2))
	(if (< (rem i 6) 4)		
			  (command "LINE" p3 p4 "")
		)  
		(setq i (+ i 1))
	   )
		  (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
	   (princ)
)

<<

Filename: 298134_ctt_ctk_dh_dhh_hk.lsp
Tác giả: hiepttr
Bài viết gốc: 298168
Tên lệnh: test
Lisp random cao độ

Thử cái này: :D

  ;;from Gia_Bach <----internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  ;main
(defun c:test()
(vl-load-com)
(prompt "\nChon text cao do can sua !")
(setq ss (acet-ss-to-list (ssget '((0 . "*TEXT")))))
	(foreach ent ss
		(setq so (atof (cdr(assoc 1 (setq info (entget ent)))))
			  dau (cond
					((< (setq rd (random))) 0.3 -1)
					((< rd 0.6) 0)
					(t...
>>

Thử cái này: :D

  ;;from Gia_Bach <----internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  ;main
(defun c:test()
(vl-load-com)
(prompt "\nChon text cao do can sua !")
(setq ss (acet-ss-to-list (ssget '((0 . "*TEXT")))))
	(foreach ent ss
		(setq so (atof (cdr(assoc 1 (setq info (entget ent)))))
			  dau (cond
					((< (setq rd (random))) 0.3 -1)
					((< rd 0.6) 0)
					(t 1)
					)
		)
		(entmod (subst (cons 1 (rtos (+ so (* dau (/ (random) 20))) 2 2)) (assoc 1 info) info))
	)
)

<<

Filename: 298168_test.lsp

Trang 161/304

161