Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Dynamic Polar Array


  • Please log in to reply
19 replies to this topic

#1 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2011 - 12:20 AM

Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.
Cho phép tăng dần đối với Text (như bản Dynamic Larray)
Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch

Preview :
Hình đã gửi
Open Source :

;Polar Array @Ketxu 22-9
;CADViet.com
;Many thank to qjchen again
(vl-load-com)
(defun c:par( / ang angnow gr oang p0 px px1 ss ss1 cc oldAng ans)
(grtext -1 "Dynamic PArray @Ketxu")
(setq m:err *error* *error* err)
(command "undo" "be")
(setq oldAng (getvar "angbase"))
(if (and
(setq ss (ST:SS->List-Vla (ssget))
p0 (getpoint "\nT\U+00E2m quay : :")
px (getpoint p0 "\n\U+0110\U+01B0\U+1EDDng c\U+01A1 s\U+1EDF ::")
)
)
(progn
(grdraw p0 px 1)
(setvar "angbase" (angle p0 px))
(setq cc (_circle p0 (distance p0 px))
ang (getangle p0 "\nG\U+00F3c Array :")
s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
)
(cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ss))
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
(cond ((not (or (= ans "K")(= ans "")))
(or #num (setq #num 1))
(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
)
)
)
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
(if ss1 (mapcar 'vla-delete ss1))
(redraw)
(setq angnow (angle p0 (cadr gr))
g (trans (cadr gr) 1 3)
)
(grvecs (LM:GrText (rtos (/ (* angnow 180) pi) 2 0) 3)
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s
(+ (car g) (* 15 s))
(- (cadr g) (* 31 s))
)
)
(if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi))))
(if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow)))
(setq ss1 (_copyCC ss (fix (/ angnow ang)) p0 ang inc #num))
(grdraw:arc p0 (/ (getvar "viewsize") 4.0) (angle p0 px) angnow)
)
(entdel cc)
;(setvar "angbase" oldAng)
)
)
(command "undo" "en")
(princ)
)

;;; =======================================================================;
;;; by qjchen, copy ss according to the direction and vector ;
;;; =======================================================================;
(defun _copyCC (sslst n cen ang inc num / i obj1 ss xobj lst number)
(foreach xobj sslst
(setq i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (setq number (last (setq lst (ST:String-GetNumber (vla-get-textstring xobj)))))))
(setq isReal T))
(T (setq isReal nil))
)
(setq isText T)
) ;Text Object
(T setq isText nil)
)
(repeat n
(setq obj1 (vla-copy xobj))
(Vla-rotate obj1 (vlax-3d-point cen) (* ang i))
(if (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (+ num number)) 2 (if isReal 1 0))(cadr lst))))
(setq i (1+ i) ss (cons obj1 ss))
)
)
ss
)
;;; =======================================================================;
;;; @Ketxu Make Circle Temp ;
;;; =======================================================================;
(defun _circle (p0 r / ent)
(redraw (setq ent(entmakex (list (cons 0 "CIRCLE")(cons 10 (trans p0 1 0))(cons 40 r)))) 3) ent)

(defun RtD (rad) ; converts radian to degree
(/ (* rad 180) pi)
);defun
;;; =======================================================================;
;;; Check List Item Exist in Other List @Ketxu ;
;;; =======================================================================;
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1))))
;;; =======================================================================;
;;; Selection to list VLA @Ketxu ;
;;; =======================================================================;
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
;;; =======================================================================;
;;; grdraw circle arc ;
;;; =======================================================================;
(defun grdraw:arc(cen r ang angadd / angdiv n)
(grdraw cen (polar cen ang r) 3 1)
(grdraw cen (polar cen (+ ang angadd) r) 3 1)
(setq n 100 angdiv (/ angadd n))
(repeat n
(grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1)
)
)
(defun ST:String-GetNumber (str / i j dau cuoi tmp tmp1 tmp2 num)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str)))) (atof num) (atoi num))
)
)

