Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Bởi Jin Yong , trong AutoLisp

Các bài được khuyến nghị

ndtnv    481

ndtnv
Đã đăng

Trên cơ sở hàm tăng, bạn có thể viết hàm giảm bằng cách đảo cons của lt '(("1" . "0") ..., các chỗ khác thì đảo "0" <=> "F" là OK

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hiepttr    538

hiepttr
Đã đăng

Không am hiểu về hệ hex nên hỏi ngu tí :D

Bấm (handent-next "FFFFF...") mỏi tay cho ra "1000000"
Không hiểu đoạn này ? :D :D :D

Mắng thì OK, nhưng chém thì xin đừng các bác nhé ! :D

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

tien2005    242

tien2005
Đã đăng

@TRUNGNGAMY Bạn có thể dùng các hàm của LEE để chuyển đổi cho tổng quát

;; Base to Decimal  -  Lee Mac
;; Converts an number in an arbitrary base to decimal.
;; n - [str] string representing number to convert
;; b - [int] base of input string
;; Returns: [int] Decimal representation of supplied number

(defun LM:base->dec ( n b / l )
    (if (= 1 (setq l (strlen n)))
        (- (ascii n) (if (< (ascii n) 65) 48 55))
        (+ (* b (LM:base->dec (substr n 1 (1- l)) b)) (LM:base->dec (substr n l) b))
    )
)
;; Decimal to Base  -  Lee Mac
;; Converts a decimal number to another base.
;; n - [int] decimal integer
;; b - [int] non-zero positive integer base
;; Returns: [str] Representation of decimal in specified base

(defun LM:dec->base ( n b )
    (if (< n b)
        (chr (+ n (if (< n 10) 48 55)))
        (strcat (LM:dec->base (/ n b) b) (LM:dec->base (rem n b) b))
    )
)

ex: (LM:dec->base(1+ (LM:base->dec "B3A" 16))16) => "B3B"

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng

Không am hiểu về hệ hex nên hỏi ngu tí :D

 

Bấm (handent-next "FFFFF...") mỏi tay cho ra "1000000"

Không hiểu đoạn này ? :D :D :D

 

Mắng thì OK, nhưng chém thì xin đừng các bác nhé ! :D

Muốn tìm hiểu hex thì gg với key: Hexadecimal, tiếng Việt: Hệ thập lục phân

Muốn tính toán hệ Hexadecimal thì mở Calculator của win, chọn hex

FFFFF + 1 = 100000

 

Trong lập trình, hàm cụ thể chạy nhanh hơn hàm tổng quát.

Như đã nói ở #2701, tôi đã test code của ThuyLinh313 thấy nhanh hơn nhiều nên sau 2 năm vẫn còn nhớ.

Test với 3 trường hợp, code hex - dec  lấy ở link (để cho tương đương, tôi comment đoạn strcase) https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/td-p/2873916:

(defun STD-NUM->HEX (i / s a)
(setq s "")
(while (> i 0)
  (setq a (rem i 16)
     i (/ i 16)
  ) ;_  setq
  (setq s (strcat
     (if (< a 10)
      (chr (+ 48 a)) ; 48: (ascii "0")
      (chr (+ 55 a))
     ) ;_  if
     s
    ) ;_  strcat
  ) ;_  setq
) ;_  while
) ;_  defun
(defun STD-HEX->NUM (s / i n a)
;(std-%simple-require "STDSTR")
(setq i 0
    n 0
    ;s (std-strcase s)
    ;s (strcase s)
)
;;; (if (= (substr s 1 2) "0X")
;;;  (setq s (substr s 3))
;;; ) ;_  if
(while (< i (strlen s))
  (setq a (substr s (setq i (1+ i)) 1))
;;;  (if (not (<= "0" a "F"))
;;;   (chr a)
;;;  )
  (setq n (+ (* n 16)
       (- (ascii a)
       (if (<= a "9")
        48
        55
       ) ;_  if
       ) ;_  -
    ) ;_  +
  ) ;_  setq
) ;_  while
) ;_  defun
 
(defun TestHex (hex n / i t0 t1 t2 t3)
(setq t0 (getvar "millisecs"))
(repeat n
  (handent-next h))
(setq t1 (getvar "millisecs"))
(repeat n
  (STD-NUM->HEX(1+ (STD-HEX->NUM hex))))
(setq t2 (getvar "millisecs"))
(repeat n
  (LM:dec->base(1+ (LM:base->dec hex 16))16))
(setq t3 (getvar "millisecs"))
(list (- t1 t0) (- t2 t1) (- t3 t2))
)
;;Lấy 1 handent
(setq h (cdr (assoc 5 (entget(car (entsel)))))) => "422C4"
(TestHex h 100000)

