Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

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


  • Please log in to reply
2847 replies to this topic

#2701 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 22 September 2015 - 01:25 PM

Ở đây có các hàm tổng quát để đổi từ hexa sang decimal và ngược lại:

https://forums.autod...al/td-p/2873916

Tuy nhiên, tôi đã đọc 1 bài của ThuyLinh313 có thuật toán rất hay để tăng hay giảm 1 đơn vị trong hệ 16, bạn search hay hỏi bạn ấy xem


  • 1

#2702 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 22 September 2015 - 04:18 PM

Ở đây có các hàm tổng quát để đổi từ hexa sang decimal và ngược lại:

https://forums.autod...al/td-p/2873916

Tuy nhiên, tôi đã đọc 1 bài của ThuyLinh313 có thuật toán rất hay để tăng hay giảm 1 đơn vị trong hệ 16, bạn search hay hỏi bạn ấy xem

Hy vọng bạn ấy vào đây hay các bạn khác sẽ thấy và giúp mình


  • 0

#2703 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

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

Đã gửi 22 September 2015 - 05:03 PM

Ở đây có các hàm tổng quát để đổi từ hexa sang decimal và ngược lại:

https://forums.autod...al/td-p/2873916

Tuy nhiên, tôi đã đọc 1 bài của ThuyLinh313 có thuật toán rất hay để tăng hay giảm 1 đơn vị trong hệ 16, bạn search hay hỏi bạn ấy xem

 

Bạn từng là thành viên của nhóm CADMagic à? Nó nằm trong lệnh fakedim của mình chia sẻ trong nhóm CADMagic chứ chưa có chia sẻ lên Cadviet.

 

Bạn TRUNGNGAMY: bạn tải code này nhé, mình viết nó để đếm dữ đối tượng tạo ra trong bản vẽ theo handle

(defun handent-next (hex / lt id str)
 (setq str (vl-string-right-trim "F" hex) id (strlen str))
 (setq lt '(("0" . "1") ("1" . "2") ("2" . "3") ("3" . "4")
            ("4" . "5") ("5" . "6") ("6" . "7") ("7" . "8")
            ("8" . "9") ("9" . "A") ("A" . "B") ("B" . "C")
            ("C" . "D") ("D" . "E") ("E" . "F")))
 (cond ((= str "") (substr "1000000" 1 (1+ (strlen hex))))
       ((= str hex) (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt))))
       (t (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt)) (substr "000000" 1 (- (strlen hex) id))))))

  • 1

#2704 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 23 September 2015 - 07:56 AM

 

Bạn từng là thành viên của nhóm CADMagic à? Nó nằm trong lệnh fakedim của mình chia sẻ trong nhóm CADMagic chứ chưa có chia sẻ lên Cadviet.

 

 

Tôi không phải thành viên của nhóm CADMagic nhưng thấy trong cadviet có 1 số mem xuất sắc nằm trong nhóm này nên có search trang web của nhóm nhưng chưa tìm ra. Còn bài này là do ketxu share ở topic này http://www.cadviet.c...atch-khong-doi/ nhưng hôm qua không nhớ key nên tìm không thấy


  • 0

#2705 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 28 September 2015 - 01:13 PM

 

Bạn từng là thành viên của nhóm CADMagic à? Nó nằm trong lệnh fakedim của mình chia sẻ trong nhóm CADMagic chứ chưa có chia sẻ lên Cadviet.

 

Bạn TRUNGNGAMY: bạn tải code này nhé, mình viết nó để đếm dữ đối tượng tạo ra trong bản vẽ theo handle

(defun handent-next (hex / lt id str)
 (setq str (vl-string-right-trim "F" hex) id (strlen str))
 (setq lt '(("0" . "1") ("1" . "2") ("2" . "3") ("3" . "4")
            ("4" . "5") ("5" . "6") ("6" . "7") ("7" . "8")
            ("8" . "9") ("9" . "A") ("A" . "B") ("B" . "C")
            ("C" . "D") ("D" . "E") ("E" . "F")))
 (cond ((= str "") (substr "1000000" 1 (1+ (strlen hex))))
       ((= str hex) (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt))))
       (t (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt)) (substr "000000" 1 (- (strlen hex) id))))))

Mấy hôm nay có việc đi xa nên kg vào CV. Cám ơn bạn đã giúp. Nhưng đó là hàm tăng, bạn viết nốt giúp hàm giảm nhé. Mình dùng để đi tới đi lui các đối tượng của cad và kiểm soát xem các đối tượng đang quan tâm có cái nào bị xoá kg

Một lần nữa cám ơn bạn.


  • 0

#2706 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 28 September 2015 - 02:09 PM

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


  • 1

#2707 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 28 September 2015 - 05:41 PM

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


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#2708 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 28 September 2015 - 06:51 PM

@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"


  • 1

#2709 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 29 September 2015 - 10:54 AM

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.autod...l/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)

  • 2

#2710 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 29 September 2015 - 11:26 AM

@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)


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#2711 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

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

Đã gửi 01 October 2015 - 09:26 AM

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.


  • 0

#2712 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 November 2015 - 12:27 PM

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.c.../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
  )
)


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2713 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 23 November 2015 - 01:10 PM

 

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.c.../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


  • 1

#2714 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 23 November 2015 - 01:25 PM

 

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.c.../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))


  • 0

#2715 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 November 2015 - 01:30 PM

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

Chuẩn xác ạ! Em cảm ơn bác nhiều! 


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2716 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 November 2015 - 01:35 PM

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 ạ!


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2717 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 27 November 2015 - 11:37 AM

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.


  • 0

#2718 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 27 November 2015 - 11:54 AM

@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.c...-sau-lenh-copy/


  • 1

#2719 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 27 November 2015 - 12:45 PM

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.


  • 1

#2720 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 27 November 2015 - 01:14 PM

 

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 ạ

Bài viết đã được chỉnh sửa nội dung bởi Tr.CongSon: 27 November 2015 - 01:24 PM

  • 0