Quick code

;Doan Van Ha - CADViet.com - Ngay 04/4/2012
;Muc dich: Tao nhieu Wipeout cung luc.
(defun C:HA( / cmd entlst...
>>

Quick code

;Doan Van Ha - CADViet.com - Ngay 04/4/2012
;Muc dich: Tao nhieu Wipeout cung luc.
(defun C:HA( / cmd entlst xoa)
(command "undo" "be")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE")))))))
(initget "X K") (setq xoa (getkword "\n pline cu <X>: "))
(if (= xoa "K") (setq xoa "N") (setq xoa "Y"))
(foreach ent entlst
 (command "wipeout" "p" ent xoa))
(setvar "cmdecho" cmd)
(command "undo" "end")
(princ))

 

 

Mình test thử lisp này thì bị như này là sao:

Select objects:

pline cu <X>: x

The polyline must be closed and made up of only line segments.

Unknown command "Y". Press F1 for help.

 

Lisp này chỉ cần click vào đường PL thì nó sẽ tự động biến thành wipeout có thể xóa pl cũ hoặc không à? còn đối với đối tượng không phải PL thì sao? đường tròn chẳng hạn?

<<

Thế thì dùng tí lisp vào vậy.

Với cách này sau khi sử dụng lệnh copy xong,sẽ selection các đối tượng vừa copy.Bạn cứ thao tác bình thường.Muốn thực hiện lệnh gì với...

>>

Thế thì dùng tí lisp vào vậy.

Với cách này sau khi sử dụng lệnh copy xong,sẽ selection các đối tượng vừa copy.Bạn cứ thao tác bình thường.Muốn thực hiện lệnh gì với các đối tượng này thì dùng tham số p

VÍ dụ Sau khi copy xong,bạn muốn đặt các đối tượng ra chỗ kác thì : move -> p

Tron code mình đặt mặc định c là copy,bạn có thể change nếu thấy dùng thích hợp

(defun c:c (/ ss)
 (and (setq ss (AT:Copy))
      (command "_.select" ss )
 ) 
) 

(defun AT:Copy (/ #SS #Pnt1 #Pnt2 #Pnts #SSAdd #Copy)
 (vl-load-com)
 (cond
   ((and (setq #SS (ssget "_:L"))
         (setq #Pnt1 (getpoint "\nSpecify base point: "))
         (setq #Pnt2 (acet-ss-drag-move #SS #Pnt1 "\nSpecify placement point: " T))
    ) ;_ and
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Pnts (mapcar '(lambda (x) (vlax-3d-point (trans x 1 0)))
                        (list #Pnt1 #Pnt2)
                ) ;_ mapcar
    ) ;_ setq
    (setq #SSAdd (ssadd))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (ssadd (vlax-vla-object->ename (setq #Copy (vla-copy x))) #SSAdd)
      (vla-move #Copy (car #Pnts) (cadr #Pnts))
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   ) ;_ cond
 ) ;_ cond
 #SSAdd
) 

Bác hiểu nhầm đề bài rùi. Mong bác đọc lại. Với đối tượng mới được copy ra thì không thể dùng "P" được ? "P" chỉ dùng với các đối tượng mới được chọn thôi. Bác kiểm tra lại nhé !

Đối tượng ban đầu là A, mình copy ra thì được đối tượng A1, khi dùng tham số "P" thì mình chỉ chọn được đối tượng A thôi. ở đây e muốn chọn toàn bộ các đối tượng A1 1 cách nhanh nhất mà !

<<

Ví dụ: đổi lệnh COPY thành lệnh ABC. Từ đó suy ra các lệnh khác.

(defun C:ABC()
(command...
>>

Ví dụ: đổi lệnh COPY thành lệnh ABC. Từ đó suy ra các lệnh khác.

(defun C:ABC()
(command "copy"))

Thank ban ^^

<<

(defun c:dt()
;tinh dien tich 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh dien tich:"))
(command "boundary" p...
>>

(defun c:dt()
;tinh dien tich 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh dien tich:"))
(command "boundary" p "")
(command "area" "e" "l")
   	(command "erase" "l" "" )
(command "color" "bylayer")
 (command "text" "m" p pause "0" (strcat "%%u" "Dien tích = " (rtos (/ (getvar "area" ) 1000000) 2 2) " m2"  ))
   	(command "redraw" )
)
(defun c:cv()
;tinh chu vi 1 hinh khep kin
(setq p (getpoint "Chon khu vuc kin can tinh chu vi:"))
(command "boundary" p "")
(command "area" "e" "l")
   	(command "erase" "l" "" )
(command "color" "bylayer")
 (command "text" "m" p pause "0" (strcat "%%u" "Chu vi = " (rtos (/ (getvar "perimeter" ) 1000) 2 2) " m" ))
   	(command "redraw" )
)

mình có 1 lisp tính diện tích và chu vi rồi...nhưng cái hạn chế của nó chỉ tính cho 1 pline liền và vì công việc tính khối lượng nên cộng các hình hơi mất thời gian.....

 

mong các pro có thể giúp sửa nó tính cho nhiều hình thay vì chỉ có 1 hình

 

link ví dụ http://www.mediafire...anjdyg4oz7pykr4

 

thank các pro

Mình thấy theo cách chọn vùng để tính chu vi và diện tích bằng cách pick điểm thì ko ổn, vì nếu bạn muốn pick vào nhiều vùng khác nhau thì phải zoom toàn bộ vùng đó giống như trong lệnh Hatch. vì vậy nếu muốn dùng tốt lisp tính diện tích cũng như chu vi cho nhiều hình thì chọn các hình bằng cách chọn đối tượng là khả thi hơn!

Trên diễn đàn có rất nhiều lisp tính diện tích chu vi. Mình gửi bạn cái của mình đang xài. Bạn có thể tham khảo!

(defun c:tdt(/ dt sdt gt tgt id pt1)
 (setq dt (ssget
 	'((-4 . "<OR")
  (0 . "CIRCLE")
  (0 . "*POLYLINE")
  (-4 . "OR>")
    	))
)
 (setq
sdt (sslength dt)
id 0
tgt 0)
(testcaochu)
 (repeat sdt
(setq ent (ssname dt id)
  id (1+ id)
  )
(command "area" "o" ent "")
(setq gt (getvar "area"))
(setq tgt (+ tgt gt))
(princ)
)
(setq pt1 (getpoint "\nchon diem ghi chu:"))
 (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tgt 1000000) 2 1) "m2"))
 (princ)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd(/ DT SDT TCD PT1)
 (setq dt (ssget '((-4 . "<OR")
  (0 . "CIRCLE")
  (0 . "ELLIPSE")
  (0 . "SPLINE")
  (0 . "ARC")
  (0 . "LINE")
  (0 . "*POLYLINE")
  (-4 . "OR>")
	))
)
(testcaochu)
 (setq sdt (sslength dt))
 (setq
 	index 0
 	tcd 0
 	)
 (repeat sdt
(setq
 	ent (ssname dt index)
 	index (1+ index)    
 	)    
(command "lengthen" ent "")
(setq cd (getvar "perimeter"))
(setq tcd (+ tcd cd))
)
 (setq pt1 (getpoint "\nchon diem ghi chu:"))
 (command "text" "j" "mc" pt1 (rtos caochu) "0" (strcat(rtos (/ tcd 1000) 2 1) "m"))
 (princ)
 )
;;;;;;;;;;;;;;;;;;
(defun testcaochu()
 (if (not caochu1)
(setq caochu (getdist "\nchieu cao chu? :"))
(setq caochu (getdist (strcat "chieu cao chu <" (rtos caochu1) ">:")))
)
 (if (= caochu nil) (setq caochu caochu1))
 (setq caochu1 caochu)
 )

<<

4 giờ trước, TrNghia.Do đã nói:

Lisp của bạn Duy hay và đáp...

>>

4 giờ trước, TrNghia.Do đã nói:

Lisp của bạn Duy hay và đáp ứng đc yêu cầu của mình nhưng cần nhiều file quá, cấu trúc tạo hộp thoại cũng rất dài mình đọc chả hiểu gì cả, nó khác với cách tạo bảng mà mình đọc quá. Có cách viết nào sử dụng file lisp ban đầu mình gửi mà đáp ứng đc những cái mình mong muốn ko hả bạn.

Của bạn chỉ cần sửa chút xíu là được:

;;;Three List Tile Dependency Example  -  Lee Mac
;;;Requires ListTileDependency.lsp to be loaded.
(defun c:vd5  (/ *error* dch dcl des lst dwg_name lst_name)
  (defun *error*  (msg)
    (if (= 'file (type des))
      (close des))
    (if (< 0 dch)
      (unload_dialog dch))
    (if (and (= 'str (type dcl)) (findfile dcl))
      (vl-file-delete dcl))
    (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg)))
    (princ))
  (setq lst '(("TBS35"
               ("TBS35-30" ("TBS35-30-1" "TBS35-30-3" "TBS35-30-5"))
               ("TBS35-35" ("TBS35-35-1" "TBS35-35-3" "TBS35-35-5"))
               ("TBS35-40" ("TBS35-40-1" "TBS35-40-3" "TBS35-40-5")))
              ("TBS45"
               ("TBS45-40" ("TBS45-40-1" "TBS35-40-3" "TBS35-40-5"))
               ("TBS45-50" ("TBS45-50-1" "TBS35-50-3" "TBS35-50-5"))
               ("TBS45-75" ("TBS45-75-1" "TBS35-75-3" "TBS35-75-5")))))
  (if (and (setq dcl (vl-filename-mktemp "tmp.dcl"))
           (setq des (open dcl "w"))
           (foreach str  '("lbx : list_box" "{" "    alignment = centered;"
                           "    fixed_width = true;" "    fixed_height = true;" "    width = 25;"
                           "    height = 10;" "}" "test : dialog" "{"
                           "    label = \"TAPPER BLOCK SETS - TBS\";" "    spacer;"
                           "    : boxed_row" "    {" "        : lbx { key = \"lb0\";}"
                           "        : lbx { key = \"lb1\";}" "        : lbx { key = \"lb2\";}"
                           "    }" "    spacer;" "    ok_cancel;" "}")
             (write-line str des))
           (not (setq des (close des)))
           (< 0 (setq dch (load_dialog dcl)))
           (new_dialog "test" dch))
    (progn (or ##rtn## (setq ##rtn## '(0 0 0)))
           (LM:dcld:action '("lb0" "lb1" "lb2") 'lst '##rtn##)
           (if (= 1 (start_dialog))
             (progn (setq lst_name (LM:dcld:getitems ##rtn## lst)
                          dwg_name (last lst_name))
                    (insert_blk dwg_name))
             (princ "\n*Cancel*"))))
  (*error* nil)
  (princ))
;;; HAM INSERT ***
(defun insert_blk  (name / path)
  (setq path "E:/Nghia_AutoLisp 2012/DCL/Tapper block sets TBS/")
  (if (not (tblsearch "BLOCK" name))
    (setq name (strcat path name ".dwg")))
  (command "_.insert" name pause "" "" ""))
;;;*******************************************
;; DCL List-Tile Dependency  -  Lee Mac
;; Configures action_tile statements for the list of keys to enabled dependency between the DCL tiles.
;; key     -  List of DCL tile keys in order of dependency
;; lst-sym -  Quoted variable containing list data
;; rtn-sym -  Quoted variable containing initial selection indexes
(defun LM:dcld:action  (key lst-sym rtn-sym)
  (defun LM:dcld:addlist  (key lst)
    (start_list key)
    (foreach itm lst (add_list itm))
    (end_list))
  (defun LM:dcld:getlists  (idx lst)
    (if (cdr idx)
      (cons (mapcar 'car lst) (LM:dcld:getlists (cdr idx) (cdr (nth (car idx) lst))))
      lst))
  (defun LM:substnth  (itm idx lst)
    (if lst
      (if (zerop idx)
        (cons itm (cdr lst))
        (cons (car lst) (LM:substnth itm (1- idx) (cdr lst))))))
  (defun LM:dcld:actions  (key lst-sym rtn-sym lvl / fun)
    (setq fun
           (if (cdr key)
             (list 'lambda
                   '(val lst / tmp)
                   (list 'setq
                         rtn-sym
                         (list 'LM:substnth '(atoi val) lvl rtn-sym)
                         'tmp
                         (list 'LM:dcld:getlists rtn-sym 'lst))
                   (list 'LM:dcld:addlist (cadr key) (list 'nth (1+ lvl) 'tmp))
                   (list 'if
                         (list '<=
                               (list 'length (list 'nth (1+ lvl) 'tmp))
                               (list 'nth (1+ lvl) rtn-sym))
                         (list 'setq rtn-sym (list 'LM:substnth 0 (1+ lvl) rtn-sym)))
                   (list (LM:dcld:actions (cdr key) lst-sym rtn-sym (1+ lvl))
                         (list 'set_tile (cadr key) (list 'itoa (list 'nth (1+ lvl) rtn-sym)))
                         'lst))
             (list 'lambda
                   '(val lst)
                   (list 'setq rtn-sym (list 'LM:substnth '(atoi val) lvl rtn-sym)))))
    (action_tile (car key) (vl-prin1-to-string (list fun '$value lst-sym)))
    fun)
  (mapcar 'LM:dcld:addlist key (LM:dcld:getlists (eval rtn-sym) (eval lst-sym)))
  ((eval (LM:dcld:actions key lst-sym rtn-sym 0)) (set_tile (car key) (itoa (car (eval rtn-sym))))
                                                  (eval lst-sym))
  (princ))
;; DCL List-Tile Dependency  -  Get Items  -  Lee Mac
;; Returns a list of the items selected from each dependent list tile.
;; idx -  List of selection indexes
;; lst -  List data
(defun LM:dcld:getitems  (idx lst / tmp)
  (if (cdr idx)
    (cons (car (setq tmp (nth (car idx) lst)))
          (LM:dcld:getitems (cdr idx) (cdr tmp)))
    (list (nth (car idx) (car lst)))))

 

<<

 

Của bạn đây.

 

 

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs...
>>

 

Của bạn đây.

 

 

(defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
dd (getpoint "\nDiem cuoi cua Polyline:")
cd (getreal "\nNhap buoc de rai:")
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
sl (getint "\nSo luong coc rai")
ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)

Bác ơi lips rất hay nhưng bác giúp em chỉnh sửa lại 1 tí được ko ạ:

- bác cho thêm lựa chọn chọn 1lúc nhiều đối tượng chứ ko chỉ 1 đối tượng

- đến chỗ lựa chọn theo em nghĩ nếu đã có bước rải thì thôi lựa chọn số cọc cần rải. Tuy nhiên em thấy lips bắt nhập cả nếu ko nhập sẽ bị lỗi. Chỗ này bác cho độc lập thì hay vẫn sẽ hỏi như vậy nhưng nếu muốn nhập số cọc cần rải thì ko nhập vào bước cần rải.

 

Thanks bác nhiều ạ.

<<

(defun c:dx ()
(princ "\nchon duong muon xien theo")
(command ".ucs" "ob" pause)
(setq dddn (getpoint "\nDiem viet dim"))
(setq dddd (getpoint "\nDiem thu nhat"))
(while  (setq dddt (getpoint dddd "\nDiem do tiep theo <ENTER de ket 
>>

(defun c:dx ()
(princ "\nchon duong muon xien theo")
(command ".ucs" "ob" pause)
(setq dddn (getpoint "\nDiem viet dim"))
(setq dddd (getpoint "\nDiem thu nhat"))
(while  (setq dddt (getpoint dddd "\nDiem do tiep theo <ENTER de ket thuc>"))
(command ".DIMLINEAR" "non" dddd "non" dddt "non" dddn)
(setq dddd dddt)
)
(command ".ucs" "p")
(Princ))

Về cơ bản là như này

Bùm bùm em xin đưa ra 1 lsp có trên diễn đàn để tính chiều dài các thể loại

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam...
>>

Bùm bùm em xin đưa ra 1 lsp có trên diễn đàn để tính chiều dài các thể loại

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(alert (strcat "Total length = " (rtos L)))
)

Tên lệnh TL

Cái này nhanh gọn. Thanks

<<

 

Đây!

(defun c:pt (/ p lst fn pw)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p...
>>

 

Đây!

(defun c:pt (/ p lst fn pw)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (write-line "Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw))
 (close pw)
 (princ))

Nhờ các bác giúp thêm phần số thứ tự tăng dần khi pick để xuất sang Excel có thêm cột thứ tự với ạ!

<<

Download lisp

Filename: 332478_pt.lsp

Code đây bạn

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf...
>>

Code đây bạn

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
 (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
 (setq i -1)
 (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
 )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
 (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
 (vl-load-com)
 (command "_.undo" "_begin")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
   ov (mapcar 'getvar vl))           ; Get Old values
 (mapcar 'setvar vl '(0 0 0))
 (princ "\nChon duong thang can ghi kich thuoc : ")
 (if  (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE")) ))
 (Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
 (setq i 0)
(Repeat (1- (length (setq Lpoints (Tue-ent-Lpoint ent))))
 (setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
   d3 (polar d1 (+ (/ pi 2.0)(angle '(0 0 0) (vlax-curve-getFirstDeriv ent i))) (* kc 500.0))
 )
  (command "dimaligned" d1 d2 d3)
  (setq i (1+ i))
)
)
)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

 

bác Tue_NV ơi, em nhờ bên phần post bài của em bên kia không được, nhưng em thấy cái này cũng gần giống cái mà em cần. nhờ bác bớt phần hỏi nhập khoảng cách này đi hoặc mặc định là 0 và không hỏi ở dưới dòng command đoạn này được không a! vì em có kích thước mẫu của cơ quan theo quy định chung rồi nên trước khi gõ lệnh KT2 thì em chọn kích thước mẫu trước trên style sau đó thực hiện lệnh là ok. giúp em với nhé, cảm ơn anh nhiều!

sửa đoạn:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 500) 2 2) "> :" )))</pre>

thành:

<pre class="cadvietlispcode">(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos (* *kc* 0) 2 2) "> :" )))</pre>

<<

Nội dung của bạn cần đây :

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc gocss)
(defun...
>>

Nội dung của bạn cần đây :

(defun c:kt2(/ vl ov ss d1 d2 d3 d4 d5 ent kc Tue-ent-Lpoint Tue-dxf i Lpoints goc gocss)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
 (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
 (setq i -1)
 (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
   (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))

 )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
 (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))

)
Lpoint
)
 (vl-load-com)
 (command "_.undo" "_begin")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
       ov (mapcar 'getvar vl))	; Get Old values
 (mapcar 'setvar vl '(0 0 0))
 (princ "\nChon duong thang can ghi kich thuoc : ")
 (if  (setq ent (car(entsel "\n Pick Chon LINE, PLINE :")))
 (Progn
(or *kc* (setq *kc* 1))
(setq kc (getdist (strcat "\nNhap khoang cach <" (rtos *kc* 2 2) "> :" )))
(if kc (setq *kc* kc) (setq kc *kc* ))
(setq d4 (getpoint "\nPick huong dat dim :"))
(setq i 0 el (entlast))  
(setq Lpoints (Tue-ent-Lpoint ent))
  (if (> kc 0.0) (vl-cmdf "offset" kc ent d4 "e")
  	       (entmakex (entget ent))
	     	)
(if (null (eq el (entlast))) (progn
   (setq Lpoints-o (Tue-ent-Lpoint (entlast)))
   (entdel (entlast))   		       
   (Repeat (1- (length Lpoints))
     	(setq d1 (nth i Lpoints) d2 (nth (1+ i) Lpoints)
       	d3 (nth i Lpoints-o)
     	)
      	(command "dimaligned" d1 d2 d3)
 	     	(setq i (1+ i))
   )
) (alert "\n Khong dim duoc vi khoang cach qua lon"))
)
)
 (mapcar 'setvar vl ov) ; reset Sys Vars
 (command "_.undo" "_end")
 (princ)
 )

 

em dùng đoạn code mới của anh thì gặp 1 chút sự cố như sau:

không chọn được Line (muốn chọn được Line để ghi kthuoc, còn trọn hướng cần ghi của Line khó quá thì không cần hướng)

nhập khoảng cách ghi kthuoc (để mặc định là 0 và không hỏi lại lần sau!)

pick hướng cần ghi kthuoc không đúng hướng đối với đường Poline khép kín!

đây là hình của em:

 

đây là file bản vẽ :

http://www.cadviet.com/upfiles/3/104547_banve.dwg

<<

 

Sửa chút xíu lsp của Ket, có 2 điều :

1. Pline không cần phải closed mới dùng được, nhưng dĩ nhiên pline phải có nhiều...

>>

 

Sửa chút xíu lsp của Ket, có 2 điều :

1. Pline không cần phải closed mới dùng được, nhưng dĩ nhiên pline phải có nhiều đoạn nó mới biết cái nào vào trong cái nào ra ngoài.

2. Gộp 2 lệnh o+o- vào chung 1 lệnh, bạn nhập số >0 thì offset ra ngoài, <0 thì offset vào trong.

Còn các lệnh chamfer và fillet vẫn như cũ.

 Bạn đặt sẵn layer hiện hành trước khi chạy lsp, màu theo bylayer.

(vl-load-com) 
(defun c:ofs( / ss lay lst)
  (setq lay (getvar 'clayer))
  (cond ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
(or #d (setq #d 5))
(setq #d (cond ((getdist (strcat "\nDistance <" (rtos #d 2 2) ">"))) (#d)))
(vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
 (setq lst (mapcar 'car (list (vlax-invoke obj 'Offset #d)  (vlax-invoke obj 'Offset (- #d)))))
 (mapcar '(lambda (x) (vla-put-Layer x lay) (vla-put-Color x 256)) lst)
 (vla-delete (car (vl-sort lst
'(lambda(x y) ((if (< #d 0) > <) (vlax-get x 'Area) (vlax-get y 'Area))) ))
 )
)
(vla-delete ss)
)
(T (princ "\nNo thing to do"))
  )
)

Cảm ơn bạn nhiêu nha đoạn lisp trên thật tuyệt đúng lúc minh cần

<<

Download lisp

Filename: 381529_ofs.lsp

 

Tôi thấy chọn caí nào nối cái đó cho tiện.

 

(defun c:nn (/ tdt ssdt)
  (defun ObjName (ssdt /)  (cdr...
>>

 

Tôi thấy chọn caí nào nối cái đó cho tiện.

 

(defun c:nn (/ tdt ssdt)
  (defun ObjName (ssdt /)  (cdr (assoc '0 (entget ssdt))))
  (defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
  
  (defun NoiPL (ssdt tdt /)
    (if (MoPL ssdt)
      (command ".PEDIT" ssdt "J" tdt "" "")
    )
  )
  (defun NoiLC (ssdt tdt /)  (command ".PEDIT" ssdt "Y" "J" tdt "" ""))
  
  (setq tdt  (ssget)
ssdt  (ssname tdt 0))
  (if (or (= (Objname ssdt) "LWPOLYLINE")
 (= (Objname ssdt) "POLYLINE"))
    (NoiPL ssdt tdt)
    (if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
      (NoiLC ssdt tdt)
    )
  )
  (princ)
)

 

Cám ơn bạn Tot77 đã giúp đỡ nhưng mỗi cái có cái hay riêng chứ, khi có quá nhiều đối tượng cần nối hết với nhau nhưng với lisp của mình thì cần chọn 1 line cũng đã nối được rồi vẫn nhanh hơn

Bạn sửa lại lisp kia chọn cái nào nối cái đó cũng được nhưng mình phải nhớ cả 2 lệnh hơi vất vả. nên bạn có thể sửa lại như ý trên của mình được không?

<<

 

Thấy chưa có ai giúp nên post cái Lisp này lên cho bạn dùng thử:

>>

 

Thấy chưa có ai giúp nên post cái Lisp này lên cho bạn dùng thử:

http://www.cadviet.com/upfiles/3/71162_21lisp_gan_cao_do_cho_pline_va_ghi_ra_text.lsp

Hướng dẫn: Ví dụ muốn đặt 2 đường đồng mức cùng có cao độ là 10 thì quét chọn cả 2 đường đồng mức đó luôn. Sau đó nhập độ cao đường đồng mức và chiều cao chữ. Cuối cùng chọn vị trí ghi Text. Khi nào không muốn ghi Text nữa thì chuột phải hoặc Enter hoặc Space.

;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;============KANGKUNG 13/04/2013=============
(defun C:kk( / index Height pt taphop)
  (setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (/= docao nil)
    (setq docao(read(lisped (rtos docao 2 2))))
    (setq docao(read(lisped "Nhap do cao duong dong muc vao day")))
    )
  (setq Height(getreal "\n Nhap chieu cao chu: "))
  (setq index 0)
  (while (< index (sslength taphop))
    (vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
    (setq index (1+ index))
    )
  (while (setq pt(getpoint "\n Pick diem chen TEXT: " ))
      (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 40 Height) (cons 1 (rtos docao 2 2))))
      )
  (princ)
  )
(princ "\n              KangKung - 13/04/2013\n")
(princ "\n           Nhap KK de chay chuong trinh\n")

tks bác kangkung đã giúp đỡ rất nhanh.lisp này dùng khá tốt, nhưng có thể nhờ bác sửa giúp em thêm 1 chút là khi chọn điểm chèn text cao độ thì mình pick vào đường đồng mức đó rồi nó chèn text song song với đường đmức mình vừa chọn và cách đường đmức 1 khoảng = 1/2 chiều cao text, ah thêm cái là đường đmức nào mình gán cao độ cho nó rồi thì nó sẽ đổi sang màu nào đó, ví dụ màu 2 chẳng hạn. thanks!

<<

Hề hề hề,

Có phải cái này không hè???

(defun c:pht (/ bln a b c d tg gt  t1 t2 t3)
(setq year (getint...
>>

Hề hề hề,

Có phải cái này không hè???

(defun c:pht (/ bln a b c d tg gt  t1 t2 t3)
(setq year (getint "\n Hay nhap nam sinh du 4 chu so: ")
         GT (getint "\n Hay nhap gioi tinh chu nha <1=Nam; 2=nu>: "))
(setq a (atoi (substr (itoa year) 1 1))
         b (atoi (substr (itoa year) 2 1))
         c (atoi (substr (itoa year) 3 1))
         d (atoi (substr (itoa year) 4 1))
         Tg (+ a b c d)  )
;;;;;;;;;;;;;;;;;;;
(defun ssu (a / a1 a2 t1)
(if (>  a 9)
   (progn
      	(setq t1 (itoa a)
                	a1 (atoi (substr t1 1 1))
                	a2 (atoi (substr t1 2 1))
                	t2 (+ a1 a2)  )
      	(if (> t2 9)
          	(ssu t2) )
   )
)
t2
)
;;;;;;;;;;;;;;;;;;
(setq tong (ssu tg))
(if (= gt 1)
   (setq bln (itoa (- 11 t2)))
   (progn
    	(setq t3 (+ 4 t2))
    	(if (> t3 9)
        	(setq t3 (ssu t3))
    	)
    	(setq bln (itoa t3))
   )
)
(alert (strcat "\n Ten block can chen la " bln))
(command "insert" bln (getpoint "\n Nhap diem chen block") 1 1 0)
)

Chúc bạn vui như cái hình avatar của bạn.

 

 

 

Cảm ơn các bạn nhiều.đây chính là cái mà minh đang muốn,nhưng chỉ có điều bạn sửa lại một chút giúp minh

đúng như bạn Nhoclangbat nói nếu la Nam 1990=1+9+1+0=19=1+9=10 khi đó quái số sẽ là 11-10=1 (quái số là 1 nên chèn block số 1)

ở đây là nam nên ta lấy 11-10 còn nếu là nữ ta lấy 4+10=14=1+4=5 (quái số là 5 chèn block số 5)

 

và khi nó hỏi tên block cần chèn là 1.thì mình phải khai báo đường dẫn như thế nào để nó lôi ra đung block của mình.mình có đính kèm chín quái số đã block và đặt tên từ 1 đến 9 rồi bạn giup minh với..hihi háo hức quá ắp oke rùi bạn ơi.

<<

Hề hề hề,

Bạn dùng thử cái này coi có ưng ý không nhé:

(defun c:chatt (/ oldos bln ssbl atn n k i a...
>>

Hề hề hề,

Bạn dùng thử cái này coi có ưng ý không nhé:

(defun c:chatt (/ oldos bln ssbl atn n k i a j att atlst atv pre num)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq bln (getstring t "\n Nhap ten block: "))
(setq ssbl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 2 bln) (cons 66 1)))))
(if ssbl
      (progn
             (setq atn (getstring t "\n Nhap ten thuoc tinh: ") 
                     n (getint "\n Nhap so ky tu can giu cua gia tri thuoc tinh: ")                    
                     k (getint "\n Nhap so ky tu bieu dien so: ")
                     i (getint "\n Nhap so bat dau danh so: ")
                     a (getreal "\n Nhap gia so: ")
                     j 0 )
             (if (> k 4) (setq k 4))     
             (if (= atn "") (setq atn bln))
             (setq ans (getstring t "\n Ban muon danh so theo chieu thuan <y or n>: "))
             (if (= (strcase ans) "Y")
                 (setq ssbl (vl-sort ssbl '(lambda (x y) (< (cadr (assoc 10 (entget x))) (cadr (assoc 10 (entget y)))))))
                 (setq ssbl (vl-sort ssbl '(lambda (x y) (> (cadr (assoc 10 (entget x))) (cadr (assoc 10 (entget y)))))))
             )
             (foreach bl ssbl
                     (setq att (entnext bl))
                     (while (/= (cdr (assoc 0 (entget att))) "SEQEND")
                              (setq atlst (entget att))
                              (if (= (cdr (assoc 2 atlst)) (strcase atn))
                                  (progn
                                         (setq atv (cdr (assoc 1 atlst))
                                                 pre (substr atv 1 n)
                                                 num (rtos (+ i (* j a)) 2 0))
                                         (if (and (= (strlen num) 1) (= k 4)) (setq num (strcat "000" num)))
                                         (if (and (= (strlen num) 2) (= k 4)) (setq num (strcat "00" num)))
                                         (if (and (= (strlen num) 3) (= k 4)) (setq num (strcat "0" num)))
                                         (if (and (= (strlen num) 1) (= k 3)) (setq num (strcat "00" num)))
                                         (if (and (= (strlen num) 2) (= k 3)) (setq num (strcat "0" num)))
                                         (if (and (= (strlen num) 1) (= k 2)) (setq num (strcat "0" num)))
                                         (setq atlst (subst (cons 1 (strcat pre num)) (assoc 1 atlst) atlst))
                                         (entmod atlst)

                                         (setq j (1+ j))
                                   )
                                )
                                (setq att (entnext att))
                     )
             )
        )
)
(command "regenall")
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

 

Hề hề hề,

Do cái sự biết chưa đến nơi đến chốn nên lisp này mới chỉ giải quyết cho bạn được đến số chữ số tối đa là 4. Nếu bạn muốn hơn thì phải bổ sung thêm vào lisp.

Phần chọn chiều đánh số mình chưa làm mà mới chỉ đánh số theo thứ tự hiện hành của các block trong tập chọn. Mình sẽ bổ xung sau nhé.

 

Hề hề hê, minh đã bổ sung phần chọn chiều đánh số váo lisp. Thay vì chọn ba đầu như bạn nói mình cho chọn chiều đánh số là thuận (từ trái qua phải) và nghịch (từ phải qua trái). Khi lisp hỏi " Ban muon danh so theo chieu thuan <y or n>: " nếu bạn nhập y vào dòng command lisp sẽ đánh số theo chiều thuận. Còn nếu bạn không nhập gì hoặc nhập bất cứ ký tự nào thì lisp sẽ đánh số theo chiều nghịch.

 

Chúc bạn vui.

Mình chưa hiểu "tên thuộc tính", "số ký tự cần giữ của giá trị thuộc tính" trong lisp của bạn nghĩa là gì? Bạn giải đáp giúp mình nhé. :D

<<

Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý;...

>>

Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý; tuy nhiên nó bị lỗi nên khi xài tôi phát hiện ra và hiệu chỉnh lại .

Các lệnh vẫn giữ nguyên:

1/ Khai báo các kiểu nét taluy dài ngắn, khoảng cách và số vạch ngắn chen giữa vạch dài = lệnh: VTL0;

2/ Vẽ taluy cho 1 đường riêng biệt = lệnh: VTL1, cho phép chọn đổi bên trái sang phải;

3/ Vẽ taluy chọn đường đỉnh mái taluy và đường chân mái taluy, cho phép đổi ngược lại = lệnh: VTL2.

(setq ktdoantaluy1 0.2 ktdoantaluy2 0.4 khoangcachtl 0.2 chieutaluy 1
sodoan 0 sodoanngan 4)
;Ve taluy tren 1 doan
(defun ve1doantaluy ( p1 p2 / pvt diemcu ktdoantaluy ketthuc )
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)

(Defun xddsd ( com epl kc / e0 e p dsd )
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
; ve ta luy cho 1 doi tuong
(Defun vetaluy ( ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
(= (cdr (assoc 0 e)) "SPLINE")
) (setq ketthuc 1))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
)
)
)
(setq dem dem)
)
(Defun C:vtl1 ( / il ill ep chon lai solan )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel))
(if ep
(progn
(setq solan (vetaluy ep))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(setq chon nil)
)
(setvar "cecolor" il)
(setvar "osmode" ill)
(command "undo" "end")
)
(Defun C:vtl0 ( / tg )
(setq tg (getreal (strcat "Chieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
(if tg (setq ktdoantaluy1 tg))
(setq tg (getreal (strcat "Chieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
(if tg (setq ktdoantaluy2 tg))
(setq tg (getreal (strcat "Khoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
(if tg (setq khoangcachtl tg))
(setq tg (getint (strcat "So doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
(if tg (setq sodoanngan tg))
)

(Defun ve1doantaluy1 ( p1 p2 / d pv diemcu ktdoantaluy ketthuc )
(if (and p1 p2)
(progn
(setq ketthuc 1)
(setq pv (angle p1 p2))
(setq d (distance p1 p2))
(setq d (* d (/ ktdoantaluy1 ktdoantaluy2)))
(setq pv (polar p1 pv d))
(if (< sodoan sodoanngan)
(progn
(setq p2 pv)
(setq sodoan (1+ sodoan))
)
(progn
(setq p2 p2)
(setq sodoan 0)
)
)
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)
)
(setq dem dem)
)

(Defun vetaluy1 ( ep1 ep2 dao / le e1 e2 ketthuc them thutu )
(setq dem 0)
(setq e1 (entget (car ep1)))
(setq e2 (entget (car ep2)))
(if (and (or (= (cdr (assoc 0 e1)) "POLYLINE")
(= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e1)) "ARC")
(= (cdr (assoc 0 e1)) "CIRCLE")
(= (cdr (assoc 0 e1)) "LWPOLYLINE")
(= (cdr (assoc 0 e1)) "SPLINE"))
(or (= (cdr (assoc 0 e2)) "POLYLINE")
(= (cdr (assoc 0 e2)) "LINE")
(= (cdr (assoc 0 e2)) "ARC")
(= (cdr (assoc 0 e2)) "CIRCLE")
(= (cdr (assoc 0 e2)) "LWPOLYLINE")
(= (cdr (assoc 0 e2)) "SPLINE"))
) (setq ketthuc 1))
(if (and (= (cdr (assoc 0 e1)) "POLYLINE") (= (cdr (assoc 0 e2)) "LWPOLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd1 (xddsd "_.Measure" ep1 khoangcachtl))
(setq dsd2 (xddsd "_.Divide" ep2 (length dsd1)))
(if dao
(setq dsd2 (reverse dsd2))
)
(repeat (length dsd1)
(setq p1 (nth thutu dsd1))
(setq p2 (nth thutu dsd2))
(setq thutu (1+ thutu))
(ve1doantaluy1 p1 p2)
)
)
)
(setq dem dem)
)

(Defun C:vtl2 ( / ep1 ep2 chon lai solan dsd1 dsd2 )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq solan 0 ep1 1 ep2 1)
(while (and ep1 ep2)
(setq chieutaluy 1)
(setq ep1 (entsel "\nDoi tuong thu nhat:"))
(setq ep2 (entsel "\nDoi tuong thu hai:"))
(if (and ep1 ep2)
(progn
(setq solan (vetaluy1 ep1 ep2 nil))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(command "_.Undo" solan)
(setq chieutaluy -1)
(setq solan (vetaluy1 ep2 ep1 nil))
)
)
(setq chon nil)
)
(command "undo" "end")
(setvar "cecolor" il)
(setvar "osmode" ill)
)

Mèo tui test thấy ngon không thua gì các lệnh RTL của Nova, các bạn test lại xem sao

mình thấy cái này rất hay nhưng thêm được mầu và layer khác nhau cho đoạn dài và đoạn ngắn thì ngon.

<<

Mình viết thử cái này xem đúng ý bạn không nhé. Chọn các số lần lượt như trong biểu thức của bạn gửi nhé!!!

(defun c:dd (/ txt1 txt2 txt3...
>>

Mình viết thử cái này xem đúng ý bạn không nhé. Chọn các số lần lượt như trong biểu thức của bạn gửi nhé!!!

(defun c:dd (/ txt1 txt2 txt3 txt4 nametxt1 nametxt2 nametxt3 nametxt4 kqua obj)
(vl-load-com)
(setq txt1 (car (entsel "\nChon text1:"))
  nametxt1 (entget txt1)
     txt2 (car(entsel "\nChon text2:"))
  nametxt2 (entget txt2)
  txt3 (car(entsel "\nChon text3:"))
  nametxt3 (entget txt3)
  txt4 (car(entsel "\nChon text4:"))
  nametxt4 (entget txt4)	  
kqua 0)
;=======
(setq
sochia (cond (sochia) (166))
sochiaold sochia
sochia (getreal (strcat "\nVao he so chia : "))
)
(if (= sochia nil) (setq sochia sochiaold))
;=======

(setq
kqua 
(- (- (atof (cdr (assoc 1 nametxt1))) (atof (cdr (assoc 1 nametxt2))))
  (- (atof (cdr (assoc 1 nametxt3))) (atof (cdr (assoc 1 nametxt4))))
)
)
(setq kqua (/ kqua sochia))
(princ kqua)

(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
)
(vla-put-TextString obj (strcat " "(rtos kqua 2 2)" %"))
;(vla-put-TextString obj (strcat " "(rtos (* kqua 100) 2 2)" %"))
(princ)
)

Chào bạn nguyentuyen6

Vì sao bạn không chọn biến sochia giống như đã làm với các số khác vì mình thấy trên bản vẽ của bạn van tu con số này cũng đã được cho trước rồi mà????

Kết quả khi tính theo phần trăm thì cái dòng code (vla-put-TextString ...... ) thứ hai của bạn mới là đúng.

<<

 

Tặng bạn Lisp này. Xem được cả màu RGB và Color Index.

(defun C:SD(/ obj oColor)
  (setq...
>>

 

Tặng bạn Lisp này. Xem được cả màu RGB và Color Index.

(defun C:SD(/ obj oColor)
  (setq obj(vlax-ename->vla-object(car(nentsel))))
  (setq oColor(vlax-get-property obj 'TrueColor))
  (princ "\nRGB = ")
  (princ (vla-get-red oColor))
  (princ ",")
  (princ (vla-get-green oColor))
  (princ ",")
  (princ (vla-get-blue oColor))
  (princ "\nIndexColor = ")
  (princ (vla-get-colorindex oColor))
  (princ)
  )

Hình như đối với các layer mà đặt By layer, By Block thì lisp trên đều cho kết quả là màu 256, mà trong cad chỉ có đến 255 thui hay sao ý. bác test lại lisp xem sao giúp mọi ng!

<<

Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại...

>>

Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại chỗ tùy ý để bạn tiện ghi chú

 

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
 (progn  
 (vl-load-com)
 (acet-sysvar-set (list "cmdecho" 0))
 (grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
 (Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch :  ")
 (if (setq ss (ssget(list (cons 0 "HATCH"))))
   (progn
     (foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
	(setq lay (vlax-get-property e 'Layer))	
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
		(setq ar (*  0.000001 (vlax-get-property e 'Area)))
		(progn
			(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
			(redraw (vlax-vla-object->ename e) 3)
		)
	)			
       (if (not (assoc lay lst))
         (setq lst (cons (cons lay ar) lst))
         (setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
                          (assoc lay lst) lst))))
     (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))            
           txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
           msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)
     (while (setq e (nth (setq i (1+ i)) lst))		
       (vla-addtext msp (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") (vlax-3d-point '(0 0 0)) txtsiz)
	(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
	(command ".move" (entlast) "" '(0 0 0) pt)
	)
		(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
   (alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
 (acet-sysvar-restore)(princ))
 (defun st-ss->ent	(ss / n e l)
 (setq n -1)
 (while (setq e (ssname ss (setq n (1+ n))))
   (setq l (cons e l))
 )
)

 

không hiểu sao mình dùng vẫn lỗi pro à

Select objects: ; error: Automation Error. Invalid input

mình dùng cad 2012

<<