Vài kết quả:
(1140 4407 5000)
(1156 4406 5016)
  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hiepttr    538

hiepttr
Đã đăng

@ndtnv:
Mình hỏi vậy vì:

1. Mình chưa từng ứng dụng nó nên không biết có giới hạn một giá trị Max nào đó trong lập trình "1000000" không bác ah !

2. Nếu (handent-next "FFFFF...") mỏi tay thấy đáp số đúng phải là 1000000.... (số số 0 bằng số chữ F)

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ThuyLinh313    156

ThuyLinh313
Đã đăng

Về nguyên tắc lập trình thì Không nên có giới hạn nào cho hàm trên, nhưng có giới hạn cho việc sử dụng nó trong thực tế. Hàm này mình viết để dùng đếm dữ liệu đối tượng tạo ra trong bản vẽ. Con số 1triệu đối tượng autocad cho 1 file bản vẽ mình e là chỉ có các hệ thống máy tính cực kỳ chuyên nghiệp cho sử lý đồ họa mới sử lý nổi. Vì vậy 1triệu thậm chí là quá thừa với nhu cầu sử dụng thông thường.

 

Khi viết ứng dụng thì mình coi trọng tính hiệu quả trong việc sử dụng hơn là viết theo kiểu hàn lâm tổng quát mất thời gian. Quan trọng ở đây là TRUNGNGAMY có thể tìm thấy hướng giải quyết khi tham khảo code trên.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Các bác cho em hỏi chút!

Em muốn rời text một đoạn theo hướng vuông góc với Polyline nhưng cứ bị mắc lỗi mà em không biết lỗi ở đâu?

Mong các bác chỉ giáo giúp em với ạ. Cảm ơn các bác nhiều!

http://www.cadviet.com/upfiles/5/36665_test.dwg

