- page 215

Info

File

Tác giả: Bee
Bài viết gốc: 410569
Tên lệnh: ccc

Bạn có thể viết cho mình đoạn lặp đó ko. Mình ko biết làm thế nào

(defun c:ccc  (/ pt)
  (while (setq pt (getpoint "\nChon tam duong tron: "))
    (command "CIRCLE" pt "_per" pause)
    )
  )

Download lisp

Filename: 410569_ccc.lsp

Tác giả: Tue_NV
Bài viết gốc: 410886
Tên lệnh: gh

Chỉnh Sửa Hàng Loạt Text

e có file cad dưới đây, nhờ mọi người giúp e cách chỉnh text sao cho: ví dụ 1 * 1250 thì sẽ thành 1250 * 1; 11 * 175 sẽ thành 175 * 11; 5 * 20 sẽ thành 20 * 5 ạ. cảm ơn mọi người

>>
e có file cad dưới đây, nhờ mọi người giúp e cách chỉnh text sao cho: ví dụ 1 * 1250 thì sẽ thành 1250 * 1; 11 * 175 sẽ thành 175 * 11; 5 * 20 sẽ thành 20 * 5 ạ. cảm ơn mọi người

https://drive.google.com/open?id=0B5iJE54fhfEIZlk2WThfRUIwMmM

Bạn thử code này:
(defun c:gh(/ i ss ename entg)
  (setq i -1)
  (if (setq ss (ssget '((0 . "TEXT") (1 . "*# * #*"))))
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq entg (entget ename))
      (setq txt (cdr(assoc 1 entg)))
      (setq entg (subst (cons 1 (strcat (substr txt (+ 3 (vl-string-position (ascii "*") txt)) (strlen txt))
       " * "
      (substr txt 1 (- (vl-string-position (ascii "*") txt) 1))
     )
)
        (assoc 1 entg) entg))
      (entmod entg)
    )
  )
  (princ)
)
<<

Download lisp

Filename: 410886_gh.lsp

Tác giả: Bee
Bài viết gốc: 410940
Tên lệnh: test

Dim Nhanh Giữa Các Line (Hoặc Pl)

Em mới làm quen với lisp nên mong được mọi người giúp

Thử Lisp này nhé.

https://youtu.be/WIg8NEVBasg

(defun c:test ()
  (setq lst nil)
  (setq old (getvar "DIMJUST"))
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq...
>>

Em mới làm quen với lisp nên mong được mọi người giúp

Thử Lisp này nhé.

https://youtu.be/WIg8NEVBasg

(defun c:test ()
  (setq lst nil)
  (setq old (getvar "DIMJUST"))
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq
	lst (vl-sort lst
		     '(lambda (e1 e2)
			(> (if (< (cadr (cdr (assoc 10 (entget e1))))
				  (cadr (cdr (assoc 11 (entget e1))))
			       )
			     (cadr (cdr (assoc 10 (entget e1))))
			     (cadr (cdr (assoc 11 (entget e1))))
			   )		;if e1
			   (if (< (cadr (cdr (assoc 10 (entget e2))))
				  (cadr (cdr (assoc 11 (entget e2))))
			       )
			     (cadr (cdr (assoc 10 (entget e2))))
			     (cadr (cdr (assoc 11 (entget e2))))
			   )		;if e2
			)
		      )
	    )
      )					;setq
      (setq pt (polar (cdr (assoc 10 (entget (car lst))))
		      (angle (cdr (assoc 10 (entget (car lst))))
			     (cdr (assoc 11 (entget (car lst))))
		      )
		      (/ (distance (cdr (assoc 10 (entget (car lst))))
				   (cdr (assoc 11 (entget (car lst))))
			 )
			 2
		      )
	       )
      )
      (setvar "DIMJUST" 1)
      (command "DIMALIGNED"
	       pt
	       "_per"
	       (cdr (assoc 11 (entget (cadr lst))))
	       "_none"
	       pt
      )
      (setq n 2)
      (command "DIMBASELINE")
      (repeat (- (length lst) 2)
	(command "_per" (cdr (assoc 11 (entget (nth n lst)))))
	(setq n (1+ n))
      )
      (command "" "")
    )					;progn then
    (princ "\nBan da khong chon LINE.")
  )
  (setvar "DIMJUST" old)
  (princ)
)

Download lisp

Filename: 410940_test.lsp

Tác giả: khanh phong
Bài viết gốc: 410880
Tên lệnh: fdd

Dim Nhanh Giữa Các Line (Hoặc Pl)

Mình cần lisp dim vuông góc line 1 với 3 line còn lại, vì làm job mình phải dim như vậy rất nhiều, nên nhờ diển đàn cadviet giúp.

Vì mình mới học viết lisp nên mình chỉ biết cách làm thủ công như bên dưới. Anh chị có chỉnh giúp em số point A1,A2,A3 thành biến số n point.

(defun c:FDD()
(setq cmdecho 0)
(setq osmode 0)
(WHILE
(setq A1 (getpoint "\nDiem 1 càn dim: ")
	A2...
>>

Mình cần lisp dim vuông góc line 1 với 3 line còn lại, vì làm job mình phải dim như vậy rất nhiều, nên nhờ diển đàn cadviet giúp.

Vì mình mới học viết lisp nên mình chỉ biết cách làm thủ công như bên dưới. Anh chị có chỉnh giúp em số point A1,A2,A3 thành biến số n point.

(defun c:FDD()
(setq cmdecho 0)
(setq osmode 0)
(WHILE
(setq A1 (getpoint "\nDiem 1 càn dim: ")
	A2 (getpoint "\nDiem 2 càn dim: ")
	A3 (getpoint "\nDiem 1 càn dim: ")
	B (getpoint "\nDuòng càn vuông góc: ")
	C (getpoint "\nVi trí dat TEXT1: ")
	D (getpoint "\nVi trí dat TEXT2: ")
	E (getpoint "\nVi trí dat TEXT3: "))
(command "_.dimaligned" A1 "PER" B C)
(command "_.dimaligned" A2 "PER" B D)
(command "_.dimaligned" A3 "PER" B E))
(princ)
)

Download lisp

Filename: 410880_fdd.lsp

Tác giả: khanh phong
Bài viết gốc: 410980
Tên lệnh: sdf

Nhờ Chỉnh Sửa Lại Vòng Lặp Và Lisp

Nhờ các anh chỉnh lại vòng lặp giúp em, lisp dim kích thước dưới chỉ chạy trên 1 line em chọn, em chọn 2 line là chạy lung tung. Cám ơn nhiều

(defun c:SDF()
(if (setq ss (ssget))
(progn
(setq n (sslength ss)
	i 0)
(while (< i n)
(setq B (ssname ss i)
	A1 (getpoint "\nDiem 1 phuong dim: ")
	A2 (getpoint "\nDiem 2 phuong dim: ")
	C (getpoint "\nVi tri TEXT dim "))
(command "_line" A1 A2 "")
(setq L0...
>>

Nhờ các anh chỉnh lại vòng lặp giúp em, lisp dim kích thước dưới chỉ chạy trên 1 line em chọn, em chọn 2 line là chạy lung tung. Cám ơn nhiều

(defun c:SDF()
(if (setq ss (ssget))
(progn
(setq n (sslength ss)
	i 0)
(while (< i n)
(setq B (ssname ss i)
	A1 (getpoint "\nDiem 1 phuong dim: ")
	A2 (getpoint "\nDiem 2 phuong dim: ")
	C (getpoint "\nVi tri TEXT dim "))
(command "_line" A1 A2 "")
(setq L0 (entlast))
(command ".copy" L0 "" "0,0,0" "@")
(setq L00 (entlast))
(command ".rotate" L00 "" A1 "90")
(setq L1 (entlast))
(setq D1 (car(acet-geom-intersectwith L1 B 1)))
(setq D2 (car(acet-geom-intersectwith L1 L0 1)))
(command "_.dimaligned" D1 D2 C)
(command ".erase" L0 L1 "")
(setq i (+ 1 i))
))
(princ "\nKhong co duong line nao duoc chon !")
)
(princ)
)

Download lisp

Filename: 410980_sdf.lsp

Tác giả: Bee
Bài viết gốc: 411011
Tên lệnh: test

Dim Nhanh Giữa Các Line (Hoặc Pl)

Cám ơn anh Bee nhiều, lisp của anh gần như giải quyết được vấn đề của mình, chỉ có điều các text dim sắp xếp không theo được 1 line.

Hiện tại mình sử dụng lisp của anh, nhưng phải move text về thẳng hàng. Cám ơn anh nhiều

Xem cái này sắp xếp thế nào nhé. ^_^

>>

Cám ơn anh Bee nhiều, lisp của anh gần như giải quyết được vấn đề của mình, chỉ có điều các text dim sắp xếp không theo được 1 line.

Hiện tại mình sử dụng lisp của anh, nhưng phải move text về thẳng hàng. Cám ơn anh nhiều

Xem cái này sắp xếp thế nào nhé. ^_^

(defun c:test (/ lst old old_osm ss pt lst_dim n p11n)
  (setq lst nil _ang nil)
  (setq old (getvar "DIMJUST"))
  (setq old_osm (getvar 'osmode))
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (command "_zoom" "obj" ss "")
      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq
	lst (vl-sort lst
		     '(lambda (e1 e2)
			(> (if (< (cadr (cdr (assoc 10 (entget e1))))
				  (cadr (cdr (assoc 11 (entget e1))))
			       )
			     (cadr (cdr (assoc 10 (entget e1))))
			     (cadr (cdr (assoc 11 (entget e1))))
			   )		;if e1
			   (if (< (cadr (cdr (assoc 10 (entget e2))))
				  (cadr (cdr (assoc 11 (entget e2))))
			       )
			     (cadr (cdr (assoc 10 (entget e2))))
			     (cadr (cdr (assoc 11 (entget e2))))
			   )		;if e2
			)
		      )
	    )
      )					;setq

      (setq pt (polar (cdr (assoc 10 (entget (car lst))))
		      (angle (cdr (assoc 10 (entget (car lst))))
			     (cdr (assoc 11 (entget (car lst))))
		      )
		      (/ (distance (cdr (assoc 10 (entget (car lst))))
				   (cdr (assoc 11 (entget (car lst))))
			 )
			 2
		      )
	       )
      )
      (setvar "DIMJUST" 1)
      (command "DIMUPT" "OFF")
      (command "DIMALIGNED"
	       pt
	       "_per"
	       (cdr (assoc 11 (entget (cadr lst))))
	       "_none"
	       pt
      )
      (setq lst_dim nil)
      (setq lst_dim (cons (entlast) lst_dim))
      (setq n 2)
      (command "DIMBASELINE")
      (repeat (- (length lst) 2)
	(command "_per" (cdr (assoc 11 (entget (nth n lst)))))
	(setq lst_dim (cons (entlast) lst_dim))
	(setq n (1+ n))
      )
      (command "" "")
      (setvar 'osmode 0)      
      (if (lm:clockwise-p
	    (vlax-get (vlax-ename->vla-object (car lst_dim))
		      'textposition
	    )
	    (vlax-get (vlax-ename->vla-object (car lst))
		      'startpoint
	    )
	    (vlax-get (vlax-ename->vla-object (car lst))
		      'endpoint
	    )
	  )
	(setq _ang (+ pi (txt_angle (car lst_dim))))
	(setq _ang (- pi (txt_angle (car lst_dim))))
      )					;if
      (mapcar
	'(lambda (obj)

	   (setq p11n (polar (vlax-get (vlax-ename->vla-object obj)
				       'textposition
			     )
			     _ang
			     (* (getvar 'dimtxt) 10.)
		      )
	   )				;setq
	   (vlax-put (vlax-ename->vla-object obj) 'textposition p11n)
	 )
	lst_dim
      )
    )					;progn then
    (princ "\nBan da khong chon LINE.")
  )					;if
  (command "_zoom" "P")
  (setvar "DIMJUST" old)
  (setvar "OSMODE" old_osm)
  (princ)
)
(defun txt_angle (ename / blkent entdata _angle)
  (if
    (and
      (= (cdr (assoc 0 (setq entdata (entget ename))))
	 "DIMENSION"
      )
      (setq blkent (tblobjname "block" (cdr (assoc 2 entdata))))
    )
     (while (setq blkent (entnext blkent))
       (if (= (cdr (assoc 0 (setq entdata (entget blkent)))) "MTEXT")
	 (setq _angle (cdr (assoc 50 (entget blkent))))
       )
     )
  )
  _angle
)
(defun lm:clockwise-p (p1 p2 p3)
  ((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))
    (mapcar '- p1 p3)
  )
)
(princ)

Download lisp

Filename: 411011_test.lsp

Tác giả: Ar_Chanwoo
Bài viết gốc: 16143
Tên lệnh: test

Cad nâng cao

Mấy hôm nay chắc ổng bận gặp ông Putin ! Dể hôm nào ông hết nhiêm kì tông thống đã ! :bigsmile:

Download lisp

Filename: 16143_test.lsp

Tác giả: gia_bach
Bài viết gốc: 411072
Tên lệnh: a1

Nhờ Sửa Lisp

Hi anh em trên diễn đàn, mình có thử làm đoạn mã sau để đổi màu đối tượng

(defun c:a1 (/ m ss)
(command "undo" "be")
(princ "\nChon doi tuong muon doi mau:")
(setq ss (ssget))
(command "change" ss "" "P" "c" 1 "")
(command "undo" "end")
(princ)
)

Khi đánh lệnh trc rồi chọn...
>>
Hi anh em trên diễn đàn, mình có thử làm đoạn mã sau để đổi màu đối tượng

(defun c:a1 (/ m ss)
(command "undo" "be")
(princ "\nChon doi tuong muon doi mau:")
(setq ss (ssget))
(command "change" ss "" "P" "c" 1 "")
(command "undo" "end")
(princ)
)

Khi đánh lệnh trc rồi chọn đối tượng thì ok. Tuy nhiên nếu mình chọn đối tượng trc rồi mới đánh lệnh thì lisp ko hoạt động.

Vậy nhờ anh em sửa giúp để lisp có thể dùng đc cả 2 chiều như mình nói

Thanks anh em

Không chính xác! Lisp vẫn hoạt đông, nhưng ... bỏ qua các đối tượng đã chọn trước đó ???

Thử lisp này xem sao:
(defun c:a1 (/ ss)
  (princ "\nChon doi tuong muon doi mau:")
  (if (setq ss (ssget"_:L"))
    (progn
      (command "undo" "be")
      (command "change" ss "" "P" "c" 1 "")
      (command "undo" "end")))
  (princ))
<<

Download lisp

Filename: 411072_a1.lsp

Tác giả: Bee
Bài viết gốc: 411047
Tên lệnh: test

Nhờ Chỉnh Sửa Text Ra Giữa Line

Cai nay` dễ mà ^_^ @Danh Cong

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr...
>>

Cai nay` dễ mà ^_^ @Danh Cong

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

Download lisp

Filename: 411047_test.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 411234
Tên lệnh: cvg

Chỉnh Góc Xoay Của Block Trong Lisp.

Thử cái này xem:
(defun c:cvg (/ doc msp n name par poi pol pss)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
msp (vla-get-modelspace doc))
(vla-startundomark doc)
(if (and (setq pol (car (entsel "\nPick Pline: ")))
(eq (cdr (assoc 0 (entget pol))) "LWPOLYLINE")
(setq name (getstring "\nBlock Name:"))
(tblsearch "block" name)
(princ "\nChon cac Point: ")
(setq pss (ssget '((0 . "POINT")))))
(progn (or #xoaydoituong# (setq #xoaydoituong#...

Download lisp

Filename: 411234_cvg.lsp

Tác giả: khanh phong
Bài viết gốc: 411377
Tên lệnh: gra

Nhờ Sửa Giúp Lisp Của Att Text Vừa Insert

(defun C:gra( / p1 st ss ht entx )
(setq osm (getvar "osmode"))
(setq uni (getvar "insunits"))
(setq atd (getvar "attdia"));1
(ACET-ERROR-INIT (LIST (LIST "OSMODE" 0) T))
(setvar "attdia" 0)
(setvar "insunits" 6)
(setvar "cmdecho" 0)
(vl-cmdf "clayer" "ANNOTATION" )
(initget "G C") (setq st (getkword "\nTEXT: <Grass/Concrete (C. S/W)>: "))
(if (= st "G") (setq st "GRASS")
(if (= st "C") (setq st "CONCRETE (C. S/W)")))
(command "_.insert" "TEXT01"...
>>

(defun C:gra( / p1 st ss ht entx )
(setq osm (getvar "osmode"))
(setq uni (getvar "insunits"))
(setq atd (getvar "attdia"));1
(ACET-ERROR-INIT (LIST (LIST "OSMODE" 0) T))
(setvar "attdia" 0)
(setvar "insunits" 6)
(setvar "cmdecho" 0)
(vl-cmdf "clayer" "ANNOTATION" )
(initget "G C") (setq st (getkword "\nTEXT: <Grass/Concrete (C. S/W)>: "))
(if (= st "G") (setq st "GRASS")
(if (= st "C") (setq st "CONCRETE (C. S/W)")))
(command "_.insert" "TEXT01" (getpoint "\n\\U+0110i\\U+1EC3m \\U+0111\\U+1EB7t TEXT:") 1 1 (getpoint "\nGóc quay: ") st)

(setq dt (entget (entnext (car (entlast)))))
(entmod (subst (cons 40 0.5) (assoc 40 dt) dt))

(setvar "osmode" osm)
(setvar "insunits" uni)
(setvar "attdia" atd)
(setvar "cmdecho" 1)
(ACET-ERROR-RESTORE)
(princ)
)

Đoạn code trên chỉ insert được text mà không thay đổi được chiều cao text attribute, mong các anh chị chỉnh giúp.

Cám ơn các anh chị nhiều.

Download lisp

Filename: 411377_gra.lsp

Tác giả: Bee
Bài viết gốc: 411378
Tên lệnh: gra

Nhờ Sửa Giúp Lisp Của Att Text Vừa Insert

Copy lisp mà ko hiểu thì làm sao viết được. Heizzzz.

1. Đặt biến cục bộ lung ku tung ---> chứng tỏ copy ko hiểu :D

2. Đặt góc mà lại chọn hàm getpoint----->cũng là ko hiểu :D

3. Xử lý block_att mà trực tiếp ---> cũng là ko hiểu. :D

Nghiên cứu học hỏi thêm nhé.

Đây là lisp sửa ở trên ^_^

(defun c:gra (/ atd dt osm p1 st...
>>

Copy lisp mà ko hiểu thì làm sao viết được. Heizzzz.

1. Đặt biến cục bộ lung ku tung ---> chứng tỏ copy ko hiểu :D

2. Đặt góc mà lại chọn hàm getpoint----->cũng là ko hiểu :D

3. Xử lý block_att mà trực tiếp ---> cũng là ko hiểu. :D

Nghiên cứu học hỏi thêm nhé.

Đây là lisp sửa ở trên ^_^

(defun c:gra (/ atd dt osm p1 st uni)
  (setq osm (getvar "osmode"))
  (setq uni (getvar "insunits"))
  (setq atd (getvar "attdia"))		;1
  (acet-error-init (list (list "OSMODE" 0) t))
  (setvar "attdia" 0)
  (setvar "insunits" 6)
  (setvar "cmdecho" 0)
;;;  (vl-cmdf "clayer" "ANNOTATION")
  (initget "G C")
  (setq st (getkword "\nTEXT: <Grass/Concrete (C. S/W)>: "))
  (if (= st "G")
    (setq st "GRASS")
    (if	(= st "C")
      (setq st "CONCRETE (C. S/W)")
    )
  )
  (command
    "_.insert"
    "TEXT01"
    (setq p1 (getpoint "\n\\U+0110i\\U+1EC3m \\U+0111\\U+1EB7t TEXT:"))
    1
    1
    (angle p1 (getpoint p1 "\nGóc quay: "))
    st
  )

  (setq dt (entnext (entlast)))
  (if (/= (cdr (assoc 0 (entget dt))) "SEQEND")
    (progn
      (entmod
	(subst (cons 40 0.5) (assoc 40 (entget dt)) (entget dt))
      )
      (entupd dt)
    )
  )
  (setvar "osmode" osm)
  (setvar "insunits" uni)
  (setvar "attdia" atd)
  (setvar "cmdecho" 1)
  (acet-error-restore)
  (princ)
)

Download lisp

Filename: 411378_gra.lsp

Tác giả: quansla
Bài viết gốc: 411453
Tên lệnh: test

Lisp Viết Text/mtext Trên Pline

BƯỚC 1: GÕ LỆNH CHỌN TẬP HỢP CÁC ĐỐI TƯỢNG (có thể kết hợp chỉ chọn PLINE,LINE) dùng qua hàm

(ssget '(( 0 . "LINE,LWPolyline")))

BƯỚC 2: LỌC QUA TOÀN BỘ ĐỐI TƯỢNG LÀM CÁC CÔNG VIỆC SAU:
- Lấy chiều dài của đối tượng đang sử lý (có ename được setq là "dt") gán giá trị này cho biến...

BƯỚC 1: GÕ LỆNH CHỌN TẬP HỢP CÁC ĐỐI TƯỢNG (có thể kết hợp chỉ chọn PLINE,LINE) dùng qua hàm

(ssget '(( 0 . "LINE,LWPolyline")))

BƯỚC 2: LỌC QUA TOÀN BỘ ĐỐI TƯỢNG LÀM CÁC CÔNG VIỆC SAU:
- Lấy chiều dài của đối tượng đang sử lý (có ename được setq là "dt") gán giá trị này cho biến "L"
- Lấy 1 điểm trên (gần) Pline, Line làm điểm chèn TEXT ký hiệu điểm này là p
- Entmakex TEXT (hoặc Mtext) giá trị L tại điểm chèn p đã có ở trên
BƯỚC 4: KẾT THÚC LỆNH

http://www.cadviet.com/forum/topic/47335-da-xong-lisp-xuat-chieu-dai-line-ra-text-co-san-va-co-tien-to-hau-to/

(defun c:test()
  (defun vText(str p k / xp yp)
    (entmakex
      (list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1 str);string
(cons 7 (getvar "textstyle"));style
(cons 8 (getvar "clayer"));layer
(cons 62 256);color
(cons 10 p);insertion point
(cons 11 p);alignment point
(cons 40 k);text height - change by suit
(cons 41 1.0);text width
(cons 50 0.0);1.5708 - vertical, 0.0 - horizontal
(cons 51 0.0);oblique angle
'(71 . 0);alignment
'(72 . 0);alignment
'(73 . 0);alignment
)
      )    
    )
  (vl-load-com)
  (foreach dt (acet-ss-to-list (setq ss (ssget '(( 0 . "*LINE")))))
    (setq p (cdr(assoc 10 (entget dt))))
    (setq L (vla-get-length (vlax-ename->vla-object dt)))
    (vText (rtos L 2 4) p 25))
  (princ))

Toàn bộ (defun vtext .... để xác định hàm con với 3 tham số đầu vào sẽ hoạt động in ra màn hình một Dtext với nội dung như string, tại điểm chèn p; với chiều cao chữ k

Phần hoạt động chính chỉ đơn giản như sau:

- foreach --... lọc qua một lượt toàn bộ đối tượng.

- (setq p (cdr(assoc 10 (entget dt)))) xác định điểm p trên đối tượng

- (setq L (vla-get-length (vlax-ename->vla-object dt))) xác định chiều dài từng đối tượng.

- vtext (rtos L 2 4) p 25 in ra màn hinh Dtext nội dung "L", tại điểm p, chiều cao 25

kết thúc

Download lisp

Filename: 411453_test.lsp

Tác giả: snowman.hms
Bài viết gốc: 411606
Tên lệnh: convertfont+nil

Lisp Chuyển Đổi Mã Font Chữ Trong Autocad

(defun c:convertfont nil
  (setq
    UNI '((225) (224) (92 85 43 49 69 65 51) (92 85 43 48 48 69 51) (92 85 43 49 69 65 49)
	 (227) (92 85 43 49 69 65 70) (92 85 43 49 69 66 49) (92 85 43 49 69 66 51)
	 (92 85 43 49 69 66 53) (92 85 43 49 69 66 55) (226) (92 85 43 49 69 65 53)
	 (92 85 43 49 69 65 55) (92 85 43 49 69 65 57) (92 85 43 49 69 65 66)
	 (92 85 43 49 69 65 68) (233) (232) (92 85 43 49 69 66 66) (92 85 43 49 69 66 68)
	 (92 85 43 49 69 66 57) (234)...
>>

(defun c:convertfont nil
  (setq
    UNI '((225) (224) (92 85 43 49 69 65 51) (92 85 43 48 48 69 51) (92 85 43 49 69 65 49)
	 (227) (92 85 43 49 69 65 70) (92 85 43 49 69 66 49) (92 85 43 49 69 66 51)
	 (92 85 43 49 69 66 53) (92 85 43 49 69 66 55) (226) (92 85 43 49 69 65 53)
	 (92 85 43 49 69 65 55) (92 85 43 49 69 65 57) (92 85 43 49 69 65 66)
	 (92 85 43 49 69 65 68) (233) (232) (92 85 43 49 69 66 66) (92 85 43 49 69 66 68)
	 (92 85 43 49 69 66 57) (234) (92 85 43 49 69 66 70) (92 85 43 49 69 67 49)
	 (92 85 43 49 69 67 51) (92 85 43 49 69 67 53) (92 85 43 49 69 67 55) (237)
	 (92 85 43 48 48 69 67) (92 85 43 49 69 67 57) (92 85 43 48 49 50 57)
	 (92 85 43 49 69 67 66) (243) (92 85 43 48 48 70 50) (92 85 43 49 69 67 70)
	 (92 85 43 48 48 70 53) (92 85 43 49 69 67 68) (244) (92 85 43 49 69 68 49)
	 (92 85 43 49 69 68 51) (92 85 43 49 69 68 53) (92 85 43 49 69 68 55)
	 (92 85 43 49 69 68 57) (245) (92 85 43 49 69 68 66) (92 85 43 49 69 68 68)
	 (92 85 43 49 69 68 70) (92 85 43 49 69 69 49) (92 85 43 49 69 69 51) (250)
	 (249) (92 85 43 49 69 69 55) (92 85 43 48 49 54 57) (92 85 43 49 69 69 53)
	 (253) (92 85 43 49 69 69 57) (92 85 43 49 69 69 66) (92 85 43 49 69 69 68)
	 (92 85 43 49 69 69 70) (92 85 43 49 69 70 49) (92 85 43 48 48 70 68)
	 (92 85 43 49 69 70 51) (92 85 43 49 69 70 55) (92 85 43 49 69 70 57)
	 (92 85 43 49 69 70 53) (240);
	 (193) (192) (92 85 43 49 69 65 50) (92 85 43 48 48 67 51) (92 85 43 49 69 65 48)
         (195) (92 85 43 49 69 65 69) (92 85 43 49 69 66 48) (92 85 43 49 69 66 50)
         (92 85 43 49 69 66 52) (92 85 43 49 69 66 54) (194) (92 85 43 49 69 65 52)
         (92 85 43 49 69 65 54) (92 85 43 49 69 65 56) (92 85 43 49 69 65 65)
         (92 85 43 49 69 65 67) (201) (200) (92 85 43 49 69 66 65) (92 85 43 49 69 66 67)
         (92 85 43 49 69 66 56) (202) (92 85 43 49 69 66 69) (92 85 43 49 69 67 48)
         (92 85 43 49 69 67 50) (92 85 43 49 69 67 52) (92 85 43 49 69 67 54) (205)
         (92 85 43 48 48 67 67) (92 85 43 49 69 67 56) (92 85 43 48 49 50 56)
         (92 85 43 49 69 67 65) (211) (92 85 43 48 48 68 50) (92 85 43 49 69 67 69)
         (92 85 43 48 48 68 53) (92 85 43 49 69 67 67) (212) (92 85 43 49 69 68 48)
         (92 85 43 49 69 68 50) (92 85 43 49 69 68 52) (92 85 43 49 69 68 54)
         (92 85 43 49 69 68 56) (213) (92 85 43 49 69 68 65) (92 85 43 49 69 68 67)
         (92 85 43 49 69 68 69) (92 85 43 49 69 69 48) (92 85 43 49 69 69 50) (218)
         (217) (92 85 43 49 69 69 54) (92 85 43 48 49 54 56) (92 85 43 49 69 69 52)
         (221) (92 85 43 49 69 69 56) (92 85 43 49 69 69 65) (92 85 43 49 69 69 67)
         (92 85 43 49 69 69 69) (92 85 43 49 69 70 48) (92 85 43 48 48 68 68)
         (92 85 43 49 69 70 50) (92 85 43 49 69 70 54) (92 85 43 49 69 70 56)
         (92 85 43 49 69 70 52) (208))
    TCVN '((184) (181) (182) (183) (185) (168) (190) (187) (188) (189) (198) (169) (202)
	 (199) (200) (201) (203) (92 85 43 48 48 68 48) (92 85 43 48 48 67 67) (206)
	 (207) (209) (170) (92 85 43 48 48 68 53) (92 85 43 48 48 68 50) (211) (212)
	 (214) (92 85 43 48 48 68 68) (215) (216) (220) (92 85 43 48 48 68 69)
	 (92 85 43 48 48 69 51) (223) (225) (226) (228) (171) (232) (229) (230) (231)
	 (233) (172) (237) (234) (235) (92 85 43 48 48 69 67) (238) (243) (239) (241)
	 (92 85 43 48 48 70 50) (244) (173) (248) (92 85 43 48 48 70 53) (246) (247)
	 (249) (92 85 43 48 48 70 68) (250) (251) (252) (92 85 43 48 48 70 69) (174);
	 (184) (181) (182) (183) (185) (161) (190) (187) (188) (189) (198) (162) (202)
         (199) (200) (201) (203) (92 85 43 48 48 68 48) (92 85 43 48 48 67 67) (206)
         (207) (209) (163) (92 85 43 48 48 68 53) (92 85 43 48 48 68 50) (211) (212)
         (214) (92 85 43 48 48 68 68) (215) (216) (220) (92 85 43 48 48 68 69)
         (92 85 43 48 48 69 51) (223) (225) (226) (228) (164) (232) (229) (230) (231)
         (233) (165) (237) (234) (235) (92 85 43 48 48 69 67) (238) (243) (239) (241)
         (92 85 43 48 48 70 50) (244) (166) (248) (92 85 43 48 48 70 53) (246) (247)
         (249) (92 85 43 48 48 70 68) (250) (251) (252) (92 85 43 48 48 70 69) (167))
    VNI '((97 249) (97 248) (97 251) (97 92 85 43 48 48 70 53) (97 239) (97 234)
         (97 233) (97 232) (97 250) (97 252) (97 235) (97 226) (97 225) (97 224)
         (97 229) (97 92 85 43 48 48 69 51) (97 228) (101 249) (101 248) (101 251)
         (101 92 85 43 48 48 70 53) (101 239) (101 226) (101 225) (101 224) (101 229)
         (101 92 85 43 48 48 69 51) (101 228) (237) (92 85 43 48 48 69 67) (230) (243)
         (92 85 43 48 48 70 50) (111 249) (111 248) (111 251) (111 92 85 43 48 48 70 53)
         (111 239) (111 226) (111 225) (111 224) (111 229) (111 92 85 43 48 48 69 51)
         (111 228) (244) (244 249) (244 248) (244 251) (244 92 85 43 48 48 70 53) (244 239)
         (117 249) (117 248) (117 251) (117 92 85 43 48 48 70 53) (117 239) (246) (246 249)
         (246 248) (246 251) (246 92 85 43 48 48 70 53) (246 239) (121 249) (121 248)
         (121 251) (121 92 85 43 48 48 70 53) (238) (241);
	 (65 217) (65 216) (65 219) (65 92 85 43 48 48 68 53)
         (65 207) (65 202) (65 201) (65 200) (65 218) (65 220)
         (65 203) (65 194) (65 193) (65 192) (65 197) (65 92 85 43 48 48 67 51)
         (65 196) (69 217) (69 216) (69 219) (69 92 85 43 48 48 68 53) (69 207)
         (69 194) (69 193) (69 192) (69 197) (69 92 85 43 48 48 67 51) (69 196)
         (205) (92 85 43 48 48 67 67) (198) (211) (92 85 43 48 48 68 50) (79 217)
         (79 216) (79 219) (79 92 85 43 48 48 68 53) (79 207) (79 194) (79 193)
         (79 192) (79 197) (79 92 85 43 48 48 67 51) (79 196) (212) (212 217) (212 216)
         (212 219) (212 92 85 43 48 48 68 53) (212 207) (85 217) (85 216) (85 219)
         (85 92 85 43 48 48 68 53) (85 207) (214) (214 217) (214 216) (214 219)
         (214 92 85 43 48 48 68 53) (214 207) (89 217) (89 216) (89 219)
         (89 92 85 43 48 48 68 53) (206) (209))
  )
  (mapcar '(lambda (a b c)
	     (eval (vl-list* 'defun (read (strcat "c:" a)) 'nil (list 'cf::convertfont b c) '((princ))))
	   )
	  '("t2u" "t2v" "u2t" "u2v" "v2t" "v2u")
	  '(tcvn tcvn uni uni vni vni)
	  '(uni vni tcvn vni tcvn uni)
  )
  (princ)
)
(defun cf::convertfont (c1 c2 / s i e el h l ol sl c n str mtx t0 t1 doc
			*error* _StartUndo _EndUndo)
  (defun *error* ( msg )
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )  
  (defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
  )
  (defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
  )  
  (initget "Lower Upper Normal")
  (setq	#case (cond ((getkword (strcat "\nSpecify Case-Sensitiy option: [Lower/Upper/Normal] <"
				       (setq #case (cond (#case) ("Normal"))) ">: ")))
		    (#case)
	      )
        doc (vla-get-ActiveDocument (vlax-get-acad-object))
	sl 0
	ol 0
  )
  (cond	((= #case "Lower") (setq c2 (cf::sublist (/ (length c2) 2) c2) c 1))
	((= #case "Upper") (setq c2 (reverse (cf::sublist (/ (length c2) 2) (reverse c2))) c 2))
	((setq c 0))
  )
  (if (and (princ "\nSelect a [M]TEXT: ") (setq s (ssget '((0 . "*TEXT")))))
    (progn
      (_StartUndo doc)
      (setq t0 (getvar "MilliSecs"))
      (repeat (setq i (sslength s))
	(setq e   (ssname s (setq i (1- i)))
	      el  (entget e)
	      h   (reverse (cdr (member (cond ((assoc 3 el)) ((assoc 1 el))) (reverse el))))
	      str (LM:UnFormat (cf::GetTextString el) (setq mtx (equal (cdr (assoc 1 el)) "MTEXT")))
	      sl  (+ (strlen str) sl)
	      ol  (1+ ol)
	      el  (cdr (member (assoc 1 el) el))
	)
	(setq str (cf::ff0 str c1 c2 (length c2) c))
	(if mtx
	  (progn
	    (setq str (gbn str 250))
	    (repeat (1- (length str))
	      (setq l (cons (cons 3 (vl-list->string (car str))) l)
		    str (cdr str)))
	    (setq l (cons (cons 1 (vl-list->string (car str))) l)
		  l (reverse l))
	  )
	  (setq l (cons (cons 1 (vl-list->string (apply (function append) str))) l)) 
	)	
	(entmod (append h l el))
      )
      (setq t1 (getvar "MilliSecs"))
      (princ (strcat "\nTotal time to conver ["(rtoc ol 0)" - Objects] with [String length: " (rtoc sl 0) "] is : "
		     (rtoc (- t1 t0) 0) " (ms)"))
      (_EndUndo doc)
    )
    (princ "\nNo Valid object selected!!!")
  )
  (princ)
)
(defun cf::ff0 (s c1 c2 n c / a p r)
  ; c = 1: lower
  ; c = 2: upper
  ; c = 0: normal
  (if (= (type s) 'str) (setq s (vl-string->list s)))
  (cond ((= 8 (apply (function max) (mapcar (function length) c1)))
	 (if (and (= (car s) 92) (setq p (vl-position (cf::f7 s) c1)))
	   (setq r (cons (nth (rem p n) c2) r)
		 s (cdddr (cddddr s))
	   )
	 )
	 (while s
	   (cond 
		 ((= (cadr s) 92)
		  (cond ((setq p (vl-position (cf::f8 s) c1))
			 (setq r (cons (nth (rem p n) c2) r) s (cddddr (cddddr s))))
			(t
			 (if (setq p (vl-position (list (car s)) c1))
			   (setq r (cons (nth (rem p n) c2) r) s (cdr s))
			   (cond ((= c 1)
				  (if (< 64 (car s) 91)
				    (setq r (cons (list (+ (car s) 32)) r) s (cdr s))
				    (setq r (cons (list (car s)) r) s (cdr s))))
				 ((= c 2)
				  (if (< 96 (car s) 123)
				    (setq r (cons (list (- (car s) 32)) r) s (cdr s))
				    (setq r (cons (list (car s)) r) s (cdr s))))
				 (t (setq r (cons (list (car s)) r) s (cdr s)))
			   )
			 )
			 (if (setq p (vl-position (cf::f7 s) c1))
			   (setq r (cons (nth (rem p n) c2) r) s (cdddr (cddddr s)))
			   (setq r (cons (list (car s)) r) s (cdr s))
			 )
			)
		  )
		 )
		 ((setq p (vl-position (cf::f2 s) c1))
		  (setq r (cons (nth (rem p n) c2) r) s (cddr s)))
		 ((setq p (vl-position (list (car s)) c1))
		  (setq r (cons (nth (rem p n) c2) r) s (cdr s)))
		 ((vl-position c '(0 1 2))
		  (cond ((= c 1)
			 (if (< 64 (car s) 91)
			   (setq r (cons (list (+ (car s) 32)) r) s (cdr s))
			   (setq r (cons (list (car s)) r) s (cdr s))))
			((= c 2)
			 (if (< 96 (car s) 123)
			   (setq r (cons (list (- (car s) 32)) r) s (cdr s))
			   (setq r (cons (list (car s)) r) s (cdr s))))
			(t (setq r (cons (list (car s)) r) s (cdr s)))
		  )
		 )
	   )
	 )
        )
	(t (while s
	     (cond ((= (car s) 92)
		    (if (setq p (vl-position (cf::f7 s) c1))
		      (setq r (cons (nth (rem p n) c2) r) s (cdddr (cddddr s)))
		      (setq r (cons (list (car s)) r) s (cdr s))
		    )
		   )		   
		   ((setq p (vl-position (setq a (list (car s))) c1))
		    (setq r (cons (nth (rem p n) c2) r) s (cdr s)))
		   ((vl-position c '(0 1 2))
		    (cond ((= c 1)
			   (if (< 64 (car s) 91)
			     (setq r (cons (list (+ (car s) 32)) r) s (cdr s))
			     (setq r (cons (list (car s)) r) s (cdr s))))
			  ((= c 2)
			   (if (< 96 (car s) 123)
			     (setq r (cons (list (- (car s) 32)) r) s (cdr s))
			     (setq r (cons (list (car s)) r) s (cdr s))))
			  (t (setq r (cons (list (car s)) r) s (cdr s)))
		    )
		   )
	     )
	   )
       )
  )
  (reverse r)
)
(defun cf::sublist ( n l ) (reverse (member (nth (1- n) l) (reverse l))))
(defun cf::f8 (l) (list (car l) (cadr l) (caddr l) (cadddr l) (car (setq l (cddddr l))) (cadr l) (caddr l) (cadddr l)))
(defun cf::f7 (l) (list (car l) (cadr l) (caddr l) (cadddr l) (car (setq l (cddddr l))) (cadr l) (caddr l)))
(defun cf::f2 (l) (list (car l) (cadr l)))
(defun cf::GetTextString (el / typ)
  (cond	((wcmatch (setq typ (cdr (assoc 0 el))) "TEXT,*DIMENSION") (cdr (assoc 1 (reverse el))))
	((wcmatch typ "ATTRIB,MTEXT")
	 (apply	(function strcat)
		(mapcar	(function cdr) (vl-remove-if-not (function (lambda (x) (vl-position (car x) '(1 3)))) el))
	 )
	)
  )
)
;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText mtxag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )
    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\
\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(defun GBN (l n / b lst)
  ;; http://www.theswamp.org/index.php?topic=32428.msg380205#msg380205
  ;; by Elpanov Evgeniy
 (setq b (list '(reverse a)))
 (repeat (/ n 4)
  (setq b (cons '(setq
                  a
                  (cons (cadddr l) (cons (caddr l) (cons (cadr l) (cons (car l) a))))
                  l
                  (cddddr l)
                 ) ;_  setq
                b
          ) ;_  cons
  ) ;_  setq
 ) ;_  repeat
 (setq n (rem n 4))
 (repeat (/ n 3)
  (setq b (cons '(setq
                  a
                  (cons (caddr l) (cons (cadr l) (cons (car l) a)))
                  l
                  (cdddr l)
                 ) ;_  setq
                b
          ) ;_  cons
  ) ;_  setq
 ) ;_  repeat
 (setq n (rem n 3))
 (repeat (/ n 2)
  (setq b (cons '(setq
                  a
                  (cons (cadr l) (cons (car l) a))
                  l
                  (cddr l)
                 ) ;_  setq
                b
          ) ;_  cons
  ) ;_  setq
 ) ;_  repeat
 (setq n (rem n 2))
 (repeat (/ n 1)
  (setq b (cons '(setq
                  a
                  (cons (car l) a)
                  l
                  (cdr l)
                 ) ;_  setq
                b
          ) ;_  cons
  ) ;_  setq
 ) ;_  repeat
 (eval (cons 'defun (cons 'f1 (cons '(a) b))))
 (while l (setq lst (cons (f1 nil) lst)))
 (reverse lst)
)
(defun rtoc ( n p / foo d l )
    (defun foo ( l n )
        (if (or (not (cadr l)) (= 44 (cadr l)))
            l
            (if (zerop (rem n 3))
                (vl-list* (car l) 46 (foo (cdr l) (1+ n)))
                (cons (car l) (foo (cdr l) (1+ n)))
            )
        )
    )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (subst 44 46 (vl-string->list (rtos (abs n) 2 p))))
    (setvar 'dimzin d)
    (vl-list->string
      (append (if (minusp n) '(45))
	      (foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
      )
    )
)
(vl-load-com)
(c:convertfont)
(princ)

ten lenh: "t2u" "t2v" "u2t" "u2v" "v2t" "v2u"

Download lisp

Filename: 411606_convertfont+nil.lsp

Tác giả: Bee
Bài viết gốc: 411626
Tên lệnh: tk

Nhờ Sửa Lisp

Em cảm ơn a. Do em chưa biết gì về lisp nên khi em thực hiện như anh hướng dẫn lại không vẽ được. Em nhờ a hướng dẫn chi tiết hơn một chút nữa được không ạ.

Sao lại ko được.?

Ví dụ TK đây:

(defun C:tk ()
  (setq v (getvar...
>>

Em cảm ơn a. Do em chưa biết gì về lisp nên khi em thực hiện như anh hướng dẫn lại không vẽ được. Em nhờ a hướng dẫn chi tiết hơn một chút nữa được không ạ.

Sao lại ko được.?

Ví dụ TK đây:

(defun C:tk ()
  (setq v (getvar "osmode"))
  (setq B (getint "\nNhap be rong loai thep goc:"))
  (setq a (getint "Nhap kich thuoc truc bu long:"))
  (setq dauthanh (getint "Nhap chieu dai dau thanh:"))
  (setq pt1 (getpoint "Diem dau : "))
  (setq pt2 (getpoint "Diem cuoi : " pt1))
  (command "osnap" "none")
  (command "-layer" "set" "1" "");vị trí bất kỳ trước command line là đc mà.
  (setq goc (angle pt1 pt2))
  (setq pt3 (polar pt2 goc dauthanh))
  (setq pt4 (polar pt1 goc (* dauthanh -1)))
  (setq pt5 (polar pt3 (+ (/ PI 2) goc) a))
  (setq pt6 (polar pt3 (- goc (/ PI 2)) (- B a)))
  (setq pt7 (polar pt4 (- goc (/ PI 2)) (- B a)))
  (setq pt8 (polar pt4 (+ (/ PI 2) goc) a))
  (setq pt9 (polar pt3 (+ (/ PI 2) goc) (- a (/ (* B 15) 100))))
  (setq pt10 (polar pt4 (+ (/ PI 2) goc) (- a (/ (* B 15) 100))))
  (if (> a 0)
    (progn
      (command "color" 1)
      (command "line" pt1 pt2 "")
      (setq truc (ssget "L"))
      (command "chprop" truc "" "lt" "center" "")
    )
  )
  (command "color" 7)
  (command "pline" pt5 pt6 pt7 pt8 "close")
  (command "color" 2)
  (command "line" pt10 pt9 "")
  (setq denta (ssget "L"))
  (command "chprop" denta "" "lt" "hidden" "")
  (command "color" 7)
  (if (> dauthanh 0)
    (progn
      (command "color" 7)
      (command "circle" pt1 10)
      (command "circle" pt2 10)
    )
  )
  (setvar "osmode" v)
)

Download lisp

Filename: 411626_tk.lsp

Tác giả: ndtnv
Bài viết gốc: 411725
Tên lệnh: cy

Kết Hợp 2 Lệnh Stretch Và Copy

Viết theo yêu cầu cũng không khó nhưng tôi chưa rãnh, nếu Danh Cong rãnh thì hoàn chỉnh

Bạn dùng tạm lisp này

- Copy các dim

- Chọn dim gốc lấy y chuẩn

- Chọn các dim cần chỉnh tọa độ

(defun c:cy( / a g) ; chinh y
(setq a (assoc 10 (entget (car (entsel "\nChon dim goc : ")))))
(princ "\nChon dim can chinh cao do : ")
(foreach e (vl-remove-if 'listp (mapcar 'cadr...
>>

Viết theo yêu cầu cũng không khó nhưng tôi chưa rãnh, nếu Danh Cong rãnh thì hoàn chỉnh

Bạn dùng tạm lisp này

- Copy các dim

- Chọn dim gốc lấy y chuẩn

- Chọn các dim cần chỉnh tọa độ

(defun c:cy( / a g) ; chinh y
(setq a (assoc 10 (entget (car (entsel "\nChon dim goc : ")))))
(princ "\nChon dim can chinh cao do : ")
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget  '((0 . "DIMENSION")(-4 . "&=")(70 . 6))))))
 (entmod (subst a (assoc 10 (setq g (entget e))) g))
)
)

Download lisp

Filename: 411725_cy.lsp

Tác giả: khanh phong
Bài viết gốc: 411766
Tên lệnh: asa

Nhờ Sữa Lisp Thay Đổi Giá Trị Dim Nếu Thỏa Điều Kiện

Em cần lisp dim kích thước nếu dim ra 0.6 mét thì tự động đổi thành 0.60 MIN, em mới tập lisp nên không biết code bên dưới bị lỗi gì mà không so sánh điều kiện được, nhờ anh chị trên diễn đàn giúp đỡ. Cám ơn nhiều


(defun c:AsA( / D1 D2 D3 )
(setq D1 (getpoint "\ndiem 1 dim: ")
      D2 (getpoint "\ndiem 2 dim: ")
      D3 (getpoint "\ndiem dat text dim: "))
(command "_.dimaligned"...
>>


(defun c:AsA( / D1 D2 D3 )
(setq D1 (getpoint "\ndiem 1 dim: ")
      D2 (getpoint "\ndiem 2 dim: ")
      D3 (getpoint "\ndiem dat text dim: "))
(command "_.dimaligned" D1 D2 D3 )
(setq dt (entlast)
      gt (cdr (assoc 42 (entget dt))))
(if (= gt 0.6)
    (progn
      (entmod
	(subst (cons 1 "0.60 MIN") (assoc 1 (entget dt)) (entget dt))
      )
      (entupd dt)
    )
  )

(princ)
)

Download lisp

Filename: 411766_asa.lsp

Tác giả: Bee
Bài viết gốc: 411824
Tên lệnh: kkk

Kết Hợp 2 Lệnh Stretch Và Copy

Mình dùng là odinate dimension k dùng cốt text

khi dùng stretch nó sẽ nhảy theo giống như là dimension

bác có thể down cái file mình đính kèm về mà xem

Mình vẫn thấy dùng field là ổn dù cho tỷ lệ nào vẫn dùng được.

Đây là lisp dùng cho công việc bạn yêu cầu....

Mình dùng là odinate dimension k dùng cốt text

khi dùng stretch nó sẽ nhảy theo giống như là dimension

bác có thể down cái file mình đính kèm về mà xem

Mình vẫn thấy dùng field là ổn dù cho tỷ lệ nào vẫn dùng được.

Đây là lisp dùng cho công việc bạn yêu cầu. Nhớ chọn window từ phải qua trái thì mới stretch được nhé.

Tết nhất đến nơi mọi người bận chắc chẳng ai rảnh viết lisp mấy đâu. ^_^

(defun c:kkk (/ os ss p1 p2)
  (setq os (getvar "osmode"))
  (princ "\nChon cot cao do: ")
  (if (setq ss (ssget "_:L"))
    (if	(setq p1 (getpoint "\nChon diem goc copy: "))
      (if (setq p2 (getpoint p1 "\nChon diem dat moi: "))
	(progn
	  (command "_.copybase" p1 ss "")
	  (setvar "OSMODE" 0)
	  (command "_.stretch" "P" "" p1 p2)
	  (command "_.pasteclip" p1)
	)
	(princ "\nBan da khong chon diem moi.")
      )
      (princ "\nBan da khong chon diem goc.")
    )
    (princ "\nBan da khong chon doi tuong.")
  )
  (setvar 'osmode os)
  (princ)
)

Download lisp

Filename: 411824_kkk.lsp

Tác giả: Bee
Bài viết gốc: 411848
Tên lệnh: test

Lisp xuất chiều dài Line ra Text có sẵn và có tiền tố, hậu tố

mình ko up lên cadviet mình gửi kèm link gồm dwg và lisp bạn nhé, đây là lisp mình lấy được trên diễn đàn, cảm ơn bạn, cuối tuần vui vẽ nhé

>>
mình ko up lên cadviet mình gửi kèm link gồm dwg và lisp bạn nhé, đây là lisp mình lấy được trên diễn đàn, cảm ơn bạn, cuối tuần vui vẽ nhé

https://drive.google.com/file/d/0B1TsLvqrTXBycDY1RzllYW0yU28/view?usp=sharing

Lisp mới đây, chỉ cần chọn LINE còn lại lisp làm việc nhé. ^_^ Thay tên lệnh tùy ý.

Chui khắp các topic nhờ vả mà ko thấy ai repply, khổ thân ^_^
;;Lenh TEST

(defun c:test (/ ss n _length pt1 ss1)
  (setvar "CMDECHO" 0)
  (princ "\nChon *LINE: ")
  (if (setq ss (ssget '((0 . "*LINE"))))
    (progn
      (command "zoom" "ob" ss "")
      (setq n 0)
      (repeat (sslength ss)
	(setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.))
	
	(setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (/ pi 2) 100.))
	
	(setq ss1 (ssget "C" pt1 (cdr (assoc 11 (entget (ssname ss n)))) '((0 . "TEXT"))))
	(if ss1
	  (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m"))
			   (assoc 1 (entget (ssname ss1 0)))
			   (entget (ssname ss1 0)))
		    )
	    )
	(setq n (1+ n))
	);repeat
      );progn
    (princ "\nBan da khong chon LINE.")
    );if
  (command "zoom" "P")
  (princ)
  )
<<

Download lisp

Filename: 411848_test.lsp

Tác giả: Bee
Bài viết gốc: 411861
Tên lệnh: test

Lisp xuất chiều dài Line ra Text có sẵn và có tiền tố, hậu tố

Hi bạn,

nếu đường thẳng nằm dọc hay nằm ngiêng lisp ko tính được, mình gửi bản vẽ đính kèm nhờ bạn xem với nhé, thanks

Hi bạn,

nếu đường thẳng nằm dọc hay nằm ngiêng lisp ko tính được, mình gửi bản vẽ đính kèm nhờ bạn xem với nhé, thanks

https://drive.google.com/open?id=0B1TsLvqrTXByZkhva1RYZUZJUFk

Đã fix nhé ^_^

;;Lenh TEST

(defun c:test (/ ss n _length pt1 pt2 pt3 pt4 ss1 )
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (princ "\nChon LINE: ")
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (command "zoom" "ob" ss "")
      (setq n 0)
      (repeat (sslength ss)
	(setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.))
	(setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt2 (polar (cdr (assoc 11 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt3 (polar (cdr (assoc 10 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )
	(setq pt4 (polar (cdr (assoc 11 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
									   (cdr (assoc 11 (entget (ssname ss n))))
									   )
								      (/ pi 2)
								    )
			 100.)
	      )

	(setq ss1 (ssget "CP" (list pt1 pt4 pt2 pt3) '((0 . "TEXT"))))
	(if ss1
	  (if (> (sslength ss1) 1)
	    (progn
	      (princ "\nCo >1 TEXT tai vi tri vung chon xung quanh LINE.")
	      (redraw (ssname ss n) 3)
	      )
	    (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m"))
			   (assoc 1 (entget (ssname ss1 0)))
			   (entget (ssname ss1 0)))
		    )
	    )
	  )
	(setq n (1+ n))
	);repeat
      );progn
    (princ "\nBan da khong chon LINE.")
    );if
  (command "zoom" "P")
  (princ)
  )

Download lisp

Filename: 411861_test.lsp

Trang 215/330