Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.



 
Trang ChínhGalleryLatest imagesĐăng kýĐăng Nhập
Đăng Nhập
Tên truy cập:
Mật khẩu:
Đăng nhập tự động mỗi khi truy cập: 
:: Quên mật khẩu
Top posters
Admin
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
tvgs
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
HotroAcad
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
ksphanle
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
engineer0405
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
quangthinh01
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
sumakho
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
quoctoa
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
M@trixs
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
tvgtyb08
Lisp Array theo đường tròn Vote_lcapLisp Array theo đường tròn Voting_barLisp Array theo đường tròn Vote_rcap 
Latest topics
» hotroacadv2.09
Lisp Array theo đường tròn Icon_minitimeMon Mar 30, 2015 11:14 pm by ninh621

» Phần mềm san nền + Phân lớp nền đường + Các ứng dụng
Lisp Array theo đường tròn Icon_minitimeMon Oct 06, 2014 8:59 am by tamky

» Bộ cài nova full trên Autocad 2005 và win7
Lisp Array theo đường tròn Icon_minitimeThu Apr 17, 2014 4:29 pm by frowin2013

» Chuyên nhận thi công tiểu cảnh sân vườn
Lisp Array theo đường tròn Icon_minitimeSun Apr 13, 2014 2:45 pm by stingdau

» Phần mềm tổ hợp nội lực từ SAP, ETABS,TK cấu kiện theo TCVN DSAP 2.x
Lisp Array theo đường tròn Icon_minitimeMon Mar 24, 2014 5:49 pm by nha.ksxd

» Ứng dụng HotroAcad hỗ trợ kết cấu xây dựng
Lisp Array theo đường tròn Icon_minitimeFri Mar 21, 2014 1:43 pm by HotroAcad

» Phần mềm soft_xdit thay thế phần mềm hotrocad
Lisp Array theo đường tròn Icon_minitimeWed Mar 12, 2014 2:31 pm by HotroAcad

» lisp Thước lỗ ban
Lisp Array theo đường tròn Icon_minitimeFri Dec 06, 2013 4:06 pm by leminhlapvl

»  MDW - Phần mềm tính toán móng đơn
Lisp Array theo đường tròn Icon_minitimeThu Dec 05, 2013 10:15 am by ngominhha

Thống Kê
Hiện có 1 người đang truy cập Diễn Đàn, gồm: 0 Thành viên, 0 Thành viên ẩn danh và 1 Khách viếng thăm

Không

Số người truy cập cùng lúc nhiều nhất là 10 người, vào ngày Mon Nov 07, 2022 3:26 pm
March 2024
MonTueWedThuFriSatSun
    123
45678910
11121314151617
18192021222324
25262728293031
CalendarCalendar
Tìm kiếm
 
 

Display results as :
 
Rechercher Advanced Search

 

 Lisp Array theo đường tròn

Go down 
2 posters
Tác giảThông điệp
HotroAcad
Trung úy
Trung úy
HotroAcad


Tổng số bài gửi : 40
Điểm : 88
Reputation : 15
Join date : 20/09/2011

Lisp Array theo đường tròn Empty
Bài gửiTiêu đề: Lisp Array theo đường tròn   Lisp Array theo đường tròn Icon_minitimeFri Sep 23, 2011 10:54 am

Lisp Array theo đường tròn của tác giả ketxu, mình post lại hy vọng tác giả không phiền lòng Very Happy

Lệnh : PAR

Code:
;; free lisp from cadviet.com
[/color][color=blue];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)
)[/color]

[color=blue]
Về Đầu Trang Go down
ksphanle
Trung úy
Trung úy
ksphanle


Tổng số bài gửi : 17
Điểm : 32
Reputation : 5
Join date : 21/09/2011

Lisp Array theo đường tròn Empty
Bài gửiTiêu đề: Re: Lisp Array theo đường tròn   Lisp Array theo đường tròn Icon_minitimeFri Sep 23, 2011 1:50 pm

HotroAcad đã viết:
Lisp Array theo đường tròn của tác giả ketxu, mình post lại hy vọng tác giả không phiền lòng Very Happy

Lệnh : PAR

Code:
;; free lisp from cadviet.com
[/color][color=blue];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)
)[/color]

[color=blue]
sao mình ko làm dc? nó ko yêu cầu select objects j cả nhỉ?
thanks!
Về Đầu Trang Go down
HotroAcad
Trung úy
Trung úy
HotroAcad


Tổng số bài gửi : 40
Điểm : 88
Reputation : 15
Join date : 20/09/2011

Lisp Array theo đường tròn Empty
Bài gửiTiêu đề: Re: Lisp Array theo đường tròn   Lisp Array theo đường tròn Icon_minitimeFri Sep 23, 2011 2:22 pm

Cậu kiểm tra xem đang để chế độ tiếng việt không, rồi chuyển sang chế độ tiếng anh!

Gõ lệnh PAR

Sau đó Select objects (chọn đối tượng)

-> Chọn tâm quay

-> Chọn bán kính

-> Nhập góc quay

-> Chọn điểm
Về Đầu Trang Go down
Sponsored content





Lisp Array theo đường tròn Empty
Bài gửiTiêu đề: Re: Lisp Array theo đường tròn   Lisp Array theo đường tròn Icon_minitime

Về Đầu Trang Go down
 
Lisp Array theo đường tròn
Về Đầu Trang 
Trang 1 trong tổng số 1 trang
 Similar topics
-
» Update tạo bảng thống kê thép tròn
» [Sưu tầm]Lisp căn lề chữ
» [Lisp]­Vẽ mũi tên 2 chiều
» lisp Thước lỗ ban
» [Lisp]Copy tăng dần

Permissions in this forum:Bạn không có quyền trả lời bài viết
 :: Phần mềm xây dựng - Giao thông - Hạ tầng kỹ thuật :: Chuyên về lisp [Sưu tầm]-
Chuyển đến