;;; =======================================================================;
;;; Error del selection @Ketxu ;
;;; =======================================================================;
(defun err (msg)
(if ss1 (mapcar 'vla-delete ss1))
(if cc (entdel cc))
(if oldAng (setvar "angbase" oldAng))
(setq *error* m:err m:err nil)
)
(defun LM:GrText ( str col / c i l v y ) ;@Lee Mac

(setq v
'(
(" ")
("\t")
("!" 45 45 65 135)
("\"" 104 134 107 137)
("#" 43 63 46 66 84 94 87 97 115 135 118 138 72 78 103 109)
("$" 25 35 52 52 43 47 58 78 83 87 92 112 123 127 118 118 135 135)
("%" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129 47 48 67 68 56 56 59 59 113 114 133 134 122 122 125 125)
("&" 43 46 49 49 52 72 57 58 67 68 76 76 79 79 83 83 85 85 94 94 103 123 134 136 127 127)
("'" 105 135)
("(" 17 17 26 36 45 105 116 126 137 137)
(")" 14 14 25 35 46 106 115 125 134 134)
("*" 73 74 76 77 84 86 92 98 104 106 113 114 116 117)
("+" 55 115 82 84 86 88)
("," 34 35 45 46 55 57)
("-" 83 88)
("." 45 46 55 56)
("/" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129)
("0" 44 47 134 137 53 123 58 128)
("1" 44 48 124 125 56 136)
("2" 43 48 53 53 64 64 75 75 86 86 97 97 108 128 134 137 123 123)
("3" 53 53 44 47 58 88 95 97 108 128 134 137 123 123)
("4" 46 48 57 137 78 78 73 76 83 83 94 94 105 115 126 126)
("5" 53 53 44 47 58 88 94 97 93 133 134 138)
("6" 44 47 58 88 95 97 84 84 53 113 124 124 135 137)
("7" 44 54 65 75 86 96 107 117 128 138 133 137 123 123)
("8" 44 47 94 97 134 137 53 83 58 88 103 123 108 128)
("9" 44 46 57 57 68 128 97 97 84 86 134 137 93 123)
(":" 45 46 55 56 95 96 105 106)
(";" 34 35 45 46 55 57 95 96 105 106)
("<" 47 47 56 56 65 65 74 74 83 83 94 94 105 105 116 116 127 127)
("=" 73 78 93 98)
(">" 43 43 54 54 65 65 76 76 87 87 96 96 105 105 114 114 123 123)
("?" 45 45 65 75 86 86 97 97 108 128 134 137 123 123)
("@" 34 38 43 43 52 112 123 123 134 137 128 128 79 119 68 68 65 66 105 106 77 107 74 94)
("A" 41 43 47 49 52 62 58 68 73 77 83 93 87 97 104 114 106 116 125 135 133 134)
("B" 42 47 53 123 58 88 108 128 94 97 132 137)
("C" 44 47 53 53 58 58 62 112 123 123 134 136 127 127 108 138)
("D" 42 46 57 57 127 127 132 136 68 118 53 123)
("E" 42 48 58 58 94 95 86 106 132 137 128 138 53 123)
("F" 42 45 94 95 86 106 132 137 128 138 53 123)
("G" 44 47 53 53 58 78 86 89 62 112 123 123 134 136 127 127 108 138)
("H" 41 43 47 49 131 133 137 139 93 97 52 122 58 128)
("I" 43 47 133 137 55 125)
("J" 52 62 43 46 57 127 135 139)
("K" 42 44 48 49 132 134 136 138 53 123 84 85 95 95 106 116 127 127 76 76 67 67 58 58)
("L" 42 47 48 58 53 123 132 135)
("M" 41 43 47 49 52 122 58 128 131 132 138 139 103 113 107 117 84 94 86 96 65 75)
("N" 41 44 131 132 136 139 52 122 48 128 113 113 94 104 85 85 66 76 57 57)
("O" 44 46 53 53 57 57 123 123 127 127 134 136 62 112 68 118)
("P" 42 45 84 87 132 137 53 123 98 128)
("Q" 134 136 123 123 127 127 112 62 118 68 53 53 57 57 44 46 35 36 23 24 27 28)
("R" 42 44 48 49 132 137 123 53 128 98 84 87 76 76 67 67 58 58)
("S" 42 62 53 53 44 47 58 78 86 87 93 95 102 122 133 136 127 127 118 138)
("T" 43 47 55 125 132 138 131 121 139 129)
("U" 44 46 52 53 57 58 62 122 68 128 131 133 137 139)
("V" 45 55 64 74 66 76 83 103 87 107 112 122 118 128 131 133 137 139)
("W" 43 63 47 67 72 92 74 94 76 96 78 98 101 121 105 115 109 129 131 132 138 139)
("X" 41 43 47 49 131 133 137 139 52 52 58 58 63 63 67 67 74 74 76 76 85 95 104 104 106 106 113 113 117 117 122 122 128 128)
("Y" 43 47 55 85 94 94 96 96 103 113 107 117 122 122 128 128 131 133 137 139)
("Z" 122 122 58 58 132 138 42 48 128 128 52 52 63 63 74 74 85 95 106 106 117 117)
("[" 15 17 135 137 25 125)
("\\" 122 122 113 113 104 104 95 95 86 86 77 77 68 68 59 59)
("]" 14 16 134 136 26 126)
("^" 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
("_" 21 29)
("`" 125 125 134 134)
("a" 43 46 48 48 52 72 57 97 83 86 103 106)
("b" 42 43 45 46 54 54 57 58 68 98 97 97 105 106 94 94 132 132 53 133)
("c" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 108 108)
("d" 44 45 47 48 52 92 53 53 56 56 93 93 104 105 96 96 136 136 57 137)
("e" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 88 88 73 78)
("f" 43 46 54 124 93 93 95 96 135 137 128 128)
("g" 13 16 22 32 27 97 107 108 66 66 96 96 54 55 104 105 63 63 93 93 62 92)
("h" 42 44 46 48 57 97 53 133 132 132 94 94 105 106)
("i" 43 47 55 105 103 104 135 135)
("j" 22 22 13 15 26 106 104 105 136 136)
("k" 42 44 46 48 53 133 132 132 57 57 66 66 74 75 85 85 96 106 107 108)
("l" 43 47 55 135 133 134)
("m" 41 43 45 46 48 49 52 102 55 105 58 108 101 101 93 93 104 104 96 96 107 107)
("n" 42 44 46 48 53 103 57 97 102 102 94 94 105 106)
("o" 44 46 104 106 53 53 57 57 93 93 97 97 52 92 58 98)
("p" 12 15 23 103 102 102 54 54 94 94 45 46 105 106 57 58 97 98 68 88)
("q" 15 18 27 107 108 108 56 56 96 96 44 45 104 105 52 53 92 93 62 82)
("r" 42 46 54 104 102 103 95 95 106 108 99 99)
("s" 52 52 43 47 58 68 73 77 82 92 103 107 98 98)
("t" 45 47 58 58 54 124 102 103 105 107)
("u" 102 102 106 106 53 103 56 56 44 45 47 107 48 48)
("v" 45 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("w" 43 53 47 57 62 92 64 84 66 86 68 98 101 103 95 105 107 109)
("x" 42 44 46 48 102 104 106 108 53 53 57 57 93 93 97 97 64 64 66 66 84 84 86 86 75 75)
("y" 12 13 24 24 35 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("z" 92 92 58 58 102 108 42 48 97 97 86 86 75 75 64 64 53 53)
("{" 16 17 25 65 73 74 85 125 136 137)
("|" 15 135)
("}" 14 15 26 66 77 78 86 126 134 135)
("~" 112 122 133 134 125 125 116 117 128 138)
)
)
(eval
(list 'defun 'LM:GrText '( str col / c i l v y )
(list 'setq 'v
(list 'quote
(mapcar
(function
(lambda ( b )
(cons (car B) (mapcar '(lambda ( a ) (if a (list (rem a 10) (/ a 10)))) (cdr B)))
)
)
v
)
)
)
'(setq i 0 y 0)

'(repeat (strlen str)
(cond
( (eq (setq c (substr str 1 1)) " ")
(setq i (+ i 9) str (substr str 2))
)
( (eq c "\t")
(setq i (+ i 36) str (substr str 2))
)
( (eq c "\n")
(setq i 0 y (- y 16) str (substr str 2))
)
( (setq l
(cons
(mapcar
(function
(lambda ( a )
(if a (list (+ (car a) i) (+ (cadr a) y)))
)
)
(cdr (assoc c v))
)
l
)
str (substr str 2) i (+ i 9)
)
)
)
)
'(cons col (apply 'append l))
)
)
(LM:GrText str col)
)

  • 6

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#2 TKTXVD

TKTXVD

    biết vẽ arc

  • Members
  • PipPip
  • 41 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 23 September 2011 - 08:23 AM

Quá chuẩn, thanks bac ketxu nhé...
  • 0

#3 matden_304

matden_304

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 September 2011 - 09:12 AM

Rải trên cung tròn thì sao nhỉ. lisp rdt của anh Duy ko rải kín đc. cài này rải kín đc mà phải biết tâm.hiiii
Chạy tốt quá, thích nhất khoản rê chuột^^
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2011 - 09:16 AM

OK,

Chạy tốt quá. Anh bổ sung thêm chỗ này thử đc ko anh ketxu
Ngay chỗ lựa chọn góc Array đó, anh thay bằng lựa chọn là Array theo góc hay theo pick chọn điểm. nếu pick điểm thì chọn điểm base point, rồi chọn điểm copy đến, nó sẽ quay theo tâm đã chọn. Nếu mình chọn Góc array thì chạy như lisp trên.

Thích nhất cái khoản rê chuột^^

Đã sửa, bạn có thể pick điểm hoặc đánh số. Vấn đề đau đầu nhất là góc âm hẹn đi du lịch về mình giải quyết tiếp. Khà khà
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 23 September 2011 - 09:05 PM

Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.
Cho phép tăng dần đối với Text (như bản Dynamic Larray)
Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch

Preview :
Hình đã gửi
Open Source :


;Polar Array @Ketxu 22-9
;CADViet.com
;Many thank to qjchen again
(vl-load-com)
(defun c:par( / ang angnow gr oang p0 px px1 ss ss1 cc oldAng ans)
(grtext -1 "Dynamic PArray @Ketxu")
(setq m:err *error* *error* err)
(command "undo" "be")
(setq oldAng (getvar "angbase"))
(if (and
(setq ss (ST:SS->List-Vla (ssget))
p0 (getpoint "\nT\U+00E2m quay : :")
px (getpoint p0 "\n\U+0110\U+01B0\U+1EDDng c\U+01A1 s\U+1EDF ::")
)
)
(progn
(grdraw p0 px 1)
(setvar "angbase" (angle p0 px))
(setq cc (_circle p0 (distance p0 px))
ang (getangle p0 "\nG\U+00F3c Array :")
s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
)
(cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ss))
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
(cond ((not (or (= ans "K")(= ans "")))
(or #num (setq #num 1))
(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
)
)
)
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
(if ss1 (mapcar 'vla-delete ss1))
(redraw)
(setq angnow (angle p0 (cadr gr))
g (trans (cadr gr) 1 3)
)
(grvecs (LM:GrText (rtos (/ (* angnow 180) pi) 2 0) 3)
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s
(+ (car g) (* 15 s))
(- (cadr g) (* 31 s))
)
)
(if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi))))
(if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow)))
(setq ss1 (_copyCC ss (fix (/ angnow ang)) p0 ang inc #num))
(grdraw:arc p0 (/ (getvar "viewsize") 4.0) (angle p0 px) angnow)
)
(entdel cc)
;(setvar "angbase" oldAng)
)
)
(command "undo" "en")
(princ)
)