(defun C:90 (/	       ACDOC	 ANG2	   CAODO     LTSTEXT
	     MSP       OBJNEWTUYEN	   PNTNEW    PNT_MOVE
	     PNT_T     PNT_T_VG	 SS	   SSOBJ     VLAOBJ
	    )
  (setvar "CMDECHO" 0)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setq	ssObj
	 (ssget "_:E:S:L" (list '(0 . "*POLYLINE,LWPOLYLINE")))
  )
  (setq ObjNewTuyen (ssname ssObj 0))
  (setq VlaObj (vlax-ename->vla-object ObjNewTuyen))
  (setvar "OSMODE" 0)
  (Alert "Quet chon Text")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (setq LtsText (LM:ss->ent ss))
  
 
  (foreach e LtsText
    (setq Pnt_T (TD:Text-Base e))
    (setq Caodo (atof (cdr (assoc 1 (entget e)))))
    (progn
      (setq Pnt_T_VG
	     (vlax-curve-getClosestPointTo
	       ObjNewTuyen
	       Pnt_T
	     )
      )
      (setq
	ang2
	 (angle	'(0 0)
		(Vlax-curve-getfirstderiv
		  ObjNewTuyen
		  (vlax-curve-getParamAtPoint ObjNewTuyen Pnt_T_VG)
		)
	 )
      )

      (setq PntNew (polar Pnt_T (+ ang2 (/ pi 2)) 10.0))
      (setq Pnt_Move (list (car PntNew) (cadr PntNew) Caodo))
      (vla-move	(vlax-ename->vla-object e)
		(vlax-3d-point Pnt_T)
		(vlax-3d-point Pnt_Move)
      )
      
    )
  )
  (setvar "OSMODE" olmode)
  (princ)
)


(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
(defun TachXY (Pnt /)
  (setq Pt (list (car Pnt) (cadr Pnt)))
  pt
)

(defun TD:Text-Base (ent / MA71 MA72 X11)
  (setq Ma10 (cdr (assoc 10 (entget ent))))
  (setq Ma11 (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71 (cdr (assoc 71 (entget ent))))
  (setq Ma72 (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3))
	  (and (= Ma71 0) (= Ma72 5))
      )
    Ma10
    Ma11
  )
)

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng

 

Các bác cho em hỏi chút!

Em muốn rời text một đoạn theo hướng vuông góc với Polyline nhưng cứ bị mắc lỗi mà em không biết lỗi ở đâu?

Mong các bác chỉ giáo giúp em với ạ. Cảm ơn các bác nhiều!

http://www.cadviet.com/upfiles/5/36665_test.dwg

Polyline có node 2 và 3 trùng nhau vì vậy hàm Vlax-curve-getfirstderiv = nil khi param = 1-2

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

gia_bach    1.549

gia_bach
Đã đăng

 

Các bác cho em hỏi chút!

Em muốn rời text một đoạn theo hướng vuông góc với Polyline nhưng cứ bị mắc lỗi mà em không biết lỗi ở đâu?

Mong các bác chỉ giáo giúp em với ạ. Cảm ơn các bác nhiều!

http://www.cadviet.com/upfiles/5/36665_test.dwg

...
      (setq
	ang2
	 (angle	'(0 0)
		(Vlax-curve-getfirstderiv
		  ObjNewTuyen
		  (vlax-curve-getParamAtPoint ObjNewTuyen Pnt_T_VG)) ) )

      (setq PntNew (polar Pnt_T (+ ang2 (/ pi 2)) 10.0))
....

thay hai dòng set ang2 và PntNew bằng : 

(setq ang2 (angle Pnt_T Pnt_T_VG))

(setq PntNew (polar Pnt_T ang2 10))

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

thay hai dòng set ang2 và PntNew bằng : 

(setq ang2 (angle Pnt_T Pnt_T_VG))

(setq PntNew (polar Pnt_T ang2 10))

Em viết thế là có mục đích ạ. Vì nếu thay như anh nói thì khi Text bên phải hay bên trái Polyline thì nó sẽ dịch chuyển sai. Hiii

Thêm nữa là khi Text nằm trên Polyline thì 2 điểm đó trùng nhau. Khi đó ko biết góc là ntn nữa ạ!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tr.CongSon    42

Tr.CongSon
Đã đăng

Em chào các anh chị,

 

Em có 1 vấn đề như sau,mong anh chị giúp đỡ tí ạ :

 

  Em có 1 tập đối tượng,em nối chúng lại với nhau bằng lệnh PEDIT,sau khi thực hiện  nó sẽ tạo ra có thể nhiều hơn 1 Pline nhưng cái em cần là lấy cái Pline Kín mới được sinh ra bởi lệnh Pedit đó,Giờ em không biết cách nào để lấy được nó.

 

Anh chị có thể Code cho em 1 đoạn hoặc cho em ý kiến để lấy được Pline này ko ạ

 

Em xin cảm ơn.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

tien2005    242

tien2005
Đã đăng

@Tr.CongSon: Bạn tham khảo lisp của Tue_NV để xác định các đối tượng được tạo ra sau lệnh Pedit. Các đối tượng này Bạn chỉ tiến hành lọc ra các dxf70=1 là OK

 

link tham khảo http://www.cadviet.com/forum/topic/10039-chon-doi-tuong-sau-lenh-copy/

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

pphung183    428

pphung183
Đã đăng

Em chào các anh chị,

 

Em có 1 vấn đề như sau,mong anh chị giúp đỡ tí ạ :

 

  Em có 1 tập đối tượng,em nối chúng lại với nhau bằng lệnh PEDIT,sau khi thực hiện  nó sẽ tạo ra có thể nhiều hơn 1 Pline nhưng cái em cần là lấy cái Pline Kín mới được sinh ra bởi lệnh Pedit đó,Giờ em không biết cách nào để lấy được nó.

 

Anh chị có thể Code cho em 1 đoạn hoặc cho em ý kiến để lấy được Pline này ko ạ

 

Em xin cảm ơn.

Nhạc sĩ Tr.CongSon tham khảo code :D :

(setq e (entlast))
…..dùng Pedit sinh ra các đối tượng mới
(setq ss (ssadd)) (while (setq e (entnext e)) (setq ss (ssadd e ss))); Lay tap chon sau khi Pedit 
(setq ss (acet-ss-to-list ss)) ; Chuyen bo chon mới ve list ename
(foreach ent ss (setq obj (vlax-ename->vla-object ent))
(if (and (eq (vla-get-closed obj) :vlax-true) (eq (vla-get-ObjectName obj) "AcDbPolyline"))
(setq lent (cons ent lent)) )) ; lent : list ename mong muốn.
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tr.CongSon    42

Tr.CongSon
Đã đăng (Đă chỉnh sửa)

 

Nhạc sĩ Tr.CongSon tham khảo code :D :

 

Em cảm ơn a pphung183, a tien2005

Em cũng dùng đoạn này để lấy a ạ

 

(setq Elast (entlast)

lstname nil)

(setq ss (TS:SELOBJ_CONTINUOUS))

(vl-cmdf "_.PEDIT" "M" ss "" "J" "J" "E" 1 "");;đoan nay lay cac line noi tiep nhau de Pedit

 

(while (setq ELast (entnext ELast))

(setq lstname (cons ELast lstname))

)

 
Nhưng không hiểu sao kết quả lstname -->nil chứ không phải là ename 
Em ko Upload file được ,mong anh chị thông cảm ạ
Chỉnh sửa theo Tr.CongSon

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tr.CongSon    42

Tr.CongSon
Đã đăng

Có mỗi lời cám ơn mà phải tốn 2 comment, thay bằng 2 like đơn giản hơn, mà cũng đỡ công người khác khỏi hớ hàng. :lol:

 

@a Doan Van Ha :Em đọc bài xong like liền anh ơi ^^

Ban đầu em cảm ơn 2 anh đã Reply + em post code em dùng bị lỗi (post lên cadviet lại che mất mấy dòng code  :( nên anh nghĩ chỉ có dòng cảm ơn thôi ^^ )

Comment thứ 2 em post để biết em sửa được rồi ,chứ im im đôi lúc dễ làm người khác khó chịu lắm anh ạ,có khi lại nghĩ : không biết thằng này sửa được hay chưa mà chẳng thấy reply hay nó chỉ post lên chơi vậy thôi :v

 

Em sẽ rút kinh nghiệm lần sau :v 

Chúc anh luôn mạnh khỏe và thành công !

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng

Nhạc sĩ nên search gg trước

http://www.cadtutor.net/forum/showthread.php?58578-AutoLISP-code-needed-to-remove-directories-%28folders%29

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/delete-folder-command/td-p/2874374

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

pphung183    428

pphung183
Đã đăng

Anh chị cho em hỏi : Trong lisp có hàm nào xóa 1 folder không  ạ?

Có sẵn hàm tạo và xóa thư mục của ACET :) :

   Make :

(acet-file-mkdir "C:\\...\\Desktop\\Tr.CongSon")
 Delete :
(acet-file-rmdir "C:\\...\\Desktop\\Tr.CongSon")
  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tr.CongSon    42

Tr.CongSon
Đã đăng

 

Có sẵn hàm tạo và xóa thư mục của ACET :) :

   Make :

(acet-file-mkdir "C:\\...\\Desktop\\Tr.CongSon")
 Delete :
(acet-file-rmdir "C:\\...\\Desktop\\Tr.CongSon")

 

Em cảm ơn 2 a!

Hàm acet này em biết a phung ạ, hàm này thuôc hàm của Express tool,nó chỉ xóa được folder trống thôi a^^

Cái em muốn là nó xóa folder bất kỳ ak a.hi

 

@ a ndtnv: Hàm delFolder a gởi dùng rất tốt ạ ^^ 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

pphung183    428

pphung183
Đã đăng

Em cảm ơn 2 a!

Hàm acet này em biết a phung ạ, hàm này thuôc hàm của Express tool,nó chỉ xóa được folder trống thôi a^^

Cái em muốn là nó xóa folder bất kỳ ak a.hi

 

@ a ndtnv: Hàm delFolder a gởi dùng rất tốt ạ ^^ 

Muốn dùng doping tăng lực thì hàng đây :D :

(acet-sys-command (strcat "RD /s /q " "\"C:\\...\\Tr.CongSon" "\""))
  • Vote tăng 4

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tr.CongSon    42

Tr.CongSon
Đã đăng

 

Muốn dùng doping tăng lực thì hàng đây :D :

(acet-sys-command (strcat "RD /s /q " "\"C:\\...\\Tr.CongSon" "\""))

 

Công nhận liều dooping của a uy lực thật ^^

Hàm này nó giống như (command "shell") đúng ko a?

Nhưng Em chưa hiểu cái  "RD /s /q" có ý nghĩa là gì ?

A có thể giải thích thêm ko ạ?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

pphung183    428

pphung183
Đã đăng

Công nhận liều dooping của a uy lực thật ^^

Hàm này nó giống như (command "shell") đúng ko a?

Nhưng Em chưa hiểu cái  "RD /s /q" có ý nghĩa là gì ?

A có thể giải thích thêm ko ạ?

1/ Chính xác

2/ RD : xóa thư mục với 2 thông số :

/s : xóa toàn bộ cây thư mục,  /q : xóa không cần hỏi
  • Vote tăng 4

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Hề hề hề,

Xin hỏi các bác một vấn đề như sau.

Trong quá trình sử dụng lisp, tôi có gặp một vấn đề là tìm số lần đệ quy để thực hiện được nhiệm vụ yêu cầu. Vì vậy tôi có dùng biến đếm số lần đệ quy, Tuy nhiên kết quả ra rất không đúng. Mày mò mãi mới phát hiện ra rằng cứ mỗi lần thực hiện đệ quy thì cái biến đếm này tăng lên với giá trị 2^n (với n là số lần thực hiện đệ quy).

Thực lòng tôi không hiểu sao lại như vậy nên rất mong các bác có thể giải đáp vì sao lại như vậy.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×