Info | File | ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433483 Tên lệnh: mtbl |
XIN LISP CHÈN TEXT VÀO LINE
| ||
Tác giả: heroproviponline Bài viết gốc: 410680 Tên lệnh: cd bd |
Không cắt được đường kích thước
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433508 Tên lệnh: mtbl |
XIN LISP CHÈN TEXT VÀO LINE
| ||
Tác giả: duy782006 Bài viết gốc: 15304 Tên lệnh: mk |
Giao diện hộp thoại trong AutoLisp
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433574 Tên lệnh: mtbl |
XIN LISP CHÈN TEXT VÀO LINE
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433612 Tên lệnh: da dd |
XIN LISP TỰ ĐỘNG ĐIỀN CHIỀU CAO DIM
(defun c:DA (/ p1 p2 p3 p4 ang ang2 ang3 anmin anmax oldos) (setq p1 (getpoint "\nDiem Dat 1" (defun c:DA (/ p1 p2 p3 p4 ang ang2 ang3 anmin anmax oldos) (setq p1 (getpoint "\nDiem Dat 1") p2 (getpoint p1 "\nDiem dat 2") ang (angle p1 p2) ang2 (angle p2 p1) anmin (min ang ang2) anmax (+ anmin pi) p3 (getpoint "\nPick huong dat dim") ang3 (angle p1 p3)) (if (and (> ang3 anmin) (< ang3 anmax)) (setq p4 (polar p1 (+ anmin (/ pi 2)) 800)) (setq p4 (polar p1 (- anmin (/ pi 2)) 800)) ) (setq oldos (getvar 'osmode)) (setvar "osmode" 0) (command "DIMALIGNED" p1 p2 p4) (setvar "osmode" oldos ) ) (defun c:DD (/ p1 p2 p3 p4 osmode) (setq p1 (getpoint "\nDiem Dat 1") p2 (getpoint p1 "\nDiem dat 2") p3 (getpoint "\nPick huong dat dim") ) (if (and (> (car p3) (car p1)) (> (car p3) (car p2)) ) (setq p4 (list (+ (max (car p1) (car p2)) 800) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1))) ) (if (and (< (car p3) (car p1)) (< (car p3) (car p2)) ) (setq p4 (list (- (min (car p1) (car p2)) 800) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1))) ) (if (and (> (cadr p3) (cadr p1)) (> (cadr p3) (cadr p2)) ) (setq p4 (list (/ (+ (car p1) (car p2)) 2) (+ (max (cadr p1) (cadr p2)) 800) (caddr p1))) ) (if (and (< (cadr p3) (cadr p1)) (< (cadr p3) (cadr p2)) ) (setq p4 (list (/ (+ (car p1) (car p2)) 2) (- (min (cadr p1) (cadr p2)) 800) (caddr p1))) ) (if p4 (progn (setq oldos (getvar 'osmode)) (setvar "osmode" 0) (command "dimlinear" p1 p2 p4) (setvar "osmode" oldos ) ) (Alert "\nPick huong chua dung")) ) Bạn test thử xem, Lệnh DA cho DIMALGNED, DD cho DIMLINEAR <<
| ||
Tác giả: TRUNGNGAMY Bài viết gốc: 73281 Tên lệnh: exx |
Lisp xóa toàn bộ đối tượng được ngăn bởi đường thẳng
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433640 Tên lệnh: da dd st |
XIN LISP TỰ ĐỘNG ĐIỀN CHIỀU CAO DIM
| ||
Tác giả: kuarambo Bài viết gốc: 322196 Tên lệnh: dlb |
Nhờ viết lisp thay các đối tượng chọn bằng 1 block khác
| ||
Tác giả: Kieu Tan Bài viết gốc: 378500 Tên lệnh: tkt |
cho em xin lisp đếm text
| ||
Tác giả: khanhcang2 Bài viết gốc: 433658 Tên lệnh: zt |
Chỉnh sửa lisp cad tính diện tích về đơn vị m2
(defun c:zt()
(defun ctext (diem gt / lst)
(setq lst
(list
(cons 0 "TEXT")
(cons 1 gt)
(cons 10 diem)
(cons 40 (getdist p "\Text heigh: "))
)
)
(entmake lst)
)
(defun dtdoituong (entdt /)
(command ".area" "o" entdt)
(command ".erase" entdt "")
(getvar "area")
)
(defun getbound(p)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(princ...
(defun c:zt()
(defun ctext (diem gt / lst)
(setq lst
(list
(cons 0 "TEXT")
(cons 1 gt)
(cons 10 diem)
(cons 40 (getdist p "\Text heigh: "))
)
)
(entmake lst)
)
(defun dtdoituong (entdt /)
(command ".area" "o" entdt)
(command ".erase" entdt "")
(getvar "area")
)
(defun getbound(p)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(princ "\nCADViet.com (c) 2007")
(setq
p (getpoint "\Select area place by click a point: ")
entpl (getbound p)
)
(if entpl
(ctext p (rtos (dtdoituong entpl)))
(alert "Fail!")
)
(princ)
)
(princ "\ndtm - free lisp from www.cadviet.com")
(princ)
Em muốn nhờ mọi người chỉnh sửa kết quả giúp em xuống đơn vị 10^-6 và thêm chữ m2 vào sau kết quả với ạ. Em cảm ơn ạ. <<
| ||
Tác giả: tuananhdo Bài viết gốc: 420084 Tên lệnh: cpt |
Nhờ Viết Lisp Rải Text Dạng Số
| ||
Tác giả: phuongkq Bài viết gốc: 185683 Tên lệnh: btk |
Đo chiều dài và ghi ra text
| ||
Tác giả: thanh1401 Bài viết gốc: 117752 Tên lệnh: ttt hh hscale d1 w1 ff llo lllo w2 h1 v1 h2 v2 oo |
Vấn đề Lisp cửa đi, cửa sổ và 1 vài lisp khác..
Hiện mình đang sửa dụng Lisp cửa đi (D1), cửa sổ (W1), opset 2 bên (oo)....Những Lisp này hỗ trợ làm đồ án rất tốt, nhưng nhược điểm của nó là chỉ sử dụng đc với đối tượng vuông góc (song song) với trục ox,oy. còn chéo thì chịu.. :iluvyousmiley: Càng ngày yêu cầu của Đồ án càng khù khằm..có mấy khi vuông đâu, toàn xiên xẹo lung tung--> hết dùng lisp này. Ai có cách nào giúp mình... >> Hiện mình đang sửa dụng Lisp cửa đi (D1), cửa sổ (W1), opset 2 bên (oo)....Những Lisp này hỗ trợ làm đồ án rất tốt, nhưng nhược điểm của nó là chỉ sử dụng đc với đối tượng vuông góc (song song) với trục ox,oy. còn chéo thì chịu.. :iluvyousmiley: Càng ngày yêu cầu của Đồ án càng khù khằm..có mấy khi vuông đâu, toàn xiên xẹo lung tung--> hết dùng lisp này. Ai có cách nào giúp mình trường hợp này đc không ? Đây là lisp mình đang dùng : Lisp cửa đi (D1) :
(defun ai_undo_on () (setq undo_setting (getvar "undoctl")) (cond ((= 2 (logand undo_setting 2)) ; Undo is one (command "_.undo" "_control" "_all" "_.undo" "_auto" "_off") ) ((/= 1 (logand undo_setting 1)) ; Undo is disabled (command "_.undo" "_all" "_.undo" "_auto" "_off") ) ) ) ;;;f ;;; Return UNDO to the initial setting. Do not use with new routines as they ;;; should be designed to operate with any UNDO setting. ;;; (defun ai_undo_off () (cond ((/= 1 (logand undo_setting 1)) (command "_.undo" "_control" "_none") ) ((= 2 (logand undo_setting 2)) (command "_.undo" "_control" "_one") ) ) ) (defun ai_undo_push() (setq undo_init (getvar "undoctl")) (cond ((and (= 1 (logand undo_init 1)) ; enabled (/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON) (/= 8 (logand undo_init 8)) ; no GROUP active ) (command "_.undo" "_group") ) (T) ) ;; If Auto is ON, turn it off. (if (= 4 (logand 4 undo_init)) (command "_.undo" "_auto" "_off") ) ) ;;; ;;; Add an END to UNDO and return to initial state. ;;; (defun ai_undo_pop() (cond ((and (= 1 (logand undo_init 1)) ; enabled (/= 2 (logand undo_init 2)) ; not ONE (ie ALL is ON) (/= 8 (logand undo_init 8)) ; no GROUP active ) (command "_.undo" "_end") ) (T) ) ;; If it has been forced off, turn it back on. (if (= 4 (logand undo_init 4)) (command "_.undo" "_auto" "_on") ) ) ;;;======== COMMAND FOR TEXT ========= ;Change string (defun c:ttt (/ OBJ NEWVAL DXF NT OT m n E) (setq olderr *error* *error* err) (defun entry() (princ "Copyright © 1998 by Han Ngoc Duc, DHXD") ) (command"undo""g") (prompt "\nSelect text to be changed: ") (setq OBJ (ssget)) (if (null OBJ) (exit)) (setq n (sslength OBJ)) (setq m 0) (setq NEWVAL (entsel "\nSelect target text: ")) (if (/= NEWVAL nil) (progn (setq NEWVAL (entget (car NEWVAL))) (setq NT (assoc 1 NEWVAL)) (repeat n (setq E (ssname OBJ m)) (setq E (entget E)) (setq OT (assoc 1 E)) (setq E (subst NT OT E)) (entmod E) (setq m (1+ m)) ) ) (progn (setq DXF 1 NEWVAL (getstring "\nInput new text: ") ) (while (< m n) (if (= "TEXT" (cdr (assoc 0 (setq E (entget (ssname OBJ m)))))) (progn (setq T2 (assoc DXF E) E (subst (cons DXF NEWVAL) T2 E)) (entmod E) (setq m (1+ m) ) ) ) ) ) ) (command"undo""e") (setq *error* olderr) (princ) ) ;===== AUTO HATCH (hh) ======== (defun mkhatch(v_hatchtp v_scale v_angle data_m / i) (command "hatch" v_hatchtp v_scale v_angle) (setq i 0) (while (< i (length data_m)) (progn (command (nth i data_m)) (setq i (+ i 1)) )) (command "") ) (defun c:hh(/ data_m check) (defun ah_import(/ p1 p2 old1 ent1 ent2 axa) (if (= nil hscale_d) (setq hscale_d 1)) (setq old1 (getvar "osmode") check 1) (setvar "osmode" 0) (setq p1 '(0 0 0) p2 p1) (command "line" p1 p2 "") (setq data_m '()) (setq ent1 (entlast) ent2 ent1) (princ ent1) (setvar "osmode" old1) (command "boundary") (setq p1 (getpoint)) (while (not (= nil p1)) (progn (command p1) (setq p1 (getpoint)) )) (command "") (setq ent1 (entnext ent1)) (princ ent1) (if (= nil ent1) (setq check 0) (progn (while (not (= nil ent1)) (progn (setq data_m (append data_m (list ent1))) (setq ent1 (entnext ent1)) )) )) (command "erase" ent2 "") (princ) ) (defun ah_procced(/ i s1) (if (= 0 check) (princ "\ninvalid data") (progn (initget 1 "WALL W CONCRETE C GROUND G FLOOR F") (setq s1 (getkword "\nWall/Concrete/Ground/Floor : ")) (if (not (= nil s1)) (progn (cond ((or (= "W" (strcase s1)) (= "WALL" (strcase s1))) (mkhatch "ansi31" (* 750 hscale_d) 0 data_m)) ((or (= "C" (strcase s1)) (= "CONCRETE" (strcase s1))) (progn (mkhatch "ansi31" (* 200 hscale_d) 0 data_m) (mkhatch "ar-conc" (* 20 hscale_d) 0 data_m) )) ((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (mkhatch "ansi38" (* 600 hscale_d) 0 data_m)) ((or (= "F" (strcase s1)) (= "FLOOR" (strcase s1))) (mkhatch "ar-conc" (* 20 hscale_d) 0 data_m)) ) )) (command "erase") (setq i 0) (while (< i (length data_m)) (progn (command (nth i data_m)) (setq i (+ i 1)) )) (command "") )) (princ) ) (ai_undo_push) (ah_import) (ah_procced) (ai_undo_pop) ) (defun c:hscale(/ i) (ai_undo_push) (if (= nil hscale_d) (setq hscale_d 1)) (setq i (getreal (strcat (strcat "enter new hatch scale <" (rtos hscale_d 2 5)) "> "))) (if (not (= nil i)) (setq hscale_d i)) (ai_undo_pop) (princ) ) ;===== AUTO DRAW DOOR-WINDOW (d1,w1,w2) ======== (defun moveent(ls1 post1 post2 / ls2 ent1 ent2 ent3 i) (setq ent1 (nth post1 ls1) ent2 (nth post2 ls1) i 0 ls2 '()) (while (< i (length ls1)) (progn (if (= i post1) (setq ent3 ent2) (if (= i post2) (setq ent3 ent1) (setq ent3 (nth i ls1)) ) ) (if (= nil ls2) (setq ls2 (list ent3)) (setq ls2 (append ls2 (list ent3))) ) (setq i (+ i 1)) )) (setq ls1 ls2) ) (defun arlst(ls1 / ls2 i j k) ; (princ ls1) (setq i 0 ls2 ls1) (if (> (length ls2) 1) (progn (while (< i (- (length ls2) 1) ) (progn (setq j (+ i 1) k 0) (while (and (= 0 k) (< j (length ls2) )) (progn (if (< (nth j ls2) (nth i ls2)) (progn ;(setq k 1) (setq ls2 (moveent ls2 i j)) )) (setq j (+ j 1)) )) (setq i (+ i 1)) )) )) (setq ls1 ls2) ) (defun mkline(point1 point2 line1 / line2 i) (setq i 0 line2 '()) (while (< i (length line1)) (progn (if (and (not (= 10 (car (nth i line1))) ) (not (= 11 (car (nth i line1))))) (progn (if (= nil line2) (setq line2 (list (nth i line1))) (setq line2 (append line2 (list (nth i line1)))) ) )) (setq i (+ i 1)) )) (setq point1 (list 0 (nth 0 point1) (nth 1 point1) (nth 2 point1))) (setq point2 (list 0 (nth 0 point2) (nth 1 point2) (nth 2 point2))) (setq line2 (append line2 (list (cons 10 (cdr point1))))) (setq line2 (append line2 (list (cons 11 (cdr point2))))) ; (princ line2) (entmake line2) (princ) ) (defun drawrec (point1 point2 l1 / point3 point4) (setq point3 (list (nth 0 point1) (nth 1 point2) 0)) (mkline point1 point3 l1) (mkline point2 point3 l1) (setq point3 (list (nth 0 point2) (nth 1 point1) 0)) (mkline point1 point3 l1) (mkline point2 point3 l1) ) (defun drawrt (point1 point2 / point3 point4 x l1) (setq l1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (drawrec point1 point2 l1) (setq x (abs (- (nth 0 point1) (nth 0 point2)))) (setq point3 (list (+ (nth 0 point1) (* 0.15 x) ) (nth 1 point1) 0)) (setq point4 (list (nth 0 point3) (nth 1 point2) 0)) (mkline point3 point4 l1) (setq point3 (list (- (nth 0 point2) (* 0.15 x) ) (nth 1 point1) 0)) (setq point4 (list (nth 0 point3) (nth 1 point2) 0)) (mkline point3 point4 l1) (setq point3 (list (+ (nth 0 point1) (* 0.15 x) ) (* 0.5 (+(nth 1 point1) (nth 1 point2))) 0)) (setq point4 (list (- (nth 0 point2) (* 0.15 x) ) (nth 1 point3) 0)) (mkline point3 point4 l1) (princ) ) (defun drawrt1 (point1 point2 / point3 point4 x l1) (setq l1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (drawrec point1 point2 l1) (setq x (abs (- (nth 1 point1) (nth 1 point2)))) (setq point3 (list (nth 0 point1) (+ (nth 1 point1) (* 0.15 x) ) 0)) (setq point4 (list (nth 0 point2) (nth 1 point3) 0)) (mkline point3 point4 l1) (setq point3 (list (nth 0 point1) (- (nth 1 point2) (* 0.15 x) ) 0)) (setq point4 (list (nth 0 point2) (nth 1 point3) 0)) (mkline point3 point4 l1) (setq point3 (list (* 0.5 (+ (nth 0 point1) (nth 0 point2))) (+ (nth 1 point1) (* 0.15 x) ) 0)) (setq point4 (list (nth 0 point3) (- (nth 1 point2) (* 0.15 x) ) 0)) (mkline point3 point4 l1) (princ) ) (defun drawrt2(pt1 pt2 l1 / pt3 pt4 i dy1 dy2 qt) (setq pt3 (list (nth 0 pt1) (nth 1 pt2) 0)) (mkline pt1 pt3 l1) (setq pt3 (list (nth 0 pt2) (nth 1 pt1) 0)) (mkline pt2 pt3 l1) (if (< 150 (- (nth 1 pt2) (nth 1 pt1))) (setq dy1 40) (setq dy1 (* 0.3 (- (nth 1 pt2) (nth 1 pt1)))) ) (setq qt (fix (/ (- (- (nth 1 pt2) (nth 1 pt1)) dy1) (+ 650 dy1)))) (if (= 0 qt) (setq dy2 (- (- (nth 1 pt2) (nth 1 pt1)) (* 2 dy1))) (setq dy2 (/ (- (- (nth 1 pt2) (nth 1 pt1)) (* (+ qt 1) dy1)) qt)) ) (if (= 0 qt) (setq qt 1)) (setq i 0) (while (< i qt) (progn (setq pt3 (list (nth 0 pt1) (+ (nth 1 pt1) (+ dy1 (* (+ dy1 dy2) i))) 0)) (setq pt4 (list (nth 0 pt2) (nth 1 pt3) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (nth 0 pt1) (+ (nth 1 pt3) dy2) 0)) (setq pt4 (list (nth 0 pt2) (nth 1 pt3) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (+ (nth 0 pt1) (* 0.38 (- (nth 0 pt2) (nth 0 pt1)))) (nth 1 pt3) 0)) (setq pt4 (list (nth 0 pt3) (- (nth 1 pt3) dy2) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (- (nth 0 pt2) (* 0.38 (- (nth 0 pt2) (nth 0 pt1)))) (nth 1 pt3) 0)) (setq pt4 (list (nth 0 pt3) (- (nth 1 pt3) dy2) 0)) (mkline pt3 pt4 l1) (setq i (+ i 1)) )) ; (princ qt) (princ) ) (defun drawrt3(pt1 pt2 l1 / pt3 pt4 i dy1 dy2 qt) (setq pt3 (list (nth 0 pt2) (nth 1 pt1) 0)) (mkline pt1 pt3 l1) (setq pt3 (list (nth 0 pt1) (nth 1 pt2) 0)) (mkline pt2 pt3 l1) (if (< 150 (- (nth 0 pt2) (nth 0 pt1))) (setq dy1 60) (setq dy1 (* 0.3 (- (nth 0 pt2) (nth 0 pt1)))) ) (setq qt (fix (/ (- (- (nth 0 pt2) (nth 0 pt1)) dy1) (+ 650 dy1)))) (if (= 0 qt) (setq dy2 (- (- (nth 0 pt2) (nth 0 pt1)) (* 2 dy1))) (setq dy2 (/ (- (- (nth 0 pt2) (nth 0 pt1)) (* (+ qt 1) dy1)) qt)) ) (if (= 0 qt) (setq qt 1)) (setq i 0) (while (< i qt) (progn (setq pt3 (list (+ (nth 0 pt1) (+ dy1 (* (+ dy1 dy2) i))) (nth 1 pt1) 0)) (setq pt4 (list (nth 0 pt3) (nth 1 pt2) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (+ (nth 0 pt3) dy2) (nth 1 pt1) 0)) (setq pt4 (list (nth 0 pt3) (nth 1 pt2) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (nth 0 pt3) (+ (nth 1 pt1) (* 0.38 (- (nth 1 pt2) (nth 1 pt1)))) 0)) (setq pt4 (list (- (nth 0 pt3) dy2) (nth 1 pt3) 0)) (mkline pt3 pt4 l1) (setq pt3 (list (nth 0 pt3) (- (nth 1 pt2) (* 0.38 (- (nth 1 pt2) (nth 1 pt1)))) 0)) (setq pt4 (list (- (nth 0 pt3) dy2) (nth 1 pt3) 0)) (mkline pt3 pt4 l1) (setq i (+ i 1)) )) ; (princ qt) (princ) ) (defun c:d1(/ data_m l1 l2 p1 p2 check) (defun dw_import(/ p3 p4 p5 p6) (setq data_m (ssget)) (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :")) (setq l1 nil l2 nil check 1) (if (not (= nil data_m)) (progn (setq l1 (entget (ssname data_m 0))) (setq l2 (entget (ssname data_m 1))) (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0)) (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0)) (if (not (= 0 (-(sslength data_m) 2))) (setq check 0)) (if (= 1 check) (progn (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3))) (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4))) (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5))) (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6))) (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0)) )) ) (setq check 0)) (princ) ) (defun dw_procced() (defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 1 p1) (nth 1 p3))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p1) (nth 1 p4))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p5))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p6))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 p3) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 p5) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p5) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 1 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 2 ls1) 0)) (mkline p7 p8 l1) (setq getom (getvar "osmode")) (setvar "osmode" 0) (if (< (nth 1 p1) (nth 1 p2)) (progn (setq ls2 (arlst (list (nth 0 p1) (nth 0 p3) (nth 0 p5) ))) ;(princ ls2) (if (= (nth 0 p1) (nth 0 ls2)) (progn (setq p7 (list (nth 1 ls2) (nth 1 ls1) 0)) (setq p8 (list (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) ) (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ;(princ p8) (drawrt p8 p7) (setq p9 p7) (setq p7 (list (nth 0 p7) (nth 1 p8) 0)) (setq p9 (list (nth 1 ls2) (nth 2 ls1) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p9 p8) (setvar "cmdecho" 1) )(progn (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5) ))) (setq p7 (list (nth 1 ls2) (nth 1 ls1) 0)) (setq p8 (list (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) ) (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) (drawrt p7 p8) (setq p9 p7) (setq p7 (list (nth 0 p7) (nth 1 p8) 0)) (setq p9 (list (nth 1 ls2) (nth 2 ls1) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p8 p9) (setvar "cmdecho" 1) )) ) (progn (setq ls2 (arlst (list (nth 0 p1) (nth 0 p3) (nth 0 p5) ))) (if (= (nth 0 p1) (nth 0 ls2)) (progn (setq p7 (list (nth 1 ls2) (nth 2 ls1) 0)) (setq p8 (list (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) ) (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ;(princ p8) (drawrt p8 p7) (setq p9 p7) (setq p7 (list (nth 0 p7) (nth 1 p8) 0)) (setq p9 (list (nth 1 ls2) (nth 1 ls1) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p8 p9) (setvar "cmdecho" 1) )(progn (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5) ))) (setq p7 (list (nth 1 ls2) (nth 2 ls1) 0)) (setq p8 (list (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) ) (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) (drawrt p7 p8) (setq p9 p7) (setq p7 (list (nth 0 p7) (nth 1 p8) 0)) (setq p9 (list (nth 1 ls2) (nth 1 ls1) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p9 p8) (setvar "cmdecho" 1) )) )) (setvar "osmode" getom) (setvar "cmdecho" 0) (command "erase" data_m "") (setvar "cmdecho" 1) )) (princ) ) (defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 0 p1) (nth 0 p3))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p1) (nth 0 p4))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p5))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p6))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 1 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 2 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq getom (getvar "osmode")) (setvar "osmode" 0) (if (< (nth 0 p1) (nth 0 p2)) (progn (setq ls2 (arlst (list (nth 1 p1) (nth 1 p3) (nth 1 p5) ))) ;(princ ls2) (if (= (nth 1 p1) (nth 0 ls2)) (progn (setq p7 (list (nth 1 ls1) (nth 1 ls2) 0)) (setq p8 (list (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ;(princ p8) (drawrt1 p8 p7) (setq p9 p7) (setq p7 (list (nth 0 p8) (nth 1 p7) 0)) (setq p9 (list (nth 2 ls1) (nth 1 ls2) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p8 p9) (setvar "cmdecho" 1) )(progn (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5) ))) (setq p7 (list (nth 1 ls1) (nth 1 ls2) 0)) (setq p8 (list (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ; (princ p7) ; (princ p8) (drawrt1 p7 p8) (setq p9 p7) (setq p7 (list (nth 0 p8) (nth 1 p7) 0)) (setq p9 (list (nth 2 ls1) (nth 1 ls2) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p9 p8) (setvar "cmdecho" 1) )) ) (progn (setq ls2 (arlst (list (nth 1 p1) (nth 1 p3) (nth 1 p5) ))) ;(princ ls2) (if (= (nth 1 p1) (nth 0 ls2)) (progn (setq p7 (list (nth 2 ls1) (nth 1 ls2) 0)) (setq p8 (list (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ;(princ p8) (drawrt1 p8 p7) (setq p9 p7) (setq p7 (list (nth 0 p8) (nth 1 p7) 0)) (setq p9 (list (nth 1 ls1) (nth 1 ls2) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p9 p8) (setvar "cmdecho" 1) )(progn (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5) ))) (setq p7 (list (nth 2 ls1) (nth 1 ls2) 0)) (setq p8 (list (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0)) ; (princ p7) ; (princ p8) (drawrt1 p7 p8) (setq p9 p7) (setq p7 (list (nth 0 p8) (nth 1 p7) 0)) (setq p9 (list (nth 1 ls1) (nth 1 ls2) 0)) (setvar "cmdecho" 0) (command "arc" "c" p7 p8 p9) (setvar "cmdecho" 1) )) )) (setvar "osmode" getom) (setvar "cmdecho" 0) (command "erase" data_m "") (setvar "cmdecho" 1) )) (princ) ) (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1) (if (= 0 check) (princ "\ninvalid data") (progn (if (< (abs (- (nth 0 (cdr (assoc 10 l1))) (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv)) (if (< (abs (- (nth 1 (cdr (assoc 10 l1))) (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh)) )) (princ) ) (dw_import) (ai_undo_push) (dw_procced) (ai_undo_pop) ) (defun c:w1(/ data_m l1 l2 p1 p2 check) (defun c:ff () (command "fillet" "r" "0") ) (Defun C:LLO (/ LAY) (setq LAY (entsel "\nChon 1 doi tuong tren Layer May muon Khoa: ")) (if LAY (progn (setq LAY (cdr (assoc 8 (entget (car LAY))))) (Command "_.-LAYER" "_LOCK" LAY "") (prompt (strcat "\nLayer " LAY " Vua duoc Khoa. Xin cam on!.")) ) ) (princ) ) ; -------------------- LAYER UNLOCK FUNCTION --------------------- ; Bá kho¸ 1 layer cÇn chän ; ---------------------------------------------------------------- (Defun C:LLLO (/ LAY) (if (not (setq SS (ssget "i"))) (progn (setq LAY (entsel "\nChon 1 doi tuong tren Layer May muon Mo Khoa: ")) (Command "_.-LAYER" "_UNLOCK" LAY "") (prompt (strcat "\nLayer " LAY " Vua Duoc May mo Khoa. Ke ra May cung kha.")) ) ) (princ) ) (defun wd_import(/ p3 p4 p5 p6) (setq data_m (ssget)) (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :")) (setq l1 nil l2 nil check 1) (if (not (= nil data_m)) (progn (setq l1 (entget (ssname data_m 0))) (setq l2 (entget (ssname data_m 1))) (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0)) (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0)) (if (not (= 0 (-(sslength data_m) 2))) (setq check 0)) (if (= 1 check) (progn (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3))) (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4))) (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5))) (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6))) (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0)) )) ) (setq check 0)) (princ) ) (defun wd_procced() (defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 1 p1) (nth 1 p3))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p1) (nth 1 p4))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p5))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p6))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 p3) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 p5) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p5) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 1 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 2 ls1) 0)) (mkline p7 p8 l1) (setq getom (getvar "osmode")) (setvar "osmode" 0) (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5)))) (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0)) (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0)) (setq ll1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (drawrt2 p7 p8 ll1) (setvar "osmode" getom) (command "erase" data_m "") )) (princ) ) (defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 0 p1) (nth 0 p3))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p1) (nth 0 p4))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p5))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p6))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 1 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 2 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq getom (getvar "osmode")) (setvar "osmode" 0) (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5)))) (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0)) (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0)) (setq ll1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (drawrt3 p7 p8 ll1) (setvar "osmode" getom) (command "erase" data_m "") )) (princ) ) (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1) (if (= 0 check) (princ "\ninvalid data") (progn (if (< (abs (- (nth 0 (cdr (assoc 10 l1))) (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv)) (if (< (abs (- (nth 1 (cdr (assoc 10 l1))) (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh)) )) (princ) ) (wd_import) (ai_undo_push) (wd_procced) (ai_undo_pop) ) (defun c:w2(/ data_m l1 l2 p1 p2 check) (defun wd_import(/ p3 p4 p5 p6) (setq data_m (ssget)) (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :")) (setq l1 nil l2 nil check 1) (if (not (= nil data_m)) (progn (setq l1 (entget (ssname data_m 0))) (setq l2 (entget (ssname data_m 1))) (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0)) (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0)) (if (not (= 0 (-(sslength data_m) 2))) (setq check 0)) (if (= 1 check) (progn (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3))) (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4))) (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5))) (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6))) (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0)) )) ) (setq check 0)) (princ) ) (defun wd_procced() (defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 1 p1) (nth 1 p3))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p1) (nth 1 p4))) (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p5))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (> (abs (- (nth 1 p2) (nth 1 p6))) (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 p3) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p3) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 p5) (nth 0 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p5) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 3 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 1 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 1 ls1) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 0 p3) (nth 2 ls1) 0)) (setq p8 (list (nth 0 p5) (nth 2 ls1) 0)) (mkline p7 p8 l1) (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5)))) (setq ll1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (if (< (nth 0 p1) (nth 0 ls2)) (progn (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0)) (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0)) (setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0)) (drawrt2 p7 p8 ll1) (setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0)) (setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0)) (mkline p7 p8 ll1) (setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0)) (mkline p7 p9 ll1) (setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0)) (mkline p8 p9 ll1) )(progn (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0)) (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0)) (setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0)) (drawrt2 p7 p8 ll1) (setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0)) (setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0)) (mkline p7 p8 ll1) (setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0)) (mkline p7 p9 ll1) (setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0)) (mkline p8 p9 ll1) )) (command "erase" data_m "") )) (princ) ) (defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1) (setq p3 (cdr (assoc 10 l1))) (setq p4 (cdr (assoc 11 l1))) (setq p5 (cdr (assoc 10 l2))) (setq p6 (cdr (assoc 11 l2))) (if (> (abs (- (nth 0 p1) (nth 0 p3))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p1) (nth 0 p4))) (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p5))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (> (abs (- (nth 0 p2) (nth 0 p6))) (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0)) (if (= 0 check) (princ "\ninvalid data") (progn (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p3) 0)) (mkline p7 p8 l1) (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) ))) ; (princ ls1) (setq p7 (list (nth 0 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p5) 0)) (setq p8 (list (nth 3 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 1 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 1 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq p7 (list (nth 2 ls1) (nth 1 p3) 0)) (setq p8 (list (nth 2 ls1) (nth 1 p5) 0)) (mkline p7 p8 l1) (setq getom (getvar "osmode")) (setvar "osmode" 0) (setq ll1 (list (cons 0 "line") (cons 8 (getvar "clayer")) )) (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5)))) ;(princ ls2) (if (> (nth 1 p1) (nth 1 ls2)) (progn (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0)) (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0)) (setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0)) (drawrt3 p7 p8 ll1) (setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0)) (setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0)) (mkline p7 p8 ll1) (setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0)) (mkline p7 p9 ll1) (setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0)) (mkline p8 p9 ll1) )(progn (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0)) (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0)) (setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0)) (drawrt3 p7 p8 ll1) (setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0)) (setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0)) (mkline p7 p8 ll1) (setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0)) (mkline p7 p9 ll1) (setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0)) (mkline p8 p9 ll1) )) (setvar "osmode" getom) (command "erase" data_m "") )) (princ) ) (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1) (if (= 0 check) (princ "\ninvalid data") (progn (if (< (abs (- (nth 0 (cdr (assoc 10 l1))) (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv)) (if (< (abs (- (nth 1 (cdr (assoc 10 l1))) (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh)) )) (princ) ) (wd_import) (wd_procced) ) ;======= AUTO DIM (h1,v1,h2,v2) ======= (defun c:h1(/ data_m ls1 p1 p2) (defun import(/ i ent p3 p4) (defun putnum(/ j k l ls3) ; (princ p3) (if (= nil ls1) (setq ls1 (list (nth 0 p3))) (progn (setq ls3 '() j 0 k 0) (while (and (< j (length ls1)) (= k 0)) (progn (if (< (nth 0 p3) (nth j ls1)) (setq k 1) (progn (if (= nil ls3) (setq ls3 (list (nth j ls1)) ) (setq ls3 (append ls3 (list (nth j ls1))))) (setq j (+ j 1)) ; (princ *x*) )) )) ; (princ j) (if (= nil ls3) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 0 p3) (nth j ls1)))) ) (if (or (= nil k) (> k 0.0001)) (setq ls3 (list (nth 0 p3))) ; (princ "a") )) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 0 p3) (nth j ls1)))) ) (if (> j 0) (setq l (abs (- (nth 0 p3) (nth (- j 1) ls1)))) ) ; (princ k) (princ l) (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) (setq ls3 (append ls3 (list (nth 0 p3)))) ) ; (princ "b") )) ; (princ ls3) (while (< j (length ls1)) (progn (setq ls3 (append ls3 (list (nth j ls1)))) (setq j (+ j 1)) ; (princ ls3) )) (setq ls1 ls3) )) ; (princ ls1) (princ) ) (setq data_m (ssget) ls1 '()) (setq p1 (getpoint "\nfirst point") p2 (getpoint "\nsecond point")) (setq i 0) (while (< i (sslength data_m)) (progn (setq ent (entget (ssname data_m i))) ;(princ ent) (if (= "LINE" (cdr (assoc 0 ent))) (progn (setq p3 (cdr (assoc 10 ent))) (putnum) (setq p3 (cdr (assoc 11 ent))) (putnum) ;(princ p3) ;(princ p4) ;(if (and (> 0.00001 (- (nth 0 p3) (nth 0 p4))) ; (< -0.00001 (- (nth 0 p3) (nth 0 p4)))) (putnum)) )) (setq i (+ i 1)) )) (princ) ) (defun procced(/ p3 p4 p5 i omd) (setq omd (getvar "osmode")) (setvar "osmode" 0) (setvar "cmdecho" 0) (if (> (length ls1) 1) (progn (setq i 0) (command "dim") (while (< i (- (length ls1) 1)) (progn (setq p3 (list (nth i ls1) (nth 1 p1) (nth 2 p1) )) (setq p4 (list (nth (+ i 1) ls1) (nth 1 p1) (nth 2 p1))) (setq p5 (list (nth 0 p1) (nth 1 p2) (nth 2 p1)) ) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (command "hor" p3 p4 p5 "")) (setq i (+ i 1)) )) (command "exit") )) (setvar "osmode" omd) (setvar "cmdecho" 1) (princ) ) (import) (ai_undo_push) (procced) (ai_undo_pop) (princ) ) (defun c:v1(/ data_m ls1 p1 p2 omd) (defun import(/ i ent p3 p4) (defun putnum(/ j k l ls3) ; (princ p3) (if (= nil ls1) (setq ls1 (list (nth 1 p3))) (progn (setq ls3 '() j 0 k 0) (while (and (< j (length ls1)) (= k 0)) (progn (if (< (nth 1 p3) (nth j ls1)) (setq k 1) (progn (if (= nil ls3) (setq ls3 (list (nth j ls1)) ) (setq ls3 (append ls3 (list (nth j ls1))))) (setq j (+ j 1)) ; (princ *x*) )) )) ; (princ j) (if (= nil ls3) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 1 p3) (nth j ls1)))) ) (if (or (= nil k) (> k 0.0001)) (setq ls3 (list (nth 1 p3))) ; (princ "a") )) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 1 p3) (nth j ls1)))) ) (if (> j 0) (setq l (abs (- (nth 1 p3) (nth (- j 1) ls1)))) ) ; (princ k) (princ l) (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) (setq ls3 (append ls3 (list (nth 1 p3)))) ) ; (princ "b") )) ; (princ ls3) (while (< j (length ls1)) (progn (setq ls3 (append ls3 (list (nth j ls1)))) (setq j (+ j 1)) ; (princ ls3) )) (setq ls1 ls3) )) ; (princ ls1) (princ) ) (setq data_m (ssget) ls1 '()) (setq p1 (getpoint "\nfirst point") p2 (getpoint "\nsecond point")) (setq i 0) (while (< i (sslength data_m)) (progn (setq ent (entget (ssname data_m i))) ;(princ ent) (if (= "LINE" (cdr (assoc 0 ent))) (progn (setq p3 (cdr (assoc 10 ent))) (putnum) (setq p3 (cdr (assoc 11 ent))) (putnum) ;(princ p3) ;(princ p4) ;(if (and (> 0.00001 (- (nth 1 p3) (nth 1 p4))) ; (< -0.00001 (- (nth 1 p3) (nth 1 p4)))) (putnum)) )) (setq i (+ i 1)) )) (princ) ) (defun procced(/ p3 p4 p5 i) (if (> (length ls1) 1) (progn (setq i 0) (command "dim") (while (< i (- (length ls1) 1)) (progn (setq p3 (list (nth 0 p1) (nth i ls1) 0 )) (setq p4 (list (nth 0 p1) (nth (+ i 1) ls1) 0 )) (setq p5 (list (nth 0 p2) (nth 1 p2) (nth 2 p1)) ) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (command "ver" p3 p4 p5 "")) (setq i (+ i 1)) )) (command "exit") )) (princ) ) (import) (ai_undo_push) (setq omd (getvar "osmode")) (setvar "osmode" 0) (procced) (setvar "osmode" omd) (ai_undo_pop) (princ) ) (defun c:h2(/ data_m ls1 p1 omd) (defun import(/ i ent p3 p4) (defun putnum(/ j k l ls3) ; (princ p3) (if (= nil ls1) (setq ls1 (list (nth 0 p3))) (progn (setq ls3 '() j 0 k 0) (while (and (< j (length ls1)) (= k 0)) (progn (if (< (nth 0 p3) (nth j ls1)) (setq k 1) (progn (if (= nil ls3) (setq ls3 (list (nth j ls1)) ) (setq ls3 (append ls3 (list (nth j ls1))))) (setq j (+ j 1)) ; (princ *x*) )) )) ; (princ j) (if (= nil ls3) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 0 p3) (nth j ls1)))) ) (if (or (= nil k) (> k 0.0001)) (setq ls3 (list (nth 0 p3))) ; (princ "a") )) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 0 p3) (nth j ls1)))) ) (if (> j 0) (setq l (abs (- (nth 0 p3) (nth (- j 1) ls1)))) ) ; (princ k) (princ l) (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) (setq ls3 (append ls3 (list (nth 0 p3)))) ) ; (princ "b") )) ; (princ ls3) (while (< j (length ls1)) (progn (setq ls3 (append ls3 (list (nth j ls1)))) (setq j (+ j 1)) ; (princ ls3) )) (setq ls1 ls3) )) ; (princ ls1) (princ) ) (setq data_m (ssget) ls1 '()) (setq p1 (getpoint "\nPick point")) (setq i 0) (while (< i (sslength data_m)) (progn (setq ent (entget (ssname data_m i))) ;(princ ent) (if (= "LINE" (cdr (assoc 0 ent))) (progn (setq p3 (cdr (assoc 10 ent))) (setq p4 (cdr (assoc 11 ent))) (if (and (> 0.00001 (- (nth 0 p3) (nth 0 p4))) (< -0.00001 (- (nth 0 p3) (nth 0 p4)))) (putnum)) )) (setq i (+ i 1)) )) (princ) ) (defun procced(/ s1) (defun putnumber(/ i p2) ; (princ ls1) (if (= nil startnb) (setq startnb 1)) (setq i (getint "\nEnter first number : ")) (if (not (= nil i)) (setq startnb i)) (setq i 0) (while (< i (- (length ls1) 1)) (progn (setq p2 (list (nth i ls1) (nth 1 p1) 0)) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb))) )) (setq i (+ i 1)) )) (if (< i (length ls1)) (progn (setq p2 (list (nth i ls1) (nth 1 p1) 0)) (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb))) )) (princ) ) (defun putchar(/ i) ; (princ ls1) (if (= nil startnb) (setq startnb 0)) (setq i "asd") (while (or (= nil i) (or (= " " i) (< 1 (strlen i)) ) ) (setq i (getstring "\nEnter charater : "))) (if (not (= nil i)) (setq startnb (ascii (strcase i)))) (setq i 0) (while (< i (- (length ls1) 1)) (progn (setq p2 (list (nth i ls1) (nth 1 p1) 0)) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (chr (+ i startnb))) )) (setq i (+ i 1)) )) (if (< i (length ls1)) (progn (setq p2 (list (nth i ls1) (nth 1 p1) 0)) (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (chr (+ i startnb))) )) (princ) ) (if (> (length ls1) 0) (progn (initget 1 "Number Charater N C n c") (setq s1 (getkword "\nNumber/Charater : ")) (if (not (= nil s1)) (progn (if (or (= (strcase s1) "NUMBER") (= (strcase s1) "N") ) (putnumber) (putchar)) )) )) ) (import) (setq omd (getvar "osmode")) (setvar "osmode" 0) (ai_undo_push) (procced) (ai_undo_pop) (setvar "osmode" omd) (princ) ) (defun c:v2(/ data_m ls1 p1 omd) (defun import(/ i ent p3 p4) (defun putnum(/ j k l ls3) ; (princ p3) (if (= nil ls1) (setq ls1 (list (nth 1 p3))) (progn (setq ls3 '() j 0 k 0) (while (and (< j (length ls1)) (= k 0)) (progn (if (< (nth 1 p3) (nth j ls1)) (setq k 1) (progn (if (= nil ls3) (setq ls3 (list (nth j ls1)) ) (setq ls3 (append ls3 (list (nth j ls1))))) (setq j (+ j 1)) ; (princ *x*) )) )) ; (princ j) (if (= nil ls3) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 1 p3) (nth j ls1)))) ) (if (or (= nil k) (> k 0.0001)) (setq ls3 (list (nth 1 p3))) ; (princ "a") )) (progn (setq k nil l nil) (if (< j (length ls1)) (setq k (abs (- (nth 1 p3) (nth j ls1)))) ) (if (> j 0) (setq l (abs (- (nth 1 p3) (nth (- j 1) ls1)))) ) ; (princ k) (princ l) (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) (setq ls3 (append ls3 (list (nth 1 p3)))) ) ; (princ "b") )) ; (princ ls3) (while (< j (length ls1)) (progn (setq ls3 (append ls3 (list (nth j ls1)))) (setq j (+ j 1)) ; (princ ls3) )) (setq ls1 ls3) )) ; (princ ls1) (princ) ) (setq data_m (ssget) ls1 '()) (setq p1 (getpoint "\nPick point")) (setq i 0) (while (< i (sslength data_m)) (progn (setq ent (entget (ssname data_m i))) ;(princ ent) (if (= "LINE" (cdr (assoc 0 ent))) (progn (setq p3 (cdr (assoc 10 ent))) (setq p4 (cdr (assoc 11 ent))) (if (and (> 0.00001 (- (nth 1 p3) (nth 1 p4))) (< -0.00001 (- (nth 1 p3) (nth 1 p4)))) (putnum)) )) (setq i (+ i 1)) )) (princ) ) (defun procced(/ s1) (defun putnumber(/ i p2) ; (princ ls1) (if (= nil startnb) (setq startnb 1)) (setq i (getint "\nEnter first number : ")) (if (not (= nil i)) (setq startnb i)) (setq i 0) (while (< i (- (length ls1) 1)) (progn (setq p2 (list (nth 0 p1) (nth i ls1) 0)) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb))) )) (setq i (+ i 1)) )) (if (< i (length ls1)) (progn (setq p2 (list (nth 0 p1) (nth i ls1) 0)) (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb))) )) (princ) ) (defun putchar(/ i) ; (princ ls1) (if (= nil startnb) (setq startnb 0)) (setq i "asd") (while (or (= nil i) (or (= " " i) (< 1 (strlen i)) ) ) (setq i (getstring "\nEnter charater : "))) (if (not (= nil i)) (setq startnb (ascii (strcase i)))) (setq i 0) (while (< i (- (length ls1) 1)) (progn (setq p2 (list (nth 0 p1) (nth i ls1) 0)) (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (chr (+ i startnb))) )) (setq i (+ i 1)) )) (if (< i (length ls1)) (progn (setq p2 (list (nth 0 p1) (nth i ls1) 0)) (command "circle" p2 300) (command "text" "j" "mc" p2 300 0 (chr (+ i startnb))) )) (princ) ) (if (> (length ls1) 0) (progn (initget 1 "Number Charater N C n c") (setq s1 (getkword "\nNumber/Charater : ")) (if (not (= nil s1)) (progn (if (or (= (strcase s1) "NUMBER") (= (strcase s1) "N") ) (putnumber) (putchar)) )) )) ) (import) (ai_undo_push) (setq omd (getvar "osmode")) (setvar "osmode" 0) (procced) (setvar "osmode" omd) (ai_undo_pop) (princ) ) ;====== OO (oo) ======= (defun c:OO(/ data_m) (defun import_data(/ i) (setq data_m (ssget)) (if (= nil distan_m) (setq distan_m 110.0)) (princ "Distance (") (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) )
Lisp OFFSET 2 BÊN (OO) :
(defun c:oo(/ data_m) (defun import_data(/ i) (setq data_m (ssget)) (if (= nil distan_m) (setq distan_m 110.0)) (princ "Distance (") (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) )
<<
| ||
Tác giả: duy267 Bài viết gốc: 198421 Tên lệnh: lpa |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
| ||
Tác giả: Tue_NV Bài viết gốc: 114659 Tên lệnh: tlt |
Nhờ sửa LISP ghi độ dốc đường thẳng
| ||
Tác giả: Doan Nguyen Van Bài viết gốc: 433852 Tên lệnh: test |
Nhờ các bác tạo giúp lisp cộng trừ số của TEXT OVERRIDE DIm
| ||
Tác giả: jangboko Bài viết gốc: 414696 Tên lệnh: adjustdim selfadjustdim |
Lisp dim khoảng cách liên tiếp trên Polyline - Pline
| ||
Tác giả: thanhduan2407 Bài viết gốc: 433992 Tên lệnh: 00 |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Với ý tưởng tạo đường bao tối ưu chứa tập hợp các điểm Point và khoảng cách giữa các đoạn không vượt quá con số a nào đó nhằm tìm kiếm đường bao tối ưu bám sát các điểm nhất. Em đã cố gắng nghiên cứu rất lâu rồi nhưng chưa tìm ra cách. Mong các Pro chỉ giáo, viết hoặc gợi ý cho em với ạ! Em có sưu tầm được lisp của Lee-Mac về đường bao lồi Convex Hull nhưng chưa chỉnh... >> Với ý tưởng tạo đường bao tối ưu chứa tập hợp các điểm Point và khoảng cách giữa các đoạn không vượt quá con số a nào đó nhằm tìm kiếm đường bao tối ưu bám sát các điểm nhất. Em đã cố gắng nghiên cứu rất lâu rồi nhưng chưa tìm ra cách. Mong các Pro chỉ giáo, viết hoặc gợi ý cho em với ạ! Em có sưu tầm được lisp của Lee-Mac về đường bao lồi Convex Hull nhưng chưa chỉnh sửa được theo đúng ý mình. Em xin gửi code tham khảo lên đây và hình ảnh. Cảm ơn các bác đã quan tâm.
(defun C:00 (/ LST LTSPOINT SSPOINT X )
(setq ssPoint (ssget '((0 . "POINT"))))
(if ssPoint
(progn
(setq LtsPoint (LM:ss->ent ssPoint))
(setq lst (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) LtsPoint))
(setq lst (LM:ConvexHull lst))
(entmakex
(append
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
'(070 . 1)
)
(mapcar '(lambda (x) (cons 10 x)) lst)
)
)
)
)
(princ)
)
;; Convex Hull - Lee Mac
;; Implements the Graham Scan Algorithm to return the Convex Hull of
;; a
;; list of
;; points.
(defun LM:ConvexHull (lst / ch p0)
(cond
((< (length lst) 4) lst)
((setq p0 (car lst))
(foreach p1 (cdr lst)
(if (or (< (cadr p1) (cadr p0))
(and (equal (cadr p1) (cadr p0) 1e-8)
(< (car p1) (car p0))
)
)
(setq p0 p1)
)
)
(setq lst
(vl-sort
lst
(function
(lambda (a b / c d)
(if
(equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
(< (distance p0 a) (distance p0 b))
(< c d)
)
)
)
)
)
(setq ch (list (caddr lst) (cadr lst) (car lst)))
(foreach pt (cdddr lst)
(setq ch (cons pt ch))
(while
(and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
(setq ch (cons pt (cddr ch)))
)
)
ch
)
)
)
;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear
(defun LM:Clockwise-p (p1 p2 p3)
(< (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
1e-8
)
)
(defun LM:ss->ent (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
https://s844.photobucket.com/user/thanhduan2407/media/sssss_zpsxbqp2zsn.png.html
<<
| ||
Tác giả: 790312 Bài viết gốc: 68879 Tên lệnh: sd |
Viết Lisp theo yêu cầu
|
Trang 286/330