;;; =======================================================================;
;;; by qjchen, copy ss according to the direction and vector ;
;;; =======================================================================;
(defun _copyCC (sslst n cen ang inc num / i obj1 ss xobj lst number)
(foreach xobj sslst
(setq i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (setq number (last (setq lst (ST:String-GetNumber (vla-get-textstring xobj)))))))
(setq isReal T))
(T (setq isReal nil))
)
(setq isText T)
) ;Text Object
(T setq isText nil)
)
(repeat n
(setq obj1 (vla-copy xobj))
(Vla-rotate obj1 (vlax-3d-point cen) (* ang i))
(if (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (+ num number)) 2 (if isReal 1 0))(cadr lst))))
(setq i (1+ i) ss (cons obj1 ss))
)
)
ss
)
;;; =======================================================================;
;;; @Ketxu Make Circle Temp ;
;;; =======================================================================;
(defun _circle (p0 r / ent)
(redraw (setq ent(entmakex (list (cons 0 "CIRCLE")(cons 10 (trans p0 1 0))(cons 40 r)))) 3) ent)

(defun RtD (rad) ; converts radian to degree
(/ (* rad 180) pi)
);defun
;;; =======================================================================;
;;; Check List Item Exist in Other List @Ketxu ;
;;; =======================================================================;
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1))))
;;; =======================================================================;
;;; Selection to list VLA @Ketxu ;
;;; =======================================================================;
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
;;; =======================================================================;
;;; grdraw circle arc ;
;;; =======================================================================;
(defun grdraw:arc(cen r ang angadd / angdiv n)
(grdraw cen (polar cen ang r) 3 1)
(grdraw cen (polar cen (+ ang angadd) r) 3 1)
(setq n 100 angdiv (/ angadd n))
(repeat n
(grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1)
)
)
(defun ST:String-GetNumber (str / i j dau cuoi tmp tmp1 tmp2 num)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str)))) (atof num) (atoi num))
)
)

;;; =======================================================================;
;;; Error del selection @Ketxu ;
;;; =======================================================================;
(defun err (msg)
(if ss1 (mapcar 'vla-delete ss1))
(if cc (entdel cc))
(setvar "angbase" oldAng)
(setq *error* m:err m:err nil)
)
(defun LM:GrText ( str col / c i l v y ) ;@Lee Mac

(setq v
'(
(" ")
("\t")
("!" 45 45 65 135)
("\"" 104 134 107 137)
("#" 43 63 46 66 84 94 87 97 115 135 118 138 72 78 103 109)
("$" 25 35 52 52 43 47 58 78 83 87 92 112 123 127 118 118 135 135)
("%" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129 47 48 67 68 56 56 59 59 113 114 133 134 122 122 125 125)
("&" 43 46 49 49 52 72 57 58 67 68 76 76 79 79 83 83 85 85 94 94 103 123 134 136 127 127)
("'" 105 135)
("(" 17 17 26 36 45 105 116 126 137 137)
(")" 14 14 25 35 46 106 115 125 134 134)
("*" 73 74 76 77 84 86 92 98 104 106 113 114 116 117)
("+" 55 115 82 84 86 88)
("," 34 35 45 46 55 57)
("-" 83 88)
("." 45 46 55 56)
("/" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129)
("0" 44 47 134 137 53 123 58 128)
("1" 44 48 124 125 56 136)
("2" 43 48 53 53 64 64 75 75 86 86 97 97 108 128 134 137 123 123)
("3" 53 53 44 47 58 88 95 97 108 128 134 137 123 123)
("4" 46 48 57 137 78 78 73 76 83 83 94 94 105 115 126 126)
("5" 53 53 44 47 58 88 94 97 93 133 134 138)
("6" 44 47 58 88 95 97 84 84 53 113 124 124 135 137)
("7" 44 54 65 75 86 96 107 117 128 138 133 137 123 123)
("8" 44 47 94 97 134 137 53 83 58 88 103 123 108 128)
("9" 44 46 57 57 68 128 97 97 84 86 134 137 93 123)
(":" 45 46 55 56 95 96 105 106)
(";" 34 35 45 46 55 57 95 96 105 106)
("<" 47 47 56 56 65 65 74 74 83 83 94 94 105 105 116 116 127 127)
("=" 73 78 93 98)
(">" 43 43 54 54 65 65 76 76 87 87 96 96 105 105 114 114 123 123)
("?" 45 45 65 75 86 86 97 97 108 128 134 137 123 123)
("@" 34 38 43 43 52 112 123 123 134 137 128 128 79 119 68 68 65 66 105 106 77 107 74 94)
("A" 41 43 47 49 52 62 58 68 73 77 83 93 87 97 104 114 106 116 125 135 133 134)
("B" 42 47 53 123 58 88 108 128 94 97 132 137)
("C" 44 47 53 53 58 58 62 112 123 123 134 136 127 127 108 138)
("D" 42 46 57 57 127 127 132 136 68 118 53 123)
("E" 42 48 58 58 94 95 86 106 132 137 128 138 53 123)
("F" 42 45 94 95 86 106 132 137 128 138 53 123)
("G" 44 47 53 53 58 78 86 89 62 112 123 123 134 136 127 127 108 138)
("H" 41 43 47 49 131 133 137 139 93 97 52 122 58 128)
("I" 43 47 133 137 55 125)
("J" 52 62 43 46 57 127 135 139)
("K" 42 44 48 49 132 134 136 138 53 123 84 85 95 95 106 116 127 127 76 76 67 67 58 58)
("L" 42 47 48 58 53 123 132 135)
("M" 41 43 47 49 52 122 58 128 131 132 138 139 103 113 107 117 84 94 86 96 65 75)
("N" 41 44 131 132 136 139 52 122 48 128 113 113 94 104 85 85 66 76 57 57)
("O" 44 46 53 53 57 57 123 123 127 127 134 136 62 112 68 118)
("P" 42 45 84 87 132 137 53 123 98 128)
("Q" 134 136 123 123 127 127 112 62 118 68 53 53 57 57 44 46 35 36 23 24 27 28)
("R" 42 44 48 49 132 137 123 53 128 98 84 87 76 76 67 67 58 58)
("S" 42 62 53 53 44 47 58 78 86 87 93 95 102 122 133 136 127 127 118 138)
("T" 43 47 55 125 132 138 131 121 139 129)
("U" 44 46 52 53 57 58 62 122 68 128 131 133 137 139)
("V" 45 55 64 74 66 76 83 103 87 107 112 122 118 128 131 133 137 139)
("W" 43 63 47 67 72 92 74 94 76 96 78 98 101 121 105 115 109 129 131 132 138 139)
("X" 41 43 47 49 131 133 137 139 52 52 58 58 63 63 67 67 74 74 76 76 85 95 104 104 106 106 113 113 117 117 122 122 128 128)
("Y" 43 47 55 85 94 94 96 96 103 113 107 117 122 122 128 128 131 133 137 139)
("Z" 122 122 58 58 132 138 42 48 128 128 52 52 63 63 74 74 85 95 106 106 117 117)
("[" 15 17 135 137 25 125)
("\\" 122 122 113 113 104 104 95 95 86 86 77 77 68 68 59 59)
("]" 14 16 134 136 26 126)
("^" 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
("_" 21 29)
("`" 125 125 134 134)
("a" 43 46 48 48 52 72 57 97 83 86 103 106)
("b" 42 43 45 46 54 54 57 58 68 98 97 97 105 106 94 94 132 132 53 133)
("c" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 108 108)
("d" 44 45 47 48 52 92 53 53 56 56 93 93 104 105 96 96 136 136 57 137)
("e" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 88 88 73 78)
("f" 43 46 54 124 93 93 95 96 135 137 128 128)
("g" 13 16 22 32 27 97 107 108 66 66 96 96 54 55 104 105 63 63 93 93 62 92)
("h" 42 44 46 48 57 97 53 133 132 132 94 94 105 106)
("i" 43 47 55 105 103 104 135 135)
("j" 22 22 13 15 26 106 104 105 136 136)
("k" 42 44 46 48 53 133 132 132 57 57 66 66 74 75 85 85 96 106 107 108)
("l" 43 47 55 135 133 134)
("m" 41 43 45 46 48 49 52 102 55 105 58 108 101 101 93 93 104 104 96 96 107 107)
("n" 42 44 46 48 53 103 57 97 102 102 94 94 105 106)
("o" 44 46 104 106 53 53 57 57 93 93 97 97 52 92 58 98)
("p" 12 15 23 103 102 102 54 54 94 94 45 46 105 106 57 58 97 98 68 88)
("q" 15 18 27 107 108 108 56 56 96 96 44 45 104 105 52 53 92 93 62 82)
("r" 42 46 54 104 102 103 95 95 106 108 99 99)
("s" 52 52 43 47 58 68 73 77 82 92 103 107 98 98)
("t" 45 47 58 58 54 124 102 103 105 107)
("u" 102 102 106 106 53 103 56 56 44 45 47 107 48 48)
("v" 45 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("w" 43 53 47 57 62 92 64 84 66 86 68 98 101 103 95 105 107 109)
("x" 42 44 46 48 102 104 106 108 53 53 57 57 93 93 97 97 64 64 66 66 84 84 86 86 75 75)
("y" 12 13 24 24 35 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("z" 92 92 58 58 102 108 42 48 97 97 86 86 75 75 64 64 53 53)
("{" 16 17 25 65 73 74 85 125 136 137)
("|" 15 135)
("}" 14 15 26 66 77 78 86 126 134 135)
("~" 112 122 133 134 125 125 116 117 128 138)
)
)
(eval
(list 'defun 'LM:GrText '( str col / c i l v y )
(list 'setq 'v
(list 'quote
(mapcar
(function
(lambda ( b )
(cons (car B) (mapcar '(lambda ( a ) (if a (list (rem a 10) (/ a 10)))) (cdr B)))
)
)
v
)
)
)
'(setq i 0 y 0)

'(repeat (strlen str)
(cond
( (eq (setq c (substr str 1 1)) " ")
(setq i (+ i 9) str (substr str 2))
)
( (eq c "\t")
(setq i (+ i 36) str (substr str 2))
)
( (eq c "\n")
(setq i 0 y (- y 16) str (substr str 2))
)
( (setq l
(cons
(mapcar
(function
(lambda ( a )
(if a (list (+ (car a) i) (+ (cadr a) y)))
)
)
(cdr (assoc c v))
)
l
)
str (substr str 2) i (+ i 9)
)
)
)
)
'(cons col (apply 'append l))
)
)
(LM:GrText str col)
)

Thank Ket đã có 1 lisp hay. Sướng nhất là biết được cái (LM:GrText) mà lâu nay đang cần.
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#6 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 23 October 2011 - 01:33 PM

Có cái Dynamic Array theo đường thẳng rồi, tiện thể e đi cóp nhặt thêm về cái Dynamic copy rotate theo đường tròn nữa, post lên mọi người xài chơi.
Cho phép tăng dần đối với Text (như bản Dynamic Larray)
Mời mọi người dùng thư giãn và thanks nhé ^^ hệch hệch

Preview :
Hình đã gửi
Open Source :


;Polar Array @Ketxu 22-9
;CADViet.com
;Many thank to qjchen again
(vl-load-com)
(defun c:par( / ang angnow gr oang p0 px px1 ss ss1 cc oldAng ans)
(grtext -1 "Dynamic PArray @Ketxu")
(setq m:err *error* *error* err)
(command "undo" "be")
(setq oldAng (getvar "angbase"))
(if (and
(setq ss (ST:SS->List-Vla (ssget))
p0 (getpoint "\nT\U+00E2m quay : :")
px (getpoint p0 "\n\U+0110\U+01B0\U+1EDDng c\U+01A1 s\U+1EDF ::")
)
)
(progn
(grdraw p0 px 1)
(setvar "angbase" (angle p0 px))
(setq cc (_circle p0 (distance p0 px))
ang (getangle p0 "\nG\U+00F3c Array :")
s (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
)
(cond ((ST:Check-Exist '("AcDbText" "AcDbMText") (mapcar 'vla-get-objectname ss))
(setq ans (strcase(getstring "Copy t\U+0103ng Text ? < K > :")))
(cond ((not (or (= ans "K")(= ans "")))
(or #num (setq #num 1))
(setq #num (cond ((getint (strcat "\nGia s\U+1ED1 < " (rtos #num 2 0) " > :")))(#num)) inc T)
)
)
)
)
(prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
(while (= (car (setq gr (grread nil 5 0))) 5)
(if ss1 (mapcar 'vla-delete ss1))
(redraw)
(setq angnow (angle p0 (cadr gr))
g (trans (cadr gr) 1 3)
)
(grvecs (LM:GrText (rtos (/ (* angnow 180) pi) 2 0) 3)
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s
(+ (car g) (* 15 s))
(- (cadr g) (* 31 s))
)
)
(if (and (< ang 0)(> angnow 0)) (setq angnow (- angnow (* 2 pi))))
(if (and (> ang 0)(< angnow 0)) (setq angnow (+ (* 2 pi) angnow)))
(setq ss1 (_copyCC ss (fix (/ angnow ang)) p0 ang inc #num))
(grdraw:arc p0 (/ (getvar "viewsize") 4.0) (angle p0 px) angnow)
)
(entdel cc)
;(setvar "angbase" oldAng)
)
)
(command "undo" "en")
(princ)
)

;;; =======================================================================;
;;; by qjchen, copy ss according to the direction and vector ;
;;; =======================================================================;
(defun _copyCC (sslst n cen ang inc num / i obj1 ss xobj lst number)
(foreach xobj sslst
(setq i 1)
(cond ((and (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(cond ((= 'REAL (type (setq number (last (setq lst (ST:String-GetNumber (vla-get-textstring xobj)))))))
(setq isReal T))
(T (setq isReal nil))
)
(setq isText T)
) ;Text Object
(T setq isText nil)
)
(repeat n
(setq obj1 (vla-copy xobj))
(Vla-rotate obj1 (vlax-3d-point cen) (* ang i))
(if (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText") inc num)
(vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (+ num number)) 2 (if isReal 1 0))(cadr lst))))
(setq i (1+ i) ss (cons obj1 ss))
)
)
ss
)
;;; =======================================================================;
;;; @Ketxu Make Circle Temp ;
;;; =======================================================================;
(defun _circle (p0 r / ent)
(redraw (setq ent(entmakex (list (cons 0 "CIRCLE")(cons 10 (trans p0 1 0))(cons 40 r)))) 3) ent)

(defun RtD (rad) ; converts radian to degree
(/ (* rad 180) pi)
);defun
;;; =======================================================================;
;;; Check List Item Exist in Other List @Ketxu ;
;;; =======================================================================;
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1))))
;;; =======================================================================;
;;; Selection to list VLA @Ketxu ;
;;; =======================================================================;
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
(defun ST:Ss-Delete (ss / i)
(mapcar 'vla-delete (ST:SS->List-Vla ss))
)
;;; =======================================================================;
;;; grdraw circle arc ;
;;; =======================================================================;
(defun grdraw:arc(cen r ang angadd / angdiv n)
(grdraw cen (polar cen ang r) 3 1)
(grdraw cen (polar cen (+ ang angadd) r) 3 1)
(setq n 100 angdiv (/ angadd n))
(repeat n
(grdraw (polar cen ang r)(polar cen (setq ang (+ ang angdiv)) r) 1 1)
)
)
(defun ST:String-GetNumber (str / i j dau cuoi tmp tmp1 tmp2 num)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str)))) (atof num) (atoi num))
)
)

;;; =======================================================================;
;;; Error del selection @Ketxu ;
;;; =======================================================================;
(defun err (msg)
(if ss1 (mapcar 'vla-delete ss1))
(if cc (entdel cc))
(if oldAng (setvar "angbase" oldAng))
(setq *error* m:err m:err nil)
)
(defun LM:GrText ( str col / c i l v y ) ;@Lee Mac

(setq v
'(
(" ")
("\t")
("!" 45 45 65 135)
("\"" 104 134 107 137)
("#" 43 63 46 66 84 94 87 97 115 135 118 138 72 78 103 109)
("$" 25 35 52 52 43 47 58 78 83 87 92 112 123 127 118 118 135 135)
("%" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129 47 48 67 68 56 56 59 59 113 114 133 134 122 122 125 125)
("&" 43 46 49 49 52 72 57 58 67 68 76 76 79 79 83 83 85 85 94 94 103 123 134 136 127 127)
("'" 105 135)
("(" 17 17 26 36 45 105 116 126 137 137)
(")" 14 14 25 35 46 106 115 125 134 134)
("*" 73 74 76 77 84 86 92 98 104 106 113 114 116 117)
("+" 55 115 82 84 86 88)
("," 34 35 45 46 55 57)
("-" 83 88)
("." 45 46 55 56)
("/" 52 52 63 63 74 74 85 85 96 96 107 107 118 118 129 129)
("0" 44 47 134 137 53 123 58 128)
("1" 44 48 124 125 56 136)
("2" 43 48 53 53 64 64 75 75 86 86 97 97 108 128 134 137 123 123)
("3" 53 53 44 47 58 88 95 97 108 128 134 137 123 123)
("4" 46 48 57 137 78 78 73 76 83 83 94 94 105 115 126 126)
("5" 53 53 44 47 58 88 94 97 93 133 134 138)
("6" 44 47 58 88 95 97 84 84 53 113 124 124 135 137)
("7" 44 54 65 75 86 96 107 117 128 138 133 137 123 123)
("8" 44 47 94 97 134 137 53 83 58 88 103 123 108 128)
("9" 44 46 57 57 68 128 97 97 84 86 134 137 93 123)
(":" 45 46 55 56 95 96 105 106)
(";" 34 35 45 46 55 57 95 96 105 106)
("<" 47 47 56 56 65 65 74 74 83 83 94 94 105 105 116 116 127 127)
("=" 73 78 93 98)
(">" 43 43 54 54 65 65 76 76 87 87 96 96 105 105 114 114 123 123)
("?" 45 45 65 75 86 86 97 97 108 128 134 137 123 123)
("@" 34 38 43 43 52 112 123 123 134 137 128 128 79 119 68 68 65 66 105 106 77 107 74 94)
("A" 41 43 47 49 52 62 58 68 73 77 83 93 87 97 104 114 106 116 125 135 133 134)
("B" 42 47 53 123 58 88 108 128 94 97 132 137)
("C" 44 47 53 53 58 58 62 112 123 123 134 136 127 127 108 138)
("D" 42 46 57 57 127 127 132 136 68 118 53 123)
("E" 42 48 58 58 94 95 86 106 132 137 128 138 53 123)
("F" 42 45 94 95 86 106 132 137 128 138 53 123)
("G" 44 47 53 53 58 78 86 89 62 112 123 123 134 136 127 127 108 138)
("H" 41 43 47 49 131 133 137 139 93 97 52 122 58 128)
("I" 43 47 133 137 55 125)
("J" 52 62 43 46 57 127 135 139)
("K" 42 44 48 49 132 134 136 138 53 123 84 85 95 95 106 116 127 127 76 76 67 67 58 58)
("L" 42 47 48 58 53 123 132 135)
("M" 41 43 47 49 52 122 58 128 131 132 138 139 103 113 107 117 84 94 86 96 65 75)
("N" 41 44 131 132 136 139 52 122 48 128 113 113 94 104 85 85 66 76 57 57)
("O" 44 46 53 53 57 57 123 123 127 127 134 136 62 112 68 118)
("P" 42 45 84 87 132 137 53 123 98 128)
("Q" 134 136 123 123 127 127 112 62 118 68 53 53 57 57 44 46 35 36 23 24 27 28)
("R" 42 44 48 49 132 137 123 53 128 98 84 87 76 76 67 67 58 58)
("S" 42 62 53 53 44 47 58 78 86 87 93 95 102 122 133 136 127 127 118 138)
("T" 43 47 55 125 132 138 131 121 139 129)
("U" 44 46 52 53 57 58 62 122 68 128 131 133 137 139)
("V" 45 55 64 74 66 76 83 103 87 107 112 122 118 128 131 133 137 139)
("W" 43 63 47 67 72 92 74 94 76 96 78 98 101 121 105 115 109 129 131 132 138 139)
("X" 41 43 47 49 131 133 137 139 52 52 58 58 63 63 67 67 74 74 76 76 85 95 104 104 106 106 113 113 117 117 122 122 128 128)
("Y" 43 47 55 85 94 94 96 96 103 113 107 117 122 122 128 128 131 133 137 139)
("Z" 122 122 58 58 132 138 42 48 128 128 52 52 63 63 74 74 85 95 106 106 117 117)
("[" 15 17 135 137 25 125)
("\\" 122 122 113 113 104 104 95 95 86 86 77 77 68 68 59 59)
("]" 14 16 134 136 26 126)
("^" 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
("_" 21 29)
("`" 125 125 134 134)
("a" 43 46 48 48 52 72 57 97 83 86 103 106)
("b" 42 43 45 46 54 54 57 58 68 98 97 97 105 106 94 94 132 132 53 133)
("c" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 108 108)
("d" 44 45 47 48 52 92 53 53 56 56 93 93 104 105 96 96 136 136 57 137)
("e" 44 46 53 53 57 58 52 92 93 93 104 106 97 98 88 88 73 78)
("f" 43 46 54 124 93 93 95 96 135 137 128 128)
("g" 13 16 22 32 27 97 107 108 66 66 96 96 54 55 104 105 63 63 93 93 62 92)
("h" 42 44 46 48 57 97 53 133 132 132 94 94 105 106)
("i" 43 47 55 105 103 104 135 135)
("j" 22 22 13 15 26 106 104 105 136 136)
("k" 42 44 46 48 53 133 132 132 57 57 66 66 74 75 85 85 96 106 107 108)
("l" 43 47 55 135 133 134)
("m" 41 43 45 46 48 49 52 102 55 105 58 108 101 101 93 93 104 104 96 96 107 107)
("n" 42 44 46 48 53 103 57 97 102 102 94 94 105 106)
("o" 44 46 104 106 53 53 57 57 93 93 97 97 52 92 58 98)
("p" 12 15 23 103 102 102 54 54 94 94 45 46 105 106 57 58 97 98 68 88)
("q" 15 18 27 107 108 108 56 56 96 96 44 45 104 105 52 53 92 93 62 82)
("r" 42 46 54 104 102 103 95 95 106 108 99 99)
("s" 52 52 43 47 58 68 73 77 82 92 103 107 98 98)
("t" 45 47 58 58 54 124 102 103 105 107)
("u" 102 102 106 106 53 103 56 56 44 45 47 107 48 48)
("v" 45 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("w" 43 53 47 57 62 92 64 84 66 86 68 98 101 103 95 105 107 109)
("x" 42 44 46 48 102 104 106 108 53 53 57 57 93 93 97 97 64 64 66 66 84 84 86 86 75 75)
("y" 12 13 24 24 35 45 54 64 56 66 73 83 77 87 92 92 98 98 101 103 107 109)
("z" 92 92 58 58 102 108 42 48 97 97 86 86 75 75 64 64 53 53)
("{" 16 17 25 65 73 74 85 125 136 137)
("|" 15 135)
("}" 14 15 26 66 77 78 86 126 134 135)
("~" 112 122 133 134 125 125 116 117 128 138)
)
)
(eval
(list 'defun 'LM:GrText '( str col / c i l v y )
(list 'setq 'v
(list 'quote
(mapcar
(function
(lambda ( b )
(cons (car B) (mapcar '(lambda ( a ) (if a (list (rem a 10) (/ a 10)))) (cdr B)))
)
)
v
)
)
)
'(setq i 0 y 0)

'(repeat (strlen str)
(cond
( (eq (setq c (substr str 1 1)) " ")
(setq i (+ i 9) str (substr str 2))
)
( (eq c "\t")
(setq i (+ i 36) str (substr str 2))
)
( (eq c "\n")
(setq i 0 y (- y 16) str (substr str 2))
)
( (setq l
(cons
(mapcar
(function
(lambda ( a )
(if a (list (+ (car a) i) (+ (cadr a) y)))
)
)
(cdr (assoc c v))
)
l
)
str (substr str 2) i (+ i 9)
)
)
)
)
'(cons col (apply 'append l))
)
)
(LM:GrText str col)
)


Chào ketxu!
Lisp của ketxu rất hay, mình đã học được rất nhiều.
Mình hỏi Ketxu 1 vấn đề có liên quan đến GRREAD.
Đối với các hàm getxxx thì mình dùng initget để có các lựa chọn input khác. Vậy thằng Grread này có chức năng tương tự không ketxu?
Chẳng hạn như trong Lisp của ketxu, người dùng kéo rê chuột để chọn số lượng array; Có thể nào thêm lựa chọn khác để nhập, tỉ nhỉ bấm A để nhập góc tổng, bấm N để nhập trựctiếp số lượng ARRAY. Nếu không phải 2 lựa chọn trên thì kéo rê.
Mình nói rõ thêm là phương án kéo rê chuột ưu tiên không cần nhập Keyword, có 2 cách nhập kia mới nhập keyword.
Mình search vấn không có cách!
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 23 October 2011 - 03:52 PM

Chào ketxu!
Lisp của ketxu rất hay, mình đã học được rất nhiều.
Mình hỏi Ketxu 1 vấn đề có liên quan đến GRREAD.
Đối với các hàm getxxx thì mình dùng initget để có các lựa chọn input khác. Vậy thằng Grread này có chức năng tương tự không ketxu?
Chẳng hạn như trong Lisp của ketxu, người dùng kéo rê chuột để chọn số lượng array; Có thể nào thêm lựa chọn khác để nhập, tỉ nhỉ bấm A để nhập góc tổng, bấm N để nhập trựctiếp số lượng ARRAY. Nếu không phải 2 lựa chọn trên thì kéo rê.
Mình nói rõ thêm là phương án kéo rê chuột ưu tiên không cần nhập Keyword, có 2 cách nhập kia mới nhập keyword.
Mình search vấn không có cách!

Thấy bạn hỏi mà chưa thấy ai trả lời nên chém gió vài điều với bạn vậy.
1). Đỏ: thì bạn cứ dùng getxxx, đặt lựa chọn 1 và 2 là nhập góc và số lượng, lựa chọn 3 là nhập theo kiểu rê chuột. Khi lựa chọn 3 được chọn, chuột sẽ rê bằng grread. (Ket đã nhập đường cơ sở + góc, sau đó mới grread đó thôi).
2). Ngay trong khi đang dùng grread bạn cũng có thể nhập bằng getxxx, thậm chí gọi được dialoge. Quan trọng là có chút mẹo và rành về các var trong grread, bởi hàm này khá rắc rối. Tôi đã từng dùng, nhưng rất tiếc không up được.
Thân thương!
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 October 2011 - 06:58 PM

@Hochoaivandot : Tất cả đều thực hiện được :) Grread bắt được sự kiện keypress, nên đương nhiên sẽ có lựa chọn khi đang rê chuột, bác nhấn 1 phím nào đó thì sẽ xử lý hàm theo cond đó thôi. Nhưng có thể làm code rối hơn, nên bác có thể để keyword ở ngay đầu rồi mới phân chia thao tác cũng được mà ^^
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 12 March 2012 - 10:42 PM

@Hochoaivandot : Tất cả đều thực hiện được :) Grread bắt được sự kiện keypress, nên đương nhiên sẽ có lựa chọn khi đang rê chuột, bác nhấn 1 phím nào đó thì sẽ xử lý hàm theo cond đó thôi. Nhưng có thể làm code rối hơn, nên bác có thể để keyword ở ngay đầu rồi mới phân chia thao tác cũng được mà ^^


Lại hỏi mọi người 1 câu nữa cũng liên quan đến cái (LM:GrText) ni. Nếu mình muốn text hiển thị trong hàm (LM:GrText) có kích thước to hơn thì chỉnh ở chổ nào nhỉ?
Trong hàm (LM:GrText) hay trong hàm chính. ví dụ như hàm chính của chính tác giả Lee dưới đây.

(defun c:test ( / *error* vl g s )
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw) (princ)
)

(setq vl (LM:GrText "www.cadviet.com" 2 ))
(while (= 5 (car (setq g (grread nil 13 0)))) (redraw)
(setq s (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) g (trans (cadr g) 1 3))
(grvecs vl
(
(lambda ( r x y )
(list
(list r 0. 0. x )
(list 0. r 0. y )
(list 0. 0. r 0.)
(list 0. 0. 0. 1.)
)
)
s (+ (car g) (* 15 s)) (- (cadr g) (* 31 s))
)
)
)
(redraw) (princ)
)

  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#10 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 12 March 2012 - 11:29 PM

Biến s
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 12 June 2012 - 09:39 AM

Mình dùng qua lisp này thấy rất hay, Thanks ketxu
Sau khi chạy lisp này thì biến hệ thống LASTANGLE bị thay đổi, biến này không dùng setvar để gán lại được do nó là read only. Khi LASTANGLE bị thay đổi thì các text trước đó vần thầy bình thường nhưng vào properties của text thì thấy rotation đà bị thay đổi bằng với LASTANGLE. Các text được tạo sau này cũng bị quay theo
Mong Bạn hoàn thiện lisp tốt hơn
  • 0

#12 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 12 June 2012 - 05:07 PM

Biến Angbase mình thay đổi bạn ơi ^^ Lastangle luôn thay đổi khi có 1 chỉ số góc được nhập vào.
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#13 maimaiyeuem80

maimaiyeuem80

    biết zoom

  • Members
  • Pip
  • 14 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 24 June 2012 - 10:51 PM

em ko biết cái Dynamic Array theo đường thẳng bác ketxu giúp em với ! giả sử mình array 1 đối tượng chạy theo hình chữ s chẳng hạn ! giúp em với bác !!
thanks bác nhiều !

  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5681 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 24 June 2012 - 11:32 PM

Đường thẳng và hình chữ S nó giống nhau hả bạn ơi :) Nếu cần theo hình đó thì bạn cài CAD2012 rồi array path nhé
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#15 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 10 August 2014 - 02:28 PM

Nhờ a Ketxu post lại lisp par.lsp ạ, em dơn load về nó không chạy ạ :

 

Command: par
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command:
Select objects: Specify opposite corner: 1 found

Select objects:
Tâm quay : :
Đường cơ sở ::
Góc Array :
Pick điểm cuối cùng :

Command:

Rồi đứng im :wub:


  • 0

#16 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 10 August 2014 - 10:04 PM

load lisp báo lỗi :  ; error: extra right paren on input    là sao ta :wacko:


  • 0

#17 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 11 August 2014 - 03:32 PM

Nhờ các lisper pro chỉ giúp chỗ thêm dấu  )  vào code par.lsp ở chỗ nào cho nó chạy ạ :(


  • 0

#18 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 12 August 2014 - 07:55 AM

-Lisp không lỗi gì chạy bình thường. Khong nhập góc độ âm.


  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#19 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 12 August 2014 - 09:54 AM

-Lisp không lỗi gì chạy bình thường. Khong nhập góc độ âm.

Bạn test chưa? Mình load lisp nó báo lỗi :  ; error: extra right paren on input    là sao ta :wacko:, Khi nhập :

Command: par
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command:
Select objects: Specify opposite corner: 1 found

Select objects:
Tâm quay : :
Đường cơ sở ::
Góc Array :
Pick điểm cuối cùng :

Command:

Rồi đứng im :wub:....Mình xài Cad 2007 :(


  • 0

#20 ad.pham234

ad.pham234

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 25 November 2016 - 05:01 PM

sư huynh ơi lip không dùng được :(


  • 0