Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Jin Yong

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

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

ndtnv    396

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

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/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

  • 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
TRUNGNGAMY    91

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

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/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

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    146

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

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/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))))))
  • 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    396

 

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.com/forum/topic/81316-xin-lisp-scale-hinh-ve-thi-block-att-text-dim-hatch-khong-doi/ nhưng hôm qua không nhớ key nên tìm không thấ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
TRUNGNGAMY    91

 

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.

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    396

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    523

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    97

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

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    523

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

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    226

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    396

 

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.442

 

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    226

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    41

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    97

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

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    41

 

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
Doan Van Ha    2.676

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:

  • 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    41

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    396
pphung183    425

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

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


×