;Kho chu :DO THANH DAT ! Thanks !
;;OFFSET VE 2 BEN CUA 1 DOI TUONG ( )
(defun c:oo(/ data_m)
(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Khoang cach line cach deu sang hai ben (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)
(defun process(/ ent check)
(defun p_check()
(setq...

;Kho chu :DO THANH DAT ! Thanks !
;;OFFSET VE 2 BEN CUA 1 DOI TUONG ( )
(defun c:oo(/ data_m)
(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Khoang cach line cach deu sang hai ben (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)
(defun process(/ ent check)
(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)
(defun p_d_offset(/ p1 p2 p3 p4)
(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))
(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))
))
(princ)
)
(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)
(SETVAR "osmode" 16383)
(setvar "pickbox" 6)
(setvar "aperture" 6)
(setvar "orthomode" 1)




nhờ các cao thủ sửa lại cho nó oset theo đường chéo được không ạ!

vì cái lisp này chỉ oset đều về 2 bên theo trục X và Y không theo trục chéo....thank các pro trước

Theo Tue_NV thì ý bạn ấy muốn cân đối lại mũi tên. Không nhất thiết phải scale rồi chỉnh lại. Và cái điểm mà Ketxu nói đó nằm trên đoạn thẳng nối từ điểm đầu đến điểm cuối của mũi tên

Có 2 thông số đặt ra để bạn Girl nhập vào để chạy chương trình:
- Một là Độ lớn của mũi tên : Trong hình vẽ của bạn là 0.18
- Hai là : Khoảng cách từ đỉnh của...

Theo Tue_NV thì ý bạn ấy muốn cân đối lại mũi tên. Không nhất thiết phải scale rồi chỉnh lại. Và cái điểm mà Ketxu nói đó nằm trên đoạn thẳng nối từ điểm đầu đến điểm cuối của mũi tên

Có 2 thông số đặt ra để bạn Girl nhập vào để chạy chương trình:
- Một là Độ lớn của mũi tên : Trong hình vẽ của bạn là 0.18
- Hai là : Khoảng cách từ đỉnh của mũi tên tới chân mũi tên để bạn girl có thể cân đối lại mũi tên
Thử nhé :

Chào bác npham,
Nhờ bác chỉ dạy và tham khảo thêm các bác khác, mình làm thử cái này hơi thừa vì chưa chắc có ai cần dùng. Song mình gửi lên để mong các bác góp ý thêm xem còn chỗ nào bất hợp lý. Đề bài vẫn là của bạn Trang72 thôi, còn đáp án thì có khác chút đỉnh với của bác. Tuy cũng ra được cái hộp thoại nhưng chưa được như mong muốn nên nhờ các bác chỉ thêm.
1/-...

Chào bác npham,
Nhờ bác chỉ dạy và tham khảo thêm các bác khác, mình làm thử cái này hơi thừa vì chưa chắc có ai cần dùng. Song mình gửi lên để mong các bác góp ý thêm xem còn chỗ nào bất hợp lý. Đề bài vẫn là của bạn Trang72 thôi, còn đáp án thì có khác chút đỉnh với của bác. Tuy cũng ra được cái hộp thoại nhưng chưa được như mong muốn nên nhờ các bác chỉ thêm.
1/- file lisp

Các bạn trên đã bày cách rồi, rất nhiều cách "chơi" được. Bạn thử thêm 1 cách này và so sánh hiệu quả, một đoạn lisp rất ngắn và đơn giản:



Load lisp, gõ lệnh EMB (erase multi block), chọn 1 cái làm mẫu là nó "chơi" tất! Nếu thấy thích thì tham gia học lisp cùng anh em trên diễn đàn, bạn sẽ làm được nhiều thứ hay hơn thế rất nhiều.... Xin mời

>>

Các bạn trên đã bày cách rồi, rất nhiều cách "chơi" được. Bạn thử thêm 1 cách này và so sánh hiệu quả, một đoạn lisp rất ngắn và đơn giản:



Load lisp, gõ lệnh EMB (erase multi block), chọn 1 cái làm mẫu là nó "chơi" tất! Nếu thấy thích thì tham gia học lisp cùng anh em trên diễn đàn, bạn sẽ làm được nhiều thứ hay hơn thế rất nhiều.... Xin mời

Em sưu tầm và có chỉnh sửa lại theo những yêu cầu của mình nhưng khổ nổi nó chỉ chạy được lần đầu tiên còn các lần sau nó đều báo lổi nhờ các bác ai biết sửa lại cho em:

(Defun c:TDT()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "osnap" "none")
(if (null am)(setq am "1"))
(Setq temp1 T)
(While temp1
(setq pt (strcat "\nHe...

Em sưu tầm và có chỉnh sửa lại theo những yêu cầu của mình nhưng khổ nổi nó chỉ chạy được lần đầu tiên còn các lần sau nó đều báo lổi nhờ các bác ai biết sửa lại cho em:

(Defun c:TDT()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "osnap" "none")
(if (null am)(setq am "1"))
(Setq temp1 T)
(While temp1
(setq pt (strcat "\nHe so ("am") \<Chon diem>: "))
(Initget "h H")
(setq str (getpoint pt))
(Cond
((= str "h") (setq am (getstring (strcat"\nNhap he so <"am"> :"))))
((= str "H") (setq am (getstring (strcat"\nNhap he so <"am"> :"))))
(Progn
(Setq pt str)
(setq temp1 nil)
)
)
)
(setq s 0)
(progn
; (setq pt (getpoint "\n Chon diem: "))
(while pt
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "boundary" pt "")
(setq entnew (cdr (assoc 5 (entget (entlast)))))
(if (/= entold entnew)
(progn
(setq entnew (entget (entlast)))
(if (assoc 62 entnew)
(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))
)


(entmod entnew)
(Command "area" "o" (entlast))
(setq s (+ s (getvar "area")))
(setq pt (getpoint "\n Chon diem: "))
(entdel (entlast))
)
(progn
(princ "chon diem sai")
(setq pt (getpoint "\n Chon diem: "))
)
)
)
)

(command "osnap" "intersection")
(setq am (atof am))
(setq s (* s am))
(setq point (getpoint "\n Chon diem ghi dien tich: "))
(setq th (getvar "textsize"))
(setq th (getstring (strcat "\nChieu cao chu <"(rtos th)"> :")))
;(princ "\nDien tich nhung vung vua chon la: "s)
(command "TEXT" point th 0 (rtos s 2 2))
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** TAILIEUKYTHUAT.COM")
(princ )
)

hi. Bác mắng em cũng đúng. Quả thật thì e đã bê cái lưu giá trị lần trước vào rồi nhưng nó không chạy nên e phải nhờ bác. hức hức. Tang chứng vật chứng vẫn còn đây ạ , chú ý rằng e chỉ copy paste và đổi tên biến chứ e ko hiểu nhìu về lisp đâu ạ.

;; free lisp from cadviet.com
;;; this lisp was downloaded from...

hi. Bác mắng em cũng đúng. Quả thật thì e đã bê cái lưu giá trị lần trước vào rồi nhưng nó không chạy nên e phải nhờ bác. hức hức. Tang chứng vật chứng vẫn còn đây ạ , chú ý rằng e chỉ copy paste và đổi tên biến chứ e ko hiểu nhìu về lisp đâu ạ.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0) ; => em khong biet bo sung luu gia tri, v&#236; l&#224; getint ?
(or cao (setq cao 10)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string #dist) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :")) ;
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

Ko biết bạn có viết dc cái lisp chua hay là dùng Crip! Mình thử add các command vào thành cái lisp này mong là có thể giúp bạn nhanh hơn làm thủ công!

(defun c:xu(/ dt)
(command "Mspace")
(setq dt (car(entsel)))
(command "-view" "o" "F")
(command "zoom"...

Ko biết bạn có viết dc cái lisp chua hay là dùng Crip! Mình thử add các command vào thành cái lisp này mong là có thể giúp bạn nhanh hơn làm thủ công!

(defun c:xu(/ dt)
(command "Mspace")
(setq dt (car(entsel)))
(command "-view" "o" "F")
(command "zoom" "o" dt "")
(command "SOLPROF" dt "" "y" "y" "n")
(entdel(entlast))
;;;;;;
(command "-view" "o" "r")
(command "rotate" (entlast) "" "0,0,0" "-90")
(command "SOLPROF" dt "" "y" "y" "n")
(entdel(entlast))
;;;;;;
(command "-view" "o" "F")
(command "rotate" (entlast) "" "0,0,0" "90")
;;;;;;
(command "Ucs" "W")
(command "plan" "")
(command "SOLPROF" dt "" "y" "y" "n")
(entdel(entlast))
(command "Pspace")
)

&#272;&#226;y l&#224; CODE FULL
;;;;;;;;;;;;;;;;;;=================== 44================
(DEFUN C:49 ()
(Command "undo" "begin")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))

(progn
(setq cmdo (getvar "cmdecho"))
;(command "_.ucs" "")
(setvar "cmdecho" 0)
(princ "\nCopy array:")
...

&#272;&#226;y l&#224; CODE FULL
;;;;;;;;;;;;;;;;;;=================== 44================
(DEFUN C:49 ()
(Command "undo" "begin")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))

(progn
(setq cmdo (getvar "cmdecho"))
;(command "_.ucs" "")
(setvar "cmdecho" 0)
(princ "\nCopy array:")
(setq ss1 (ssget))
(setq p1 (getpoint "First point: "))
(setq p2 (getpoint p1 "Second point: "))
(if ca:distance
(progn
(setq std (rtos ca:distance 2 4))
(setq d (getdist (strcat "@n=<" std ">: ")))
(if d
(setq ca:distance d)
)
) ;end progn
(setq ca:distance (getdist "a= "))
) ;end if
(setq a (angle p1 p2))
(setq a (* (/ 180 pi) a))
(command "_.ucs" "z" a)
(setq di (distance p1 p2))
(setq d ca:distance)
(setq n (/ di d))
(setq n (+ 1 (atoi (rtos n 2 1))))
(command "_.array" ss1 "" "r" 1 n d)
(command "_.ucs" "")
(setvar "cmdecho" cmdo)
(command "OSMODE" "15359")
(princ)
)
)

(PRINC)
)
)
)


Command: 49 undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or
<1>: begin
Command:
Copy array:
Select objects: 1 found

Select objects: First point: Second point: @n=<15>: 5
5.000000

Unknown command "49". Press F1 for help.
OSMODE
Enter new value for OSMODE <15359>: 15359
Command:
Cái này 100% em nghĩ là do cái thằng Array phải xoay UCS bây giờ mình làm sao để không động chạm gì tới UCS thì sẽ giải quyết đc vấn đề, còn việc tên biến có trùng cũng không sao ạ. Vì e có rất nhiều tên biến trùng nhau như vậy giữa các lispp nhưng không bị làm sao cả. Anh cứ đổi giúp em thuật toán array sang COPY là ok ạ !

Nhờ các bác chỉnh sửa giúp em lisp này với!Cảm ơn các bác nhiều!!

(defun main
FasStringtables 0
FasStringtables 1
(defun main
nil
(setq C:OVAL <Func> C:OVAL)
(vl-ACAD-defun C:OVAL)
(defun C:OVAL
(_al-bind-alist '(*OVL:ERR* C_E C1 C2 R ANG O1 O2 O3 O4 CE))
(defun *OVL:ERR*
(M)
(cond (MEMBER M '("Function cancelled" "quit / exit abort" "console break")) (

>>

Nhờ các bác chỉnh sửa giúp em lisp này với!Cảm ơn các bác nhiều!!

(defun main
FasStringtables 0
FasStringtables 1
(defun main
nil
(setq C:OVAL <Func> C:OVAL)
(vl-ACAD-defun C:OVAL)
(defun C:OVAL
(_al-bind-alist '(*OVL:ERR* C_E C1 C2 R ANG O1 O2 O3 O4 CE))
(defun *OVL:ERR*
(M)
(cond (MEMBER M '("Function cancelled" "quit / exit abort" "console break")) (
(cond (PROMPT (STRCAT "\n< " M " >\n")) (
it's OR skip next 6 bytes -> 81
it's OR skip next 6 bytes -> 81
T
(ENTDEL CE)
(SETVAR Then OR Else C_E)
(setq *ERROR* *E*)
(setq *OVL:ERR* <Func> *OVL:ERR*)
(cond *E* (
(cond *ERROR* (
normal cond
normal cond
(setq *E* nil)
(setq *ERROR* *OVL:ERR*)
(setq C_E (GETVAR "cmdecho"))
(setq C1 (GETPOINT "\nFirst end of oval <center point>: "))
(PROMPT "\nOval width <point>: ")
(SETVAR "cmdecho" 0)
(ads-cmd "circle")
(ads-cmd C1)
(ads-cmd PAUSE)
(setq CE (ENTLAST ))
(PROMPT "\nOther end of oval: ")
(ads-cmd "move")
(ads-cmd "l")
(ads-cmd "")
(ads-cmd C1)
(ads-cmd PAUSE)
(setq C2 (CDR (ASSOC 10 (ENTGET (ENTLAST )))))
(setq R (CDR (ASSOC 40 (ENTGET (ENTLAST )))))
(setq ANG (ANGLE C1 C2))
(setq O1 (POLAR C1 (+ ANG (/ PI 2)) R))
(setq O2 (POLAR C1 (- ANG (/ PI 2)) R))
(setq O3 (POLAR C2 (- ANG (/ PI 2)) R))
(setq O4 (POLAR C2 (+ ANG (/ PI 2)) R))
(ENTDEL CE)
(ads-cmd "pline")
(ads-cmd O1)
(ads-cmd "w")
(ads-cmd 0)
(ads-cmd 0)
(ads-cmd "a")
(ads-cmd "ce")
(ads-cmd C1)
(ads-cmd O2)
(ads-cmd "l")
(ads-cmd O3)
(ads-cmd "a")
(ads-cmd O4)
(ads-cmd "l")
(ads-cmd "c")
(SETVAR Then OR Else C_E)
(setq *ERROR* *E*)

Hề hề hề,
Có phải bạn cần cái ni không???
Bữa trước có một bạn đã lập topic tương tự thế này và mình đã trả lời. Nhưng có lẽ do topic lập sai quy định nên đã bị delete. Trong lisp trả lời của mình do không có thời gian test nên chưa thực sự đúng trong một số trường hợp. Nay mình đã bổ sung lại lisp đó tuy nhiên trong lisp này mình để chiều dài của đường xanh ngắn...

Hề hề hề,
Có phải bạn cần cái ni không???
Bữa trước có một bạn đã lập topic tương tự thế này và mình đã trả lời. Nhưng có lẽ do topic lập sai quy định nên đã bị delete. Trong lisp trả lời của mình do không có thời gian test nên chưa thực sự đúng trong một số trường hợp. Nay mình đã bổ sung lại lisp đó tuy nhiên trong lisp này mình để chiều dài của đường xanh ngắn là 1/3 chiều dài đường trắng như bạn lúc trước yêu cầu. Nếu bạn không khoái thì có thể sửa lạ.
Hy vọng bạn hài lòng.


Lisp này yêu cầu bạn: chọn đường chuẩn là đường mà bạn sẽ bắt đầu vẽ các đường mái dốc
chọn đường giói hạn là đường hạn chế chiều dài đường mái dốc
Nhập khoảng cách chia
Nhập nội dung text cần ghi
Nhập khoảng cách giữa đường xanh ngắn và đường trắng.
Sau đó sẽ vẽ ra cái bạn cần.

Hề hề hề,
Chúc bạn vui.

Bạn xài thử lisp này (viết cho cad 2010), nếu không chạy được lệnh acet-ss-to-list mình sẽ sửa lại
4 lệnh là QTr, QPh, TrPh, PhTr
Chiều của đường cong tính từ đầu gần của điểm pick

To phamthanhbinh
Bài này và bài rải cột điện khác nhau nhiều. Bài này là tuyệt đối, bài rải cột điện là tương đối nên không áp dụng cho nhau được.
Các chương trình của bạn...

Bạn xài thử lisp này (viết cho cad 2010), nếu không chạy được lệnh acet-ss-to-list mình sẽ sửa lại
4 lệnh là QTr, QPh, TrPh, PhTr
Chiều của đường cong tính từ đầu gần của điểm pick

To phamthanhbinh
Bài này và bài rải cột điện khác nhau nhiều. Bài này là tuyệt đối, bài rải cột điện là tương đối nên không áp dụng cho nhau được.
Các chương trình của bạn nên hạn chế dùng biến global. Biến global chỉ dùng khi cần thiết và phải có quy tắc đặc tên để nhận biết.