Jump to content
InfoFile
Tác giả: phamngoctukts
Bài viết gốc: 150518
Tên lệnh: invis vis invert
Viết lisp theo yêu cầu [phần 2]

Eo ơi, bác Tú kêu bận mà vẫn nhiệt tình giúp CV mem thế ^^

Em xin gửi thêm 1 phương án nữa, trong trường hợp máy có Express thì cả 3...

>>

Eo ơi, bác Tú kêu bận mà vẫn nhiệt tình giúp CV mem thế ^^

Em xin gửi thêm 1 phương án nữa, trong trường hợp máy có Express thì cả 3 hàm sẽ gói lại trong 3 dòng sau :

(defun C:invis()(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng mu\U+1ED1n \U+1EA9n \U+0111i :")(acet-ss-visible (ssget) 1))
(defun C:vis()(prompt "Hi\U+1EC7n l\U+1EA1i c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+00E3 b\U+1ECB \U+1EA9n :")(acet-ss-visible (ssget "_X" '((60 . 1))) 0))
(defun C:invert()(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng hi\U+1EC7n : ")(acet-ss-visible (acet-ss-remove (ssget) (ssget "x")) 1))

Híc định kiếm ít danh tiếng không ngờ gặp ngay hàng khủng :wub:


<<

Filename: 150518_invis_vis_invert.lsp
Tác giả: thanhduan2407
Bài viết gốc: 445477
Tên lệnh: vc vcc
Hướng dẫn lập trình Lisp

Đây là chương trình vẽ cầu

(defun C:VC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CAU
  (MakeLayer_ "4_Giaothong_CAU" 7)
  (or *WidthPline* (setq *WidthPline*...
>>

Đây là chương trình vẽ cầu

(defun C:VC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CAU
  (MakeLayer_ "4_Giaothong_CAU" 7)
  (or *WidthPline* (setq *WidthPline* 0.50))
  (setq
    WidthPline
     (getreal
       (strcat "\nNh\U+1EADp \U+0111\U+1ED9 d\U+00E0y Width c\U+1EA7u   <"
	       (rtos *WidthPline* 2 2)
	       ">: "
       )
     )
  )
  (if (not WidthPline)
    (setq WidthPline *WidthPline*)
    (setq *WidthPline* WidthPline)
  )
  (or *Rau* (setq *Rau* 2.0))
  (setq
    Rau	(getdist
	  (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i r\U+00E2u   <"
		  (rtos *Rau* 2 2)
		  ">: "
	  )
	)
  )
  (if (not Rau)
    (setq Rau *Rau*)
    (setq *Rau* Rau)
  )
  (setq P1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t: "))
  (setq P2 (getpoint P1 "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai: "))
  (setq	P3 (getpoint
	     "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 3 t\U+00EDnh \U+0111\U+1ED9 r\U+1ED9ng c\U+1EA7u: "
	   )
  )
  (setq HuongCau (CCW P1 P2 P3))
  (setq MidP12 (mid P1 P2))
  (MakeLine P1 P2 nil nil "4_Giaothong_CAU" nil nil)
  (setq Line1 (entlast))
  (setq	KC (distance P3
		     (vlax-curve-getClosestPointTo (vlax-ename->vla-object Line1) (trans P3 1 0))
	   )
  )
  (cond	((= HuongCau 1)
	 (Progn
	   (setq P4 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 4)) Rau))
	   (setq P5 (Polar P2 (+ (angle P1 P2) (/ Pi 4)) Rau))
	   (MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
	   (setq ObjPl1 (entlast))
	   (setq Mp1 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (setq Mp2 (Polar P2 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (MakeLine Mp1 Mp2 nil nil "4_Giaothong_CAU" nil nil)
	   (setq Line2 (entlast))
	 )
	)
	((= HuongCau -1)
	 (Progn
	   (setq P4 (Polar P1 (+ (angle P2 P1) (/ Pi 4)) Rau))
	   (setq P5 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 4)) Rau))
	   (MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
	   (setq ObjPl1 (entlast))
	   (setq Mp1 (Polar P1 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (setq Mp2 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
	 )
	)
  )
  (vla-mirror
    (vlax-ename->vla-object ObjPl1)
    (vlax-3D-point Mp1)
    (vlax-3D-point Mp2)
  )
  (setq ObjPl2 (entlast))
  (vla-put-constantwidth (vlax-ename->vla-object ObjPl1) WidthPline)
  (vla-put-constantwidth (vlax-ename->vla-object ObjPl2) WidthPline)
  (entdel Line1)
  (entdel Line2)
  (Princ)
)

(defun C:VCC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CONG
  (MakeLayer_ "4_Giaothong_CAU" 7)
  (or *WidthPline* (setq *WidthPline* 0.50))
  (setq
    WidthPline
     (getreal
       (strcat "\nNh\U+1EADp \U+0111\U+1ED9 d\U+00E0y Width c\U+1EA7u   <"
	       (rtos *WidthPline* 2 2)
	       ">: "
       )
     )
  )
  (if (not WidthPline)
    (setq WidthPline *WidthPline*)
    (setq *WidthPline* WidthPline)
  )
  (or *Rau* (setq *Rau* 0.5))
  (setq
    Rau	(getdist
	  (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i r\U+00E2u   <"
		  (rtos *Rau* 2 2)
		  ">: "
	  )
	)
  )
  (if (not Rau)
    (setq Rau *Rau*)
    (setq *Rau* Rau)
  )
  (if (> Rau 0.5)
    (setq Rau 0.5)
  )
  (setq P1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t: "))
  (setq P2 (getpoint P1 "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai: "))
  
  (setq HuongCau (CCW P1 P2 P2))
  (setq MidP12 (mid P1 P2))
  (MakeLine P1 P2 nil nil "4_Giaothong_CAU" nil nil)
  (setq Line1 (entlast))
  (setq	KC (distance P2
		     (vlax-curve-getClosestPointTo (vlax-ename->vla-object Line1) (trans P2 1 0))
	   )
  )
  (cond	((= HuongCau 1)
	 (Progn
	   (setq P4 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 4)) Rau))
	   (setq P5 (Polar P2 (+ (angle P1 P2) (/ Pi 4)) Rau))
	   (MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
	   (setq ObjPl1 (entlast))
	   (setq Mp1 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (setq Mp2 (Polar P2 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (MakeLine Mp1 Mp2 nil nil "4_Giaothong_CAU" nil nil)
	   (setq Line2 (entlast))
	 )
	)
	((= HuongCau -1)
	 (Progn
	   (setq P4 (Polar P1 (+ (angle P2 P1) (/ Pi 4)) Rau))
	   (setq P5 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 4)) Rau))
	   (MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
	   (setq ObjPl1 (entlast))
	   (setq Mp1 (Polar P1 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
	   (setq Mp2 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
	 )
	)
  )
  (vla-mirror
    (vlax-ename->vla-object ObjPl1)
    (vlax-3D-point Mp1)
    (vlax-3D-point Mp2)
  )
  (setq ObjPl2 (entlast))
  (vla-put-constantwidth (vlax-ename->vla-object ObjPl1) WidthPline)
  (vla-put-constantwidth (vlax-ename->vla-object ObjPl2) WidthPline)
  (entdel Line1)
  (entdel Line2)
  (Princ)
)



(defun mid (p1 p2)
  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)
(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 CV:List-to-ss (lst / ss)
  (setq ss (ssadd))
  (foreach item	lst
    (or	(= (type item) 'Ename)
	(setq item (vlax-vla-object->ename item))
    )
    (setq ss (ssadd item ss))
  )
  ss
)
;;;(LM:UniqueFuzz (list 1 2 3 4 4 4 5 5 5 3 6 7 7 7 7  9) 0.0001)
(defun LM:UniqueFuzz (l f)
  (if l
    (cons (car l)
	  (LM:UniqueFuzz
	    (vl-remove-if
	      (function (lambda (x) (equal x (car l) f)))
	      (cdr l)
	    )
	    f
	  )
    )
  )
)
(defun MakeLayer_ (name colour /)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 name)
	(cons 62 colour)
      )
    )
  )
)
(defun MakeLWPolyline
		      (listpoint closed Linetype LTScale Layer Color xdata / Lst)
  (setq	Lst (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons	8
			(if Layer
			  Layer
			  (getvar "Clayer")
			)
		  )
		  (cons	6
			(if Linetype
			  Linetype
			  "bylayer"
			)
		  )
		  (cons	48
			(if LTScale
			  LTScale
			  1
			)
		  )
		  (cons	62
			(if Color
			  Color
			  256
			)
		  )
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length listpoint))
		  (cons	70
			(if closed
			  1
			  0
			)
		  )
	    )
  )
  (foreach PP listpoint
    (setq Lst (append Lst (list (cons 10 PP))))
  )
  (if xdata
    (setq Lst (append lst (list (cons -3 (list xdata)))))
  )
  (entmakex Lst)
)
(defun MakeLine	(PT1 PT2 Linetype LTScale Layer Color xdata)
  (entmakex (list '(0 . "LINE")
		  (cons	8
			(if Layer
			  Layer
			  (getvar "Clayer")
			)
		  )
		  (cons	6
			(if Linetype
			  Linetype
			  "bylayer"
			)
		  )
		  (cons	48
			(if LTScale
			  LTScale
			  1
			)
		  )
		  (cons	62
			(if Color
			  Color
			  256
			)
		  )
		  (cons 10 PT1)
		  (cons 11 PT2)
		  (cons	-3
			(if xdata
			  (list xdata)
			  nil
			)
		  )
	    )
  )
)


;;;;;; XET DIEM BEN TRAI HAY PHAI DOAN THANG;;;;;;;;;;;;;;;;;;;
(defun CCW (P1 P2 P / CCW1 D DX DX0 DY DY0)
  (setq	dX  (- (car P) (car P1))
	dY  (- (cadr P) (cadr P1))
	dX0 (- (car P2) (car P1))
	dY0 (- (cadr P2) (cadr P1))
	d   (- (* dX dY0) (* dY dX0))
  )
  (if (>= d 0)
    (setq CCW1 1)
    (setq CCW1 -1)
  )
  CCW1
)

 


<<

Filename: 445477_vc_vcc.lsp
Tác giả: Tue_NV
Bài viết gốc: 69792
Tên lệnh: ssb
Hỏi lisp về Region
Bạn chạy thử Lisp Highlight đối tuợng Region bao ngoài (nếu có) trong tập hợp các đối tuợng Region.

Sau đó việc erase, move, copy ... bạn tùy nghi xử...

>>
Bạn chạy thử Lisp Highlight đối tuợng Region bao ngoài (nếu có) trong tập hợp các đối tuợng Region.

Sau đó việc erase, move, copy ... bạn tùy nghi xử lý.

Chú ý : Lisp này không tạo ra Region mà chỉ chọn ra Region bao ngoài trong tập hợp các đối tuợng Region.

(defun C:ssb(/ ss ss1 boundary e minPt maxPt )  ;select region boundary
 (vl-load-com)
 (setq ss1 (ssadd))
 (if (setq ss (ssget (list (cons 0 "REGION")  ) ) )
   (progn
     (setq boundary (boundarySS ss))
     (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(vla-getBoundingBox e 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt)
      maxPt (vlax-safearray->list maxPt))
(if (equal (list minPt  maxPt ) boundary 0.001)
  (setq ss1 (ssadd (vlax-vla-object->ename e) ss1))
  )
); foreach
     (if (>(sslength ss1)0)(sssetfirst nil ss1) )
     ); progn
   ); if  
 )
;ham tra ve 2 diem (LowerLeft TopRight) cua hinh chu nhat bao quanh cac doi tuong 
(defun boundarySS (ss / all_max all_min ll maxpt minpt ur); 
 (setq	all_min	(list)
all_max	(list)  ) 
 (foreach x (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (vla-GetBoundingBox x 'minpt 'maxpt)
   (setq all_min (cons (vlax-safearray->list minpt) all_min)
  all_max (cons (vlax-safearray->list maxpt) all_max)  )
   ) ;foreach
 (setq ll (list (car (vl-sort (mapcar 'car all_min) '		 (car (vl-sort (mapcar 'cadr all_min) '		 (car (vl-sort (mapcar 'caddr all_min) '	ur (list (last (vl-sort (mapcar 'car all_max) '		 (last (vl-sort (mapcar 'cadr all_max) '		 (last (vl-sort (mapcar 'caddr all_max) '	) ;setq
 (list ll  ur )
 )

Chào anh gia bách

Lisp trên thật hay.

Anh cho Tue_NV hỏi 1 tý : là các hàm vla ... . Ví dụ như hàm vla-getBoundingBox thì đọc Help ở đâu?

Tue_NV đã đọc trong cuốn acad_dev nhưng tìm hoài không thấy các hàm vla. Mong anh hướng dẫn giúp.

Cảm ơn anh


<<

Filename: 69792_ssb.lsp
Tác giả: anhduccec
Bài viết gốc: 319835
Tên lệnh: dd
Giao diện hộp thoại trong AutoLisp

(DEFUN C:DD (/ tp tm ddiag ss DIMT_FAC fname fn saveVars1 saveVars2 create_dialog doButton vectors vtm3 vtm4)

(defun create_dialog...

>>

(DEFUN C:DD (/ tp tm ddiag ss DIMT_FAC fname fn saveVars1 saveVars2 create_dialog doButton vectors vtm3 vtm4)

(defun create_dialog ()

(setq fname (vl-filename-mktemp "dcl.dcl"))

(setq fn (open fname "w"))

(write-line "

cuatui : dialog {

label = \"****DUNG SAI_CHE TAO MAY****\";

: column {

:row {

:column {

: image_button {

key = \"M3\";

width =30;

color = 2;

aspect_ratio = 1 ;

}

: toggle {

label = \"lua chon(h) \" ;

key = \"luachon\" ;

}

: edit_box {

key = \"myvalue3\";

label = \"Dung sai(h):\";

edit_width = 5;

value = \"0.1\";

}

}

:row {

:column {

: image_button {

key = \"M4\";

width =30;

color = 2;

aspect_ratio = 1 ;

}

: edit_box {

key = \"myvalue1\";

label = \"Max(h):\";

edit_width =5;

value = \"0\";

}

: edit_box {

key = \"myvalue2\";

label = \"Min(f):\";

edit_width = 5;

value = \"0.02\";

}}}

}

}

: row {

: button {

key = \"accept\" ;

label = \" Ch\U+1ECDn K\U+00EDch Th\U+01B0\U+1EDBc \" ;

is_tab_stop = true;

is_cancel = false;

is_default = true;

width = 6;

height = 2;

mnemonic = \"B\";

}

: button {

key = \"luachon1\";

label = \"HELP\";

is_default = false;

}

: button {

key = \"cancel\";

label = \" Cancel \";

is_default = false;

is_cancel = true;

height = 2 ;

}

}

}

" fn)

(close fn))

(defun doButton(a)

(cond

((= a 1)(alert "chuong trinh viet boi BUI DINH NGUYEN,

Moi su gop y xin vui lien he qua Gmail: nguyenbd159@gmail.com. hoac phone: 097415548!"))

((= a 2)(alert "Nut nay khong can thiet!"))

)

)

;;;;;;;;;; Vectors image

(defun vectors (img vt-img / X# Y#)

(start_image img)

(setq X# (dimx_tile img))

(setq Y# (dimy_tile img))

(fill_image 0 0 X# Y# 0)

(vt-img)

(end_image)

)

(defun vtm3 ()

(mapcar 'vector_image; Color 6

(list 135 143 141 140 138 137 135 135 135 127 127 127 148 150 151 153 155 156 157 158 159 145 144 135 136 138 139 141 142 144 145 147 160 161 161 162 162 163 163 163 155 155 155 155 154 154 153 152 151 149 147 147 163 162 162 162 161 161 160 160 159 159 158 158 157 156 155 155 155 154 154 154 153 153 152 152 151 150 149 148 147 146 145 144 143 143 142 141 141 141 140 140 139 139 138 138 137 137 137 136 136 135 135 134 133 132 131 130 129 128 100 100 117 100 100 94 94 77 77 77 94 94 117 77 77 77 116 116 115 115 114 114 113 113 112 112 111 111 110 110 109 109 108 108 107 107 106 106 105 105 104 104 103 103 102 102 101 101 100 100 99 99 98 98 97 97 96 96 95 95 94 94 94 93 93 92 92 91 91 90 90 89 89 88 88 87 87 86 86 85 85 84 84 83 83 82 82 81 81 80 80 79 79 78 78 38 40 41 43 45 47 48 50 51 53 54 56 57 58 59 27 27 58 57 56 54 53 52 50 49 47 45 44 42 40 38 38 19 19 19 60 61 62 63 64 64 65 66 66 67 67 67 68 68 68 68 68 68 68 68 67 67 67 66 66 65 64 64 63 62 61 60 59 27 37 40 42 44 46 47 49 50 52 53 54 55 55 56 57 58 58 59 59 60 60 60 60 60 60 60 59 59 58 58 57 56 56 55 54 53 52 51 50 48 46 45 43 41 38 37 68 68 68 68 67 67 67 67 66 66 66 65 65 65 65 64 64 63 63 63 62 62 61 61 60 60 60 60 60 60 60 59 59 59 59 59 59 59 59 58 58 58 58 58 58 57 57 57 57 57 56 56 56 56 56 55 55 55 55 55 55 54 54 54 54 53 53 53 53 53 52 52 51 51 51 51 50 50 50 50 49 49 48 48 48 47 47 46 46 46 46 45 45 44 44 44 44 43 43 42 42 41 41 40 40 39 39 38 38 37 37 36 36 35 35 34 34 33 33 32 32 31 31 30 30 29 29 28 28 27 27 27 26 25 24 23 22 21 20)

(list 61 84 85 85 87 88 89 89 90 121 61 61 77 77 77 77 78 78 79 80 81 83 83 83 82 80 79 78 78 77 77 77 82 83 84 86 87 89 91 93 121 93 91 89 87 86 85 84 84 83 83 83 89 87 86 85 84 83 82 81 81 80 80 79 79 78 78 78 78 78 77 77 77 77 77 77 77 77 77 77 77 77 77 77 77 78 78 78 78 79 79 79 79 80 80 81 81 81 82 82 83 83 61 61 61 61 61 61 61 61 70 86 86 93 93 110 93 93 86 86 70 70 114 121 114 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 70 114 70 114 70 114 70 114 70 114 70 114 70 114 86 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 86 114 61 61 61 61 61 62 62 62 63 63 64 65 65 66 67 68 68 116 116 117 118 118 119 119 120 120 121 121 121 121 121 121 121 61 61 68 69 70 71 72 73 75 76 77 79 80 82 84 85 87 89 91 93 94 96 100 100 101 104 104 107 108 108 111 112 113 114 115 114 114 114 114 114 113 113 112 112 111 110 109 108 108 107 105 102 102 99 99 96 94 92 91 89 87 85 83 81 80 78 77 75 74 74 73 72 71 71 70 69 69 69 68 68 68 68 90 85 83 82 81 80 79 78 77 77 76 75 74 74 73 73 72 72 71 70 70 69 69 68 68 68 93 68 96 67 98 67 99 67 100 67 101 67 102 66 102 103 66 104 66 66 105 66 65 106 65 106 107 65 108 65 108 64 108 64 109 64 109 64 110 64 110 63 110 63 63 111 63 111 63 112 63 112 62 112 62 112 62 112 113 62 113 62 113 61 113 61 113 61 113 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 114 61 61 61 61 61 61 61 61)

(list 135 144 143 141 140 138 137 135 135 135 127 135 150 151 153 155 156 157 158 159 160 147 145 136 138 139 141 142 144 145 147 148 161 161 162 162 163 163 163 163 163 155 155 155 155 154 154 153 152 151 149 147 163 162 162 162 161 161 160 160 159 159 158 158 157 156 155 155 155 154 154 154 153 153 152 152 151 150 149 148 147 146 145 144 143 143 142 141 141 141 140 140 139 139 138 138 137 137 137 136 136 135 135 134 133 132 131 130 129 128 100 117 117 117 100 100 94 94 77 94 94 100 117 117 77 117 116 116 115 115 114 114 113 113 112 112 111 111 110 110 109 109 108 108 107 107 106 106 105 105 104 104 103 103 102 102 101 101 100 100 99 99 98 98 97 97 96 96 95 95 94 94 94 93 93 92 92 91 91 90 90 89 89 88 88 87 87 86 86 85 85 84 84 83 83 82 82 81 81 80 80 79 79 78 78 40 41 43 45 47 48 50 51 53 54 56 57 58 59 60 37 27 59 58 57 56 54 53 52 50 49 47 45 44 42 40 38 38 19 38 61 62 63 64 64 65 66 66 67 67 67 68 68 68 68 68 68 68 68 68 68 67 67 67 66 66 65 64 64 63 62 61 60 37 40 42 44 46 47 49 50 52 53 54 55 55 56 57 58 58 59 59 60 60 60 60 60 60 60 60 60 59 59 58 58 57 56 56 55 54 53 52 51 50 48 46 45 43 41 38 68 68 68 68 67 67 67 67 66 66 66 65 65 65 65 64 64 63 63 63 62 62 61 61 60 60 60 60 60 60 60 59 59 59 59 59 59 59 59 58 58 58 58 58 58 57 57 57 57 57 56 56 56 56 56 55 55 55 55 55 55 54 54 54 54 53 53 53 53 53 52 52 51 51 51 51 50 50 50 50 49 49 48 48 48 47 47 46 46 46 46 45 45 44 44 44 44 43 43 42 42 41 41 40 40 39 39 38 38 37 37 36 36 35 35 34 34 33 33 32 32 31 31 30 30 29 29 28 28 27 27 27 26 25 24 23 22 21 20)

(list 83 83 84 85 85 87 88 90 121 121 121 61 77 77 77 78 78 79 80 81 82 83 83 82 80 79 78 78 77 77 77 77 83 84 86 87 89 91 93 121 121 121 93 91 89 87 86 85 84 84 83 83 121 121 121 121 121 121 121 121 121 121 121 121 121 121 121 90 88 88 87 86 86 85 85 84 84 83 83 83 83 83 83 83 84 84 84 84 85 85 85 86 86 86 87 87 87 88 88 89 89 90 121 121 121 121 121 121 121 121 86 86 93 93 110 110 110 93 93 86 86 70 121 121 121 114 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 110 121 110 121 110 121 110 121 110 121 110 121 110 121 93 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 93 121 61 61 61 61 62 62 62 63 63 64 65 65 66 67 68 68 114 115 116 116 117 118 118 119 119 120 120 121 121 121 121 121 121 121 61 69 70 71 72 73 75 76 77 79 80 82 84 85 87 89 91 93 94 96 98 98 101 103 103 106 106 107 110 110 111 112 113 114 114 114 114 114 113 113 112 112 111 110 109 108 108 107 105 104 104 101 101 97 97 96 94 92 91 89 87 85 83 81 80 78 77 75 74 74 73 72 71 71 70 69 69 69 68 68 68 91 96 98 99 101 102 103 103 104 105 106 107 107 108 108 109 110 110 111 111 112 113 113 114 114 88 114 86 114 84 114 83 115 82 115 81 115 80 115 79 115 116 78 116 77 77 116 76 76 117 75 117 117 74 117 74 117 74 118 73 118 73 118 72 118 72 118 72 119 71 71 119 71 119 70 119 70 119 70 120 70 120 69 120 120 69 120 69 120 69 121 69 121 69 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 68 121 121 121 121 121 121 121 121 121)

(list 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6)

);mapcar

)

(defun vtm4 ()

(mapcar 'vector_image; Color 3

(list 129 131 132 130 129 124 125 126 127 129 128 127 127 127 127 127 131 127 127 123 123 120 120 120 123 123 123 123 118 118 107 107 107 136 140 138 137 136 136 133 133 133 143 145 146 147 148 141 136 138 139 140 142 149 150 150 150 150 146 146 146 146 145 144 143 142 119 119 127 119 119 116 116 108 108 108 116 116 64 66 68 71 73 74 76 78 80 81 83 84 53 53 85 84 82 81 79 78 76 74 72 70 68 66 64 45 45 45 85 87 88 89 90 91 91 92 93 93 94 94 94 94 95 94 94 94 94 93 93 92 92 91 90 89 88 87 86 53 64 66 69 71 73 75 77 78 80 81 82 83 83 84 85 85 86 86 86 86 86 86 85 85 84 83 82 82 81 79 78 76 75 73 71 68 66 64 150 150 150 149 149 148 148 147 146 146 146 145 144 143 142 141 141 140 140 139 139 138 138 137 137 137 136 135 134 131 130 130 129 129 128 128 128 127 127 127 127 126 126 125 125 124 124 124 124 123 123 123 123 122 122 121 121 120 119 119 118 117 117 116 116 116 115 115 114 114 113 113 112 112 111 111 110 110 109 109 108 95 94 94 94 94 93 93 93 92 92 92 91 91 91 90 90 89 89 88 88 87 87 86 86 86 86 86 86 86 86 85 85 85 85 85 85 85 85 84 84 84 84 84 84 83 83 83 83 83 83 83 82 82 82 82 81 81 81 81 80 80 80 80 79 79 79 79 78 78 77 77 77 77 77 76 76 76 75 75 75 74 74 74 73 73 72 72 72 71 71 71 70 70 70 69 69 69 68 68 67 67 66 66 65 65 64 64 63 63 62 62 61 61 60 60 59 59 58 58 57 57 56 56 55 55 54 54 53 53 53 52 51 50 49 48 47 46)

(list 97 97 97 100 100 99 98 97 97 97 100 101 101 102 104 105 105 108 108 127 108 108 105 105 104 102 100 100 118 114 114 114 118 57 69 70 71 72 72 87 57 57 65 65 65 66 67 68 68 67 66 65 65 68 69 71 72 73 87 73 71 70 69 68 68 68 62 71 71 74 74 82 74 74 71 71 62 62 62 62 62 63 63 63 64 64 65 66 66 67 69 69 116 117 118 119 120 120 121 121 122 122 122 122 122 122 62 62 68 69 70 72 73 74 76 77 79 81 83 85 86 89 91 94 94 96 98 102 102 106 106 109 110 112 113 114 115 115 115 115 115 114 114 113 113 112 111 110 109 106 106 104 101 101 96 94 92 89 87 85 83 81 79 78 76 75 74 73 72 71 71 70 70 69 69 69 72 70 69 68 67 67 66 66 66 65 65 65 65 65 65 65 65 65 66 66 66 67 67 67 68 68 57 57 57 97 97 105 97 105 97 105 97 97 105 97 97 71 97 71 98 71 98 99 100 71 100 101 105 71 105 71 105 71 71 62 62 62 114 62 114 71 71 114 71 114 71 114 71 114 71 114 71 114 71 114 114 90 86 85 83 82 81 80 79 78 77 76 76 75 74 74 73 72 71 71 70 70 69 69 95 69 97 69 99 68 100 68 101 68 102 68 103 68 104 67 104 67 105 67 106 67 106 67 107 66 66 108 66 108 66 109 66 109 65 110 65 110 111 65 65 111 112 64 64 112 64 112 113 64 113 64 113 63 63 113 114 63 114 63 63 114 63 114 114 63 114 115 63 115 62 62 115 62 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 115 62 62 62 62 62 62 62 62)

(list 131 132 132 132 130 125 126 127 129 129 129 128 127 127 127 131 131 131 127 127 123 123 120 123 123 123 123 124 118 118 118 107 118 136 141 140 138 137 136 136 133 136 145 146 147 148 149 142 138 139 140 142 143 150 150 150 150 150 150 146 146 146 146 145 144 143 119 127 127 127 119 119 116 116 108 116 116 119 66 68 71 73 74 76 78 80 81 83 84 85 64 53 86 85 84 82 81 79 78 76 74 72 70 68 66 64 45 64 87 88 89 90 91 91 92 93 93 94 94 94 94 95 95 95 94 94 94 94 93 93 92 92 91 90 89 88 87 64 66 69 71 73 75 77 78 80 81 82 83 83 84 85 85 86 86 86 86 86 86 86 86 85 85 84 83 82 82 81 79 78 76 75 73 71 68 66 150 150 150 149 149 148 148 147 146 146 146 145 144 143 142 141 141 140 140 139 139 138 138 137 137 137 136 135 134 131 130 130 129 129 128 128 128 127 127 127 127 126 126 125 125 124 124 124 124 123 123 123 123 122 122 121 121 120 119 119 118 117 117 116 116 116 115 115 114 114 113 113 112 112 111 111 110 110 109 109 108 95 94 94 94 94 93 93 93 92 92 92 91 91 91 90 90 89 89 88 88 87 87 86 86 86 86 86 86 86 86 85 85 85 85 85 85 85 85 84 84 84 84 84 84 83 83 83 83 83 83 83 82 82 82 82 81 81 81 81 80 80 80 80 79 79 79 79 78 78 77 77 77 77 77 76 76 76 75 75 75 74 74 74 73 73 72 72 72 71 71 71 70 70 70 69 69 69 68 68 67 67 66 66 65 65 64 64 63 63 62 62 61 61 60 60 59 59 58 58 57 57 56 56 55 55 54 54 53 53 53 52 51 50 49 48 47 46)

(list 97 97 100 100 100 98 97 97 97 97 100 100 102 104 105 105 108 108 127 127 127 108 108 105 105 104 102 99 118 118 114 118 118 68 68 69 70 71 87 87 87 57 65 65 66 67 68 68 67 66 65 65 65 69 71 72 73 87 87 87 73 71 70 69 68 68 71 71 74 74 82 82 82 74 74 71 71 62 62 62 63 63 63 64 64 65 66 66 67 68 69 115 115 116 117 118 119 120 120 121 121 122 122 122 122 122 122 62 69 70 72 73 74 76 77 79 81 83 85 86 89 91 92 92 96 98 100 100 104 104 107 107 109 110 112 113 114 115 115 115 114 114 113 113 112 111 110 109 108 108 104 103 103 99 99 96 94 92 89 87 85 83 81 79 78 76 75 74 73 72 71 71 70 70 69 69 87 87 87 87 87 87 87 87 71 70 69 69 68 68 68 68 69 69 69 69 70 70 71 71 71 72 87 87 87 100 100 108 100 108 100 108 101 101 108 102 127 74 127 74 127 74 127 127 127 74 127 127 108 74 108 74 108 74 74 82 82 82 118 82 118 74 74 118 74 118 74 118 74 118 74 118 74 118 74 118 118 93 97 99 101 102 103 104 105 106 107 108 108 109 110 110 111 112 113 113 114 114 115 89 115 86 115 85 116 84 116 83 116 82 116 81 116 80 117 80 117 79 117 78 117 78 117 77 118 77 76 118 76 118 75 118 75 119 74 119 74 119 119 73 73 120 120 72 72 120 72 120 120 71 121 71 121 71 71 121 121 71 121 70 70 121 70 121 122 70 122 122 70 122 70 70 122 69 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 69 122 122 122 122 122 122 122 122 122)

(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)

);mapcar

)

;;;;;;;;;;;;

(create_dialog)

(setq dcl_id (load_dialog fname))

(if (not (new_dialog "cuatui" dcl_id))

(exit)

)

;;;

(defun saveVars2()

(setq DIMT_FAC "0.5" )

(setq tp (atof (get_tile "myvalue1")))

(setq tm (atof (get_tile "myvalue2")))

)

;;;

(defun saveVars1()

(setq DIMT_FAC "1.0" )

(setq

tp (atof (get_tile "myvalue3"))

tm tp )

)

;;;

(defun huybo ()(princ "\n... DUNG SAI Cancelled. \n ")(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun thuchien (/ oldcmd)

(setq oldcmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(if (setq ss (ssget '((0 . "DIMENSION"))))

(command "_.dimoverride"

"DIMTOL" "ON"

"DIMTDEC" 2

"DIMtad" 1

"DIMtolj" 1

"dimclrt" 200

"dimalttz" 10

"dimtzin" 8

"DIMTFAC" DIMT_FAC

"DIMTP" TP

"DIMTM" TM

""

ss

"")

(princ "\n<<>>"))

(setvar "CMDECHO" oldcmd)

(Princ))

;;;

(vectors "M3" vtm3)

(vectors "M4" vtm4)

(action_tile "luachon" "(doButton 2)")

(action_tile "luachon1" "(doButton 1)")

(action_tile "cancel" "(done_dialog)(huybo)")

(action_tile "accept" "(doButton 2)")

(action_tile "M3" "(setq ddiag T)(saveVars1)(done_dialog)")

(action_tile "M4" "(setq ddiag T)(saveVars2)(done_dialog)")

(start_dialog)

(unload_dialog dcl_id)

(if (= ddiag T)(thuchien))

(princ))

 

 

 

 

 

 

 

 

có tải về được đâu bạn

Uh, không hiểu tại sao, gửi lại.


<<

Filename: 319835_dd.lsp
Tác giả: ancontau
Bài viết gốc: 402883
Tên lệnh: ll lgt lc ln lh l%2F lmh
Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi
;;;============================================================================================
;;;-------------------LINK GIA...
>>
;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
				ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso	(I_REAL "\n Nhap he so nhan" hso)
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).Length \\f \"%lu2"
										"%pr" (rtos ltr 2 0)
										"%ct8"
										"\">%"
						)

	)
	(vla-put-textstring obd Tkq)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).TextString>%"
						)
	)
	(vla-put-textstring obd Tkq)
	(vla-update obd)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
	(START_PG) 
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt "%<\\AcExpr (0")
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "+"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
	(START_PG)
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt 	"%<\\AcExpr (1"
	)
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "*"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK HIEU

(defun C:LH (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))
	(setq ent1 (car (C_S2L ss1))
				ent2 (car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK CHIA

(defun C:L/ (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))
	(setq ent1 	(car (C_S2L ss1))
				ent2 	(car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
	(START_PG) 
	(setq	42pan	(I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
				ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso		(I_REAL "\n Nhap he so nhan" hso)
				Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
				Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
				Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
				Tgt 	"%<\\AcExpr (0"
				dem		0
	)
	(if (null Lst3)
		(while (null (setq pt1 (getpoint "\n X dat cot: "))))
	)
	(if (/= (length Lst1) (length Lst2))
		(progn
			(alert "So hang cua 2 cot khong bang nhau. Chon lai")
			(exit)
		)
	)
	(repeat (length Lst1)
		(setq ent1 (nth dem Lst1)
					ent2 (nth dem Lst2)
		)
		(if Lst3
			(setq ent3 (nth dem Lst3))
			(setq ent3 nil)
		)
		(setq dem (1+ dem))
		(cond	(	(= 42pan "C")
						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))
					)
					(	(= 42pan "N")
						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))
					)
					(	(= 42pan "CH")
						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))
					)
		)
		(if	(/= ent3 nil)
			(progn
				(setq ob (entget ent3))
				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
			)
			(progn
				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)
								 (= (caddr (assoc 11 (entget ent1))) 0.0)
						)
					(setq Tj 10)
					(setq Tj 11)
				)
				(setq	ent1	(entget ent1)
							pt1		(list (car pt1) (caddr (assoc Tj ent1)))
			 	)
				(entmakex (list	'(0 . "TEXT")
												'(100 . "AcDbEntity")
												(assoc 8 ent1)
												'(100 . "AcDbText")
												(cons Tj pt1)
												(assoc 40 ent1)
												(cons 1 Tgt)
												(assoc 50 ent1)
												(assoc 41 ent1)
												(assoc 51 ent1)
												(assoc 7 ent1)
												(assoc 71 ent1)
												(assoc 72 ent1)
												'(100 . "AcDbText")
												(assoc 73 ent1)
									)
				)
			)
		)
	)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)
;;;============================================================================================
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;============================================================================================

(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2"
															"%pr" (itoa ltr)
															"%ct8\""
					">%"
	)
)


(defun OWNER_ENAME (obn)
	(vlax-vla-object->ename
		(vla-objectidtoobject
			(vla-get-activedocument (vlax-get-acad-object))
			(vla-get-ownerid
				(vlax-ename->vla-object obn)
			)
		)
	)
)

;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
;;;===============================================================
;;;---------- CAC HAM THIET LAP BAY LOI, RESTORE------------------
;;;===============================================================

;;;HAM BAY LOI
(defun INIT	()
	(setq	OLD_ERROR	*error*
				*error*	MYERROR
	)
	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

	(cond
		((= errmsg "quit / exit abort")
		 (princ)
		)
		((/= errmsg "Function cancelled")
		 (princ (strcat "\n Co loi: " errmsg))
		)
	)

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(setvar "cmdecho" 1)
	(command "Undo" "end")
	(DONE)
	(prompt "\n Da Reset lai thiet lap ban dau")


)

(defun DONE	()
	(if	OLD_ERROR
		(setq *error* OLD_ERROR)
	)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()

	(setvar "cmdecho" 0)
	(command "Undo" "begin")
	(command "UCS" "W")
	(setq	OLD_OSMODE		(getvar "OSMODE")
				OLD_CECOLOR		(getvar "CECOLOR")
				OLD_AUTOSNAP	(getvar "AUTOSNAP")
				OLD_ORTHOMODE	(getvar "ORTHOMODE")
				OLD_CLAYER		(getvar "clayer")
				OLD_DIMZIN		(getvar "DIMZIN")
	)
	(setvar "DIMZIN" 0)

)
(defun RESTORE ()

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(command "Undo" "end")
	(setvar "cmdecho" 1)
	(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
(defun START_PG	(/ ss)
	(setq ss (ssget "I"))

	(INIT)
	(SAVE_MODE)
	(sssetfirst nil ss)
)

(defun END_PG	()
	(DONE)
	(RESTORE)
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0	(dongnhac Tso)
	(if	(null Tso)
		(progn
			(initget (+ 1 4))
			(getint (strcat dongnhac " <?>:"))
		)
		(progn
			(cond
				((progn
					 (initget 4)
					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL	(dongnhac Tso / Tso1)
	(if	(null Tso)
		(progn
			(initget (+ 1 2))
			(setq Tso (getdist (strcat dongnhac " <?>:")))
			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
			Tso
		)
		(progn
			(cond
				((progn
					 (initget (+ 2))
					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
					 (if Tso1
						 (progn
							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
							 (setq Tso Tso1)
						 )
					 )
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick
	(prompt dongnhac)
	(while (/= (car mouse) 2)
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
	 		(if (setq sel (car (nentselp (cadr mouse))))
				(progn
					(setq Lsel (append Lsel (list sel)))
					(princ (strcat "\n" (itoa (length Lsel)) " doi tuong duoc pick chon/ENTER ke ket thuc chon"))
				)
				(princ "\nChon chua dung!")
			)
		)
	)
	Lsel
)

;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
	(prompt "\n Chon text chua kq / An enter de viet text kq...")
	(while (and (/= (car mouse) 2) (null sel))
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
			(if (null (setq sel (car (nentselp (cadr mouse)))))
					(princ "\nChon chua dung! Chon lai...")
			)
		)
	)
	(if	(/= sel nil)
		(progn
			(setq ob (entget sel))
			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
		)
		(progn
			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
			(if	Tmau
				(progn
					(if	(and (= (cadr (assoc 11 (entget Tmau))) 0.0)
									 (= (caddr (assoc 11 (entget Tmau))) 0.0)
							)
						(setq Tj 10)
						(setq Tj 11)
					)
					(setq	Tmau	(entget Tmau))
					(entmakex (list	'(0 . "TEXT")
													'(100 . "AcDbEntity")
													(assoc 8 Tmau)
													'(100 . "AcDbText")
													(cons Tj pt1)
													(assoc 40 Tmau)
													(cons 1 Tkq)
													(assoc 50 Tmau)
													(assoc 41 Tmau)
													(assoc 51 Tmau)
													(assoc 7 Tmau)
													(assoc 71 Tmau)
													(assoc 72 Tmau)
													'(100 . "AcDbText")
													(assoc 73 Tmau)
										)
					)
				)
			)
		)
	)

)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
											 (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
									 )
							)
				 )
	)
	ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
	(if	ss
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		nil
	)
)

;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)

	(if	(null Text)
		(progn
			(initget 1 key)
			(getkword (strcat dongnhac " :"))
		)
		(progn
			(cond
				((progn
					 (initget key)
					 (getkword (strcat dongnhac " < " Text " >:"))
				 )
				)
				(T Text)

			)
		)

	)
)

(defun OD_SSY_DES_L	(Lst)
	(setq	lst	(vl-sort lst
										 '(lambda	(e1 e2)
												(>
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e1))) 0.0)
																						(= (caddr (assoc 11 (entget e1))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e1)
																 )
													)
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e2))) 0.0)
																						(= (caddr (assoc 11 (entget e2))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e2)
																 )
													)
												)
											)
						)
	)
)

;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
											 (setq ss (ssget '((0 . "*TEXT"))))
									 )
							)
				 )
	)
	ss
)

;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM	(dongnhac / ss)
	(prompt dongnhac)
	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))
		(setq ss (ssget '((0 . "*TEXT"))))
	)
	ss
)

lisp sửa chạy dc trên cad 64 bit

 

phongtran86 quá tuyệt, quá pro, cám ơn bạn mình hóng lâu quá rồi!!!!!!!!!!!!


<<

Filename: 402883_ll_lgt_lc_ln_lh_l%2F_lmh.lsp
Tác giả: quan_elec
Bài viết gốc: 95776
Tên lệnh: draw name
viết lisp thống kê bản vẽ
Nếu sử dụng hàm Vxgetatt của anh gia_bach sẽ bị lỗi Font Unicode. Anh gia_bach xem lại code của anh 1 tý.

Đây là code mà Tue_NV viết lại -> quan_elec' chạy thử...

>>
Nếu sử dụng hàm Vxgetatt của anh gia_bach sẽ bị lỗi Font Unicode. Anh gia_bach xem lại code của anh 1 tý.

Đây là code mà Tue_NV viết lại -> quan_elec' chạy thử nhé :

Chạy với file mà file của bạn đã upload lên đây. Chú ý chọn Font chữ hiện hành giống với font chữ trong Khung tên

Đó là Style : KHUNGTEN-TIEUDE (font chữ Aria -Bảng mã Unicode)

Bạn chạy thử với code sau -> Tue_NV đã chỉnh lại :

(defun c:draw_name (/ att doc i kyhieu lst lstatt msp pt row ss tblobj ten) ;Bang ten ban ve
;; By : Gia Bach, Copyright- December 2009 ;;
;; Contact : gia_bach @ www.CadViet.com ;;
;Develop  by Tue_NV. Contact :  @tue_nvcc@yahoo.com
(defun VxGetAtts (Obj / L)
(setq L '())
(while (not (= (cdr(assoc 0 (entget (setq e (entnext e))
		     ))) "SEQEND"))
(setq L (append L (list (list (cdr(assoc 2 (entget e)))
	              (cdr(assoc 1 (entget e)))
		)
	  )
)
)
)
);defun
(SETQ lst '())
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn

(if (setq ss (ssget "_A"(list (cons 0 "INSERT")(cons 66 1)(cons 2 "KT"))))
(progn
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
msp (vla-get-modelspace doc))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq lstAtt (VxGetAtts e)
kyhieu (cadr (assoc "DWNNO" lstAtt))
ten (cdr (assoc "DRAWING" lstAtt)))
(setq lst (cons (cons kyhieu ten) lst)) )
(setq lst (vl-sort lst '(lambda (x y) (< (atoi(substr (car x) 4 (- (strlen (car x)) 3)))
(atoi (substr (car y) 4 (- (strlen (car y)) 3)))
) ) ))
(setq i 1
row 2
pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 15 100))
(vla-put-vertcellmargin TblObj 4)
(vla-SetColumnWidth TblObj 0 50)
(mapcar '(lambda (x)(vla-SetTextStyle TblObj x (getvar "TEXTSTYLE")))
	(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
(list acTitleRow acHeaderRow acDataRow))
(vla-setText TblObj 0 0 "list of drawings") 
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Ten ban Ve")
(vla-setText TblObj 1 2 "Ky hieu")
(foreach pt lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (cadr pt))
(vla-setText TblObj row 2 (car pt))
(setq row (1+ row) i (1+ i))
)
(vlax-release-object TblObj)
(princ lst) ) ) )
(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
))

Đúng là nó tự dưng "chết" thiệt. :s_big: Chẳng hiểu nguyên nhân. Chỉ có anh gia_bach mới giải thích được cái này :rolleyes:

Cám ơn Tue_NV đã giúp , tuy nhiên lại xuâ1t hiện lỗi mới :

- Lisp đã thể hiện được font Unicode

- Tuy nhiên đối với Tên bản vẽ được đánh xuống dòng thì Lisp chỉ thống kê được phần dòng trên . VD:

+ Tên bản vẽ là : Mặt bằng bố trí chiếu sáng --> tầng trệt

+ Kết quả : Tên bản vẽ : Mặt bằng bố trí chiếu sáng

+ Phần : tầng trệt đã bị cắt mất .

Mong bác Tue_NV lại ra tay giúp đỡ . Thanks bác . Nhờ bác nên tui hiểu được lệnh : getvar "TEXTSTYLE" . Hii , thanks u


<<

Filename: 95776_draw_name.lsp
Tác giả: Tue_NV
Bài viết gốc: 111976
Tên lệnh: tdd
Viết lisp theo yêu cầu [phần 2]
Thể theo yêu cầu của bác (đẻ trứng hộ bạn hdt4151) em đã hoàn thành lisp như sau. Bác test thử và cho ý kiến.

;; free lisp from...
>>
Thể theo yêu cầu của bác (đẻ trứng hộ bạn hdt4151) em đã hoàn thành lisp như sau. Bác test thử và cho ý kiến.

;; free lisp from cadviet.com
(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa sn)))
(while (setq ss (ssget))
(if ss (setq lss (append lss (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq sn (1+ sn))) " hoac an Enter de ket thuc"))
)
(taobo)
)

(defun taobo ()
(setq k 0)
(while ((setq ss (nth k lss))
(setq i 0)
(while ((setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while ((setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while ((setq reg (ssname ss i))
(setq ptam (centroid reg))
(setq list_tam (append (list ptam) list_tam))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while ((setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(progn 
(setq delname boname loaichu i)
)
)
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl) list_plmoi (append (list list_pl) list_plmoi) list_tam 
                 (vl-remove (nth loaichu (reverse list_tam)) list_tam))
)
(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
list_tam nil
)
(ndt)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq h 0)
(while ((setq list_pl (nth h list_plmoi))
(setq p 0)
(while ((setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq h (1+ h))
)
(setq dlst (reverse dlst))
(setq list_tam (reverse list_tam))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(setq i 0 ik 1)
(while ((setq chutam (nth i list_tam))
(command "text" "j" "m" chutam "" "" (rtos ik 2 0))
(setq i (1+ i) ik (1+ ik))
)
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

(defun inittdd ()
(setq 
    tdd_old_er *error*
    *error* tdderror
 )
)

(defun tdderror (errmsg)
(loitdd)
)
(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

(defun centroid (re / op ptam)
(vl-load-com)
(setq ob (vlax-ename->vla-object re)  
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
) 
)

Hề hề. Sao bạn lại lầm lẫn giữa lời góp ýyêu cầu vậy nhở?? :cheers: .

Tue_NV vô tình mang cái tội là "kích thích cho việc đẻ trứng rồi" :cheers: Thiện tai, thiện tai

1- Đã test. Kết quả chưa đạt. Vẫn chưa xoá được Boundary ngoài cùng thể hiện ở chổ : Khi chọn nhóm đối tượng có 2 số thứ tự ghi cùng trong 1 đa giác

2- Số thứ tự sắp xếp chưa đúng. Nên sắp xếp số thứ tự tăng dần trong cùng 1 nhóm

Kết quả test trên 1 số nhóm thửa

 

@Bác TRUNGNGAMY : Cảm ơn bác rất nhiều. Thuật toán rất hay :cheers:


<<

Filename: 111976_tdd.lsp
Tác giả: vcdichoi
Bài viết gốc: 448530
Tên lệnh: lh
Xin được nhờ sửa giúp lỗi Lisp Cad để hợp hình lại

Em có sưu tầm được một Lisp cad dùng để hợp các hình lại với nhau:

Sử dụng như Video:

Nhưng khi em load lisp vào và sử dụng thì thấy báo lỗi, Em có tham khảo thì thấy bảo là do trùng biến gì đó trong...

>>

Em có sưu tầm được một Lisp cad dùng để hợp các hình lại với nhau:

Sử dụng như Video:

Nhưng khi em load lisp vào và sử dụng thì thấy báo lỗi, Em có tham khảo thì thấy bảo là do trùng biến gì đó trong quá trình lập trình, và biến đó được ghi vào bộ nhớ Ram (em cũng không hiểu cho lắm, hỳ).

Báo lỗi như hình dưới

 

Nhờ các anh/chị giúp em chỉnh sửa để Lisp có thể sử dụng được

;;-----------------------=={ Outline Objects  }==-----------------------;;
;;                                                                      ;;
;;  This program enables the user to generate one or more closed        ;;
;;  polylines or regions outlining all objects in a selection.          ;;
;;                                                                      ;;
;;  Following a valid selection, the program calculates the overall     ;;
;;  rectangular extents of all selected objects and constructs a        ;;
;;  temporary rectangular polyline offset outside of such extents.      ;;
;;                                                                      ;;
;;  Using a point located within the offset margin between the extents  ;;
;;  of the selection and temporary rectangular frame, the program then  ;;
;;  leverages the standard AutoCAD BOUNDARY command to construct        ;;
;;  polylines and/or regions surrounding all 'islands' within the       ;;
;;  temporary bounding frame.                                           ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2014-11-30                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-01-23                                      ;;
;;                                                                      ;;
;;  - Added option to erase original objects.                           ;;
;;----------------------------------------------------------------------;;

(defun c:LH ( / *error* idx sel )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (if (setq sel (ssget))
        (progn
            (LM:startundo (LM:acdoc))
            (LM:outline sel)
            (initget "Yes No")
            (if (/= "No" (getkword "\nErase original objects?  <Yes>: "))
                (repeat  (setq idx (sslength sel))
                    (entdel (ssname sel (setq idx (1- idx))))
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Outline Objects  -  Lee Mac
;; Attempts to generate a polyline outlining the selected objects.
;; sel -  Selection Set to outline
;; Returns:  A selection set of all objects created

(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp )
    (if (setq box (LM:ssboundingbox sel))
        (progn
            (setq app (vlax-get-acad-object)
                  dis (/ (apply 'distance box) 20.0)
                  lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
                  are (apply '* (apply 'mapcar (cons '- (reverse lst))))
                  dis (* dis 1.5)
                  ent
                (entmakex
                    (append
                       '(   (000 . "LWPOLYLINE")
                            (100 . "AcDbEntity")
                            (100 . "AcDbPolyline")
                            (090 . 4)
                            (070 . 1)
                        )
                        (mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
                           '(   (caar   cadar)
                                (caadr  cadar)
                                (caadr cadadr)
                                (caar  cadadr)
                            )
                        )
                    )
                )
            )
            (apply 'vlax-invoke
                (vl-list* app 'zoomwindow
                    (mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))
                )
            )
            (setq cmd (getvar 'cmdecho)
                  enl (entlast)
                  rtn (ssadd)
            )
            (while (setq tmp (entnext enl)) (setq enl tmp))
            (setvar 'cmdecho 0)
            (command
                "_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
                (trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""
            )
            (while (< 0 (getvar 'cmdactive)) (command ""))
            (entdel ent)
            (while (setq enl (entnext enl))
                (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
                         (equal (vla-get-area obj) are 1e-4)
                    )
                    (entdel enl)
                    (ssadd  enl rtn)
                )
            )
            (vla-zoomprevious app)
            (setvar 'cmdecho cmd)
            rtn
        )
    )
)

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s -  Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

lllll.png

Lisp Lay hop cac hinh_LH.lsp


<<

Filename: 448530_lh.lsp
Tác giả: minhphuong_humg
Bài viết gốc: 185959
Tên lệnh: vec
Làm sao để thay thế (đối tượng bằng wipeout) ?

Faster. Bạn muốn thao tác với vùng chọn thì bỏ chũ "x" trong các dòng ssget đi. Muốn sửa gì thì minhg ghi chú trong lisp đó.

Lisp có sử...

>>

Faster. Bạn muốn thao tác với vùng chọn thì bỏ chũ "x" trong các dòng ssget đi. Muốn sửa gì thì minhg ghi chú trong lisp đó.

Lisp có sử dụng phần tạo wipeout của bác Thái Bụi cho nhanh

(defun c:vec(/ lst num lay ss ss1 e1 dxf10 max_dist cen dxf14 wpObject doc)
(setq num 100  ;So canh Pline gia lap duong tron
 lay "STT"  ;Layer Text, Line, Circle)
)
(cond ( (setq ss (ssget "x" (list (cons 0  "CIRCLE") (cons 8 lay))))  
 (setq  doc (vla-get-ActiveDocument (vlax-get-acad-object))
ss1 (vla-get-ActiveSelectionSet doc)
e1 (entget (ssname ss 0)) i 0 d (cdr(assoc 40 e1)) pt (cdr (assoc 10 e1))
 )
 (vla-startundomark doc)
 ;Tao WipeOut
 (if (not (member "acwipeout.arx" (arx))) (arxload "acwipeout.arx"))
 (setq i 0)
 (while (< i num)
  (setq lst (cons (polar pt (/ (* pi 2 (setq i (1+ i))) num) d) lst))
 )
 (setq dxf10 (list (apply'min (mapcar 'car lst)) (apply'min(mapcar'cadr lst)) (if(caddar lst)(caddar lst)0))
max_dist(float (apply'max (mapcar'- (apply'mapcar(cons'max lst)) dxf10)))
cen (mapcar'+ dxf10 (list(/ max_dist 2)(/ max_dist 2) 0.0))
dxf14 (mapcar '(lambda(p)(mapcar '/ (mapcar'- p cen)(list max_dist (- max_dist) 1.0)))lst)
dxf14  (reverse (cons(car dxf14)(reverse dxf14)))
wpObject
(vlax-ename->vla-object
 	(entmakex (append (list
  	'(0 . "WIPEOUT")'(100 . "AcDbEntity")
  	(cons 8 lay)  
  	'(100 . "AcDbWipeout")'(90 . 0)
  	(cons 10 (trans dxf10 (list 0 0 1) 0))
  	(cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0))
  	(cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0))
  	'(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2)
  	(cons 91 (length dxf14)))
  	(mapcar'(lambda(p)(cons 14 p))dxf14)
  	)
 	)
)
 )
 (vlax-map-collection ss1 '(lambda(x)(vla-move (vla-copy wpObject) (vlax-3d-point pt)(vlax-3d-point (vlax-get  x 'Center)))(vla-erase x)))
 (cond  ( (setq  ss (ssget "x" (list (cons 0  "LINE,*TEXT") (cons 8 Lay))))
(setq ss1 (vla-get-ActiveSelectionSet doc))
(vlax-map-collection ss1 '(lambda(x)(vla-copy x)(vla-erase x)))
)
 )
 (vlax-release-object ss1)
 (vla-regen doc acActiveViewport )
 (vla-endundomark doc)
)
))

Cảm ơn bác ketxu rất nhiều, cảm ơn mọi người đã quan tâm và giúp đỡ. Chúc mọi người có sức khỏe dồi dào.Trân trọng cảm ơn!


<<

Filename: 185959_vec.lsp
Tác giả: tinhyeu_forever2
Bài viết gốc: 432479
Tên lệnh: block scale uniformly toggle
Copy xong paste block ra được đối tượng có thuộc tính Scale uniformly

Mình vừa tìm được trang web nói về vấn đề này rồi này :)

http://forums.augi.com/showthread.php?134247-2012-Scale-Uniformly

Có lisp để "bật - tắt" chế độ Scale Uniformly nữa. Các cao thủ xem thử xem có gì hot không :D

>>

Mình vừa tìm được trang web nói về vấn đề này rồi này :)

http://forums.augi.com/showthread.php?134247-2012-Scale-Uniformly

Có lisp để "bật - tắt" chế độ Scale Uniformly nữa. Các cao thủ xem thử xem có gì hot không :D

(Defun C:Block_Scale_Uniformly_Toggle (/ MS)
(vl-load-com)
(setq MS (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(if (= (vla-get-blockscaling ms) acuniform)
(vla-put-blockscaling ms acAny)
(vla-put-blockscaling ms acUniform)
);if
(princ (strcat "\nWhen this drawing is inserted as a block it will Scale: " (if (= (vla-get-blockscaling ms) acuniform) "UNIFORMLY" "UN-UNIFORMLY")))
(princ)
);defun

 


<<

Filename: 432479_block_scale_uniformly_toggle.lsp
Tác giả: thanhduan2407
Bài viết gốc: 121501
Tên lệnh: invis vis
Lisp hide & show object
Hề hề hề,

Không phải bạn uống nhầm thuốc mà là bạn download về nhầm lisp. Cái lisp này nếu mình không nhớ nhầm thì bị lỗi và đã được sửa lại ở...

>>
Hề hề hề,

Không phải bạn uống nhầm thuốc mà là bạn download về nhầm lisp. Cái lisp này nếu mình không nhớ nhầm thì bị lỗi và đã được sửa lại ở đâu đó trên diễn đàn từ khá lâu rồi. Song do chủ thớt bận chưa cập nhật lại chỗ hỏng nên các bạn tới sau cứ thế mà down về nên dính chấu thôi.

Cái này là mình mới đọc lại cái lisp lỗi và sửa lại để các bạn xài thử coi. Nếu thấy được thì cứ thế xài, khỏi phải làm phiền bác chủ thớt nữa hỉ. Còn không được thì chờ bác chủ thớt xuống dao vậy.

;======================Bemove====================================
; Hide & Show

(defun c:InVis (/ SSet Count Elem)

(defun Dxf (Id Obj)
(cdr (assoc Id (entget Obj)))
);end Dxf

(prompt "\nSelect object(s) to hide: ")
(cond
      ( (setq SSet (ssget)) 
        (repeat (setq Count (sslength SSet))
                    (setq Count (1- COunt)
                             Elem (ssname SSet Count)
                    )
                    (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
                         (if (Dxf 60 Elem)
                             (entmod (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem)))
                             (entmod (append (entget Elem) (list '(60 . 1))))
                          )
                          (prompt "\nEntity on a locked layer. Cannot hide this entity. ")
                      );;;end if
          );;;end repeat
       )
);end cond
(princ)
);end c:InVis
(defun c:Vis (/ WhatNextSSet Count Elem)

(defun Dxf (Id Obj)
(cdr (assoc Id (entget Obj)))
);end Dxf

(cond
     ( (setq SSet (ssget "_X" '((60 . 1))))
        (initget "Yes No")
        (setq WhatNext (getkword "\nAll hidden entities will be visible. Continue? No, : ")) 
        ;;;;;;;(T "Yes")
      ) 
)
(cond
    ( (= WhatNext "Yes")
      (prompt "\nPlease wait...")
      (repeat (setq Count (sslength SSet))
                 (setq Count (1- COunt)
                         Elem (ssname SSet Count)
                 )
                 (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
                     (entmod (subst '(60 . 0) '(60 . 1) (entget Elem)))
                     (prompt "\nEntity on a locked layer. Cannot make visible this entity. ")
                 );end if
       );end repeat
       (prompt "\nDone...")
    )
);end cond
)
;;;;;;;(T (prompt "\nNo objects was hidden. "))

 

Nhớ copy cái này thành tên khác chứ đừng copy đè lên cái cũ. Sau đó các bạn hãy tự đọc lại và so sánh với cái lisp cũ để thấy cái chỗ mình sửa và hiểu được vì sao nó trật.

Hy vọng các bạn hài lòng.

 

PS: lưu ý các bạn là khi lisp hỏi: All hidden entities will be visible. Continue? No, :

Các bạn phải trả lời là Yes chứ không được lười nhấn mà nhập yes hay y hay Y chăng nữa. Vì như vậy lisp sẽ chẳng cho kết quả đúng đâu. Hề hề hề,

Cái này là tôn trọng bác chủ thớt đã có công làm ra nó, mình chỉ chỉnh chỗ chưa đạt chứ không thay đổi ý đồ của bác ấy. Mong các bạn hiểu giùm.

Bác thanhbinh à. Nhìn con số bài mà bác tham gia thật đáng kính. Em nhìn phần bác viết mà thèm quá, chỉ mong sau này được như bác, thích lập trình theo ý mình muốn. Hic. Chắcc bác phải dày công nghiên cứu lắm mới được như ngày hôm nay bác nhở. Tại em không có thời gian nhiều nên chỉ tranh thủ xem lúc rảnh rỗi để học Lisp. Ngày trước em học pascal, sau đó là VB và sau đó nữa là nghiên cứu vài cái ngôn ngữ khác.... đến khi bắt đầu tập tành cái Lisp em thấy mê nó quá. Nó chui sâu vào Cad và điều khiển theo ý mình. Hic. Em sẵn có dòng máu thích lập trình bác ạ, không giỏi nhưng em có niềm đam mê. Rất mong bác và các anh chị trong diễn đàn giúp đỡ. Em mạn phép được xin nickname của bác để mắc lỗi chỗ nào trong quá trình nghiên cứu Lisp em muốn hỏi bác. Nickname của em là: thanhduan2407. Đợi tin của bác


<<

Filename: 121501_invis_vis.lsp
Tác giả: hoavien248
Bài viết gốc: 186703
Tên lệnh: test
Lisp dim các block không thẳng hàng!

Ví dụ 2, sử dụng Angbase + duyệt Block gần nhau. Với cái này bạn có thể chọn hết Block loại BT 06 và thử sẽ thaaysDim chạy vòng ntn

>>

Ví dụ 2, sử dụng Angbase + duyệt Block gần nhau. Với cái này bạn có thể chọn hết Block loại BT 06 và thử sẽ thaaysDim chạy vòng ntn

(defun c:test (/ ss estart dump i ang dis pt mspace p1 p2 tmp)
(grtext -1 "Free lisp from CadViet @Ketxu")
(defun ST:Ent-Dxf (dxfCode Ent)(if (= (type Ent) 'ENAME)(cdr (assoc dxfCode (entget Ent))) nil))
(defun ST:Ss->ListBasePoint (ss / n l)
;31-7-2011 @Ketxu
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (ST:Ent-Dxf 10 e) l))
 )
)
(defun ST:List-Sort-ByDistance (lst start / lstRT 1st item lstDis tmp)
;31-7-2011 @Ketxu
(setq 1st (nth start lst) lstRT (list 1st) lst (append lstRT (vl-remove 1st lst)))
(while (> (length lst) 1)
(setq lst (vl-remove (setq item (nth (1+ (vl-position (setq mindis (apply 'min (setq lstDis (cdr (mapcar '(lambda(x) (distance 1st x)) lst))))) lstDis)) lst)) lst))
(setq lstRT (cons item lstRt))
(setq 1st (car lstRT))
)
(reverse lstRT)
)
(defun CV:Geom-Midpoint (p1 p2 )(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2))
(setvar "nomutt" 1)(prompt "Ch\U+1ECDn c\U+00E1c Block mu\U+1ED1n k\U+1EBB Pline :")
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 "BT 06")))
   	dump (setvar "nomutt" 0)
   	estart (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EA7u :"))
   	)
(setq lstPnt (ST:List-Sort-ByDistance
   	(setq tmp (ST:Ss->ListBasePoint ss))
   	(vl-position (ST:Ent-Dxf 10 estart) tmp)
))
(setq p1 (car lstPnt) p2 (cadr lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))
(setq pt (getpoint mid "\nPoint to Put text :" ) ang (angle mid pt) dis (distance mid pt) i 0)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 3d vlax-3d-point)
(repeat (1- (length lstPnt))
(setq p1 (nth i lstPnt) p2 (nth (setq i (1+ i)) lstPnt) mid (CV:Geom-Midpoint p1 p2))
(setvar "ANGBASE" (angle p1 p2))(setq p (polar mid ang dis))
(vla-AddDimAligned mspace (3d p1)(3d p2) (3d p))
)
(setvar "ANGBASE" 0)
)

Mình upload lại file có đường dẫn rùi bác,lisp của bác ra 1 phát rùi đó,nhưng mà đường dim nó không về 1 phía bác ah!thanks bác

cái thứ 1 làm tửng đoạn nhỏ bác ah thì ok


<<

Filename: 186703_test.lsp
Tác giả: hoavien248
Bài viết gốc: 186702
Tên lệnh: ha
Lisp dim các block không thẳng hàng!

Thử cái này xem. Có gì y/c sẽ sửa lại. Code nhanh nên thông cảm.

;Doan Van Ha - CADViet.com - Ngay...
>>

Thử cái này xem. Có gì y/c sẽ sửa lại. Code nhanh nên thông cảm.

;Doan Van Ha - CADViet.com - Ngay 20/12/2011
;Muc dich: Dim lien tuc tung cap Block.
(defun C:HA( / ss1 p1 name ss entlst i)
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(while (not (progn (princ "\rChon Block dau hoac cuoi cua day cac Block de lam Block mau...") (setq ss1 (ssget ":s" '((0 . "INSERT")))))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq name (cdr (assoc 2 (entget (ssname ss1 0)))))
(princ "\nChon cac Block nam tren day...")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2  name))))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq entlst (vl-sort entlst '(lambda (e1 e2) (< (distance p1 (cdr (assoc 10 (entget e1)))) (distance p1 (cdr (assoc 10 (entget e2))))))))
(setq i 0)
(repeat (- (length entlst) 1)
 (command "dim" "ali" (cdr (assoc 10 (entget (nth i entlst))))
                                     	(cdr (assoc 10 (entget (nth (1+ i) entlst))))
                                     	(polar (cdr (assoc 10 (entget (nth i entlst))))
                                            		(+ (/ pi 2) (angle (cdr (assoc 10 (entget (nth i entlst))))
                                                                          		(cdr (assoc 10 (entget (nth (1+ i) entlst))))))
                                            		10) "" "e")
 (setq i (+ 1 i)))
(KET_THUC)
(princ))
(defun BAT_DAU()
(vl-load-com)
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

Mình upload lại file có đường dẫn rùi bác,lisp bác tạm ok vì chọn đối tượng lần 1 ko được,phải chọn 2 lần!thanks bác


<<

Filename: 186702_ha.lsp
Tác giả: hugo007
Bài viết gốc: 162331
Tên lệnh: moc
Lisp vẽ đai móc

Để scale mà không thay đổi các thứ, mình bắt buộc đóng block. Nếu bạn muốn nó to ngay từ đầu thì hãy dùng lệnh Ctrl C , Ctrl V cho nhanh...

>>

Để scale mà không thay đổi các thứ, mình bắt buộc đóng block. Nếu bạn muốn nó to ngay từ đầu thì hãy dùng lệnh Ctrl C , Ctrl V cho nhanh :)

(defun c:moc ()
(if (not (tblsearch "layer" "daimoc"))
 (command "-LAYER" "m" "daimoc" "c" 1 "daimoc" "" )
 (setvar "clayer" "daimoc" )
)
(setq ss
(ssadd
 (entmakex '(
(0 . "LWPOLYLINE") 
(100 . "AcDbEntity") 
(67 . 0) 
(8 . "0") 
(100 . "AcDbPolyline") 
(90 . 5)
(70 . 0) 
(43 . 0.0) 
(38 . 0.0)
(39 . 0.0) 
(10 24.64817964888254 -91.74677730714256) 
(40 . 0.0) 
(41 . 0.0) 
(42 . 0.0)
(10 0.064704761275634 0.0)
(40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 201.3678792892649 0.0) 
(40 . 0.0) (41 . 0.0) 
(42 . -0.955352130863200) 
(10 200.0000000000000 -29.93750000000000) 
(40 . 0.0) (41 . 0.0) (42 . 0.0) 
(10 170.0000000000000 -29.93750000000000) 
(40 . 0.0) (41 . 0.0) (42 . 0.0))
)
(ssadd)
)
ss 
(ssadd
  (entmakex '(
(0 . "DIMENSION") (100 . "AcDbEntity")
(67 . 0) (8 . "0") (100 . "AcDbDimension")
(10 0.060370364143068 0.016176190318916 0.0) 
(11 36.41853992802232 -27.89527883998339 0.0)
(12 0.0 0.0 0.0) (70 . 34) (1 . "") (71 . 5) (72 . 1)
(41 . 1.0) (42 . 1.308996938995746) (73 . 0) (74 . 0)
(75 . 0) (52 . 0.0) (53 . 0.0) (54 . 0.0) (51 . 0.0)
(3 . "Standard") (100 . "AcDb2LineAngularDimension")
(13 0.0 0.0 0.0) (14 200.0000000000000 0.0 0.0) 
(15 24.64817964888254 -91.74677730714256 0.0) 
(16 29.51916549524492 -35.10245939763303 0.0)
(40 . 0.0) (50 . 0.0))
)
  ss)
  blkName "#caiblocknaytenphaidai"
 )
 (if (not (tblsearch "block" blkName))
(progn (command "-block" blkName '(0 0 0) (eval ss) ""))
)
(while (setq pt (getpoint "\n\U+0110i\U+1EC3m ch\U+00E8n :"))
(command "-insert" blkName "s" 5 pt "")  
 (princ)
)
(command ".erase" ss "")
) 

Bạn kiểm tra lại giùm nó vẫn chưa gán cho đai móc này thành layer daimoc và vẫn chưa cho nhập điểm chền.Mặc dù trong lisp bạn đã có 2 mục này.Mình muốn tất cả đai này lớn hơn 5 lần để thể hiện nó đang ở tỉ lệ 1/20 không cần phải block đâu bạn,thí dụ đường xiên trong lisp dài 95 giờ mình muốn nó dài 475.....Nếu làm vậy khó thì bạn xem lại giùm mình gán layer cho nó và điểm chèn là được,có gì mình dùng lệnh scale nó lên sau.Cảm ơn sự nhiệt tình của bạn rất nhiều.


<<

Filename: 162331_moc.lsp
Tác giả: ngokiet
Bài viết gốc: 448302
Tên lệnh: test
Nhờ viết lisp
(defun c:test ( / point et)
  (setq point (getpoint "\nPick diem trong vung kin"))
  (while point
    (if (setq et (bpoly point))
      (progn
        (entmake
            (append
               '((000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1))
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))))
	(entdel et)))
    (setq point...
>>
(defun c:test ( / point et)
  (setq point (getpoint "\nPick diem trong vung kin"))
  (while point
    (if (setq et (bpoly point))
      (progn
        (entmake
            (append
               '((000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1))
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))))
	(entdel et)))
    (setq point (getpoint "\n Chon diem tiep theo: ")))
  (princ))
(vl-load-com) 
;; Bounding Box  -  Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj -  VLA-Object

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)
(princ)

Mình nghĩ nên làm thế này dễ hơn là sài Entlast và command vì lisp có lệnh bpoly.

Còn lệnh command boundary thì đôi khi nó có nhiều hơn 1 vùng kín phía trong nên có thể tạo ra nhiều hơn 1 pl. Và lệnh bpoly nó trả về được pl nó tạo ra luôn. Đồng thời thông báo nếu ko kín luôn.

 


<<

Filename: 448302_test.lsp
Tác giả: ngokiet
Bài viết gốc: 448638
Tên lệnh: dl
Sửa lại lệnh DIM cho tiện dụng hơn

Nếu bạn sài cad đời cao thì bạn gán biến dimlayer là dim thì dim nó sẽ tạo ở layer dim.

còn bạn muốn viết lisp thì phải kết thúc lệnh command thì mới setvar clayer lại được.

ví dụ:

(defun c:dl(/ ll)
  (setq ll (getvar 'clayer))
  (setvar 'clayer "dim")
  (command "_dimlinear")
  (while (/= (getvar 'cmdactive) 0) (command pause))
 ...
>>

Nếu bạn sài cad đời cao thì bạn gán biến dimlayer là dim thì dim nó sẽ tạo ở layer dim.

còn bạn muốn viết lisp thì phải kết thúc lệnh command thì mới setvar clayer lại được.

ví dụ:

(defun c:dl(/ ll)
  (setq ll (getvar 'clayer))
  (setvar 'clayer "dim")
  (command "_dimlinear")
  (while (/= (getvar 'cmdactive) 0) (command pause))
  (setvar 'clayer ll))

 


<<

Filename: 448638_dl.lsp
Tác giả: newness
Bài viết gốc: 55108
Tên lệnh: w1 w2
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.

 

Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại...

>>
Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.

 

Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại phải SCALE rồi làng nhằng LAYER không đúng với bản vẽ của mình ! Vậy thì co cách nào không nhỉ?

 

Bài 5: Vẽ cửa đi

 

;-------------------------------------------------------------------------------------
;ve cua di 1 canh
;-------------------------------------------------------------------------------------
(defun c:c1 (/ p1 p2 p3 p4 p5 daicua x y)
(setq osm (getvar "osmode"))  
(setq	p1     (getpoint "\nHay vao diem goc cua: ")

p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (distance p1 p2)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn
     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")
   )
   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
(setvar "osmode" osm)       
)
;-------------------------------------------------------------------------------------
;ve cua di 2 canh
;-------------------------------------------------------------------------------------
(defun c:c2 (/ p1 p2 p3 p4 p5 daicua x y)
 (setq osm (getvar "osmode"))  
 (setq	p1     (getpoint "\nHay vao diem goc cua: ")
p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 2.0)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua 
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn
     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" p2 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

   )

   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
 (setvar "osmode" osm)       
)
;-------------------------------------------------------------------------------------
;ve cua di 4 canh
;-------------------------------------------------------------------------------------
(defun c:c4 (/ p1 p2 p3 p4 p5 daicua x y)
 (setq osm (getvar "osmode"))    
 (setq	p1     (getpoint "\nHay vao diem goc cua: ")
p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 4.0)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua 
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn

     (setq diem1 (diemgiua p1 (diemgiua p1 p2)))
     (setq diem2 (diemgiua p1 p2))
     (setq diem3 (diemgiua p2 (diemgiua p1 p2)))      

     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" diem1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)     
     (command ".UCS" "P")      

     (command ".UCS" "3" p2 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" diem3 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

   )

   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
(setvar "osmode" osm)         
)
;-----------------------------------------------------------------------------

 

Có 3 lệnh trong lisp này.

c1: vẽ cửa đi 1 cánh

c2: vẽ cửa đi 2 cánh

c4: vẽ cửa đi 4 cánh

 

Thế còn cửa sổ thì sao nhỉ ?

 

Bài 6: Vẽ cửa sổ

 

(defun c:w1(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))
       (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
       (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt2 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
       (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt3 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")
   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
 	(ai_undo_push)
   (wd_procced)
 	(ai_undo_pop)	
)
(defun c:w2(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

	(if (< (nth 0 p1) (nth 0 ls2)) (progn
       	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
    )(progn
	   	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
	))


       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

	(setq getom (getvar "osmode"))
       (setvar "osmode" 0)

	(setq ll1 (list
            (cons 0 "line")
            (cons 8 (getvar "clayer"))
        ))
	(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
	;(princ ls2)

	(if (> (nth 1 p1) (nth 1 ls2)) (progn

       	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

       	(drawrt3 p7 p8 ll1)

		(setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)
	)(progn
	  	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

		(drawrt3 p7 p8 ll1)


		(setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)


	))

	(setvar "osmode" getom)

       (command "erase" data_m "")
   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
   (wd_procced)
)

 

Có 2 lệnh trong lisp này.

w1: vẽ cửa sổ kiểu 1

w2: vẽ cửa sổ kiểu 2

 

mình không thể sài nổi cái này


<<

Filename: 55108_w1_w2.lsp
Tác giả: a12k39duchao
Bài viết gốc: 415056
Tên lệnh: qb
Sửa Lisp

Hiện nay em đang sử dụng Autocad 2018.
Không hiểu tại sao khi em load lisp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=1160
(defun c:QB (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
(defun TxtWidth (val h...
>>

Hiện nay em đang sử dụng Autocad 2018.
Không hiểu tại sao khi em load lisp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=1160
(defun c:QB (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
(defun TxtWidth (val h msp / txt minp maxp)
  (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
  (foreach itm (vlax-for itm objTblStyDic
		 (setq tabLst (append tabLst (list itm))))
    (if (not
	  (vl-catch-all-error-p
	    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name)))  )  )
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
	TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
	      (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )
  
(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method
      (setq Utility
        (cond
	  (Utility)
          ((vla-get-Utility *adoc))))
      'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))  
;main
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (vl-load-com)
      (setq i -1 len0 8)
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
	(if (> (setq blk_len (strlen blk_name)) len0)
	  (setq str blk_name len0 blk_len) )	
	(if (not (assoc blk_name lst_blk))
	  (setq lst_blk (cons (cons blk_name 1) lst_blk))
	  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
			       (assoc blk_name lst_blk) lst_blk)))	    )
      (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
      (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
      (initget "Yes No")
      (setq ins (getkword "\nChen ki hieu Block  <yes> : ") )
      (or ins (setq ins "Yes"))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)      
      (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
      (initget 6)
      (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))      
      (if h (setq *h* h) (setq h *h*) )
      (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	    msp (vla-get-modelspace *adoc)
	    blks (vla-get-blocks *adoc))      
      (setq width1 (* 2 (TxtWidth "STT" h msp))
	    width (* 2 (TxtWidth "So luong" h msp))
	    height (* 2 h))
      (if str
	(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
	(setq width2 width))
      (if (> h 3)
	(setq width (* (fix (/ width 10))10)
	      width1 (* (fix (/ width1 10))10)
	      width2 (* (fix (/ width2 10))10)
	      height (* (fix (/ height 5))5)))
      (GetOrCreateTableStyle "CadViet")
      (setq pt (getpoint "\nDiem dat Bang :")
	    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
      (vla-put-regeneratetablesuppressed TblObj :vlax-true)
      (vla-SetColumnWidth TblObj 0 width1)
      (vla-SetColumnWidth TblObj 1 width2)
      (vla-put-vertcellmargin TblObj (* 0.75 h))
      (vla-put-horzcellmargin TblObj (* 0.75 h))
      (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
	      (list acTitleRow acHeaderRow acDataRow) )
      (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
	      (list acTitleRow acHeaderRow acDataRow))      
      (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
      (vla-setText TblObj 0 0 "Bang thong ke")
      (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) 
      (repeat (length header_lsp)
	(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
      (setq row 2 i 1)    
      (foreach pt lst_blk
	(setq blk_name (car pt) j -1)
	(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
		(list i blk_name "cai" (cdr pt)))
	(if (= ins "Yes")
	  (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true))
	(vla-SetCellAlignment TblObj row 1 7)
	(vla-SetCellAlignment TblObj row 3 9)
	(setq row (1+ row) i (1+ i))	)
      (vla-put-regeneratetablesuppressed TblObj :vlax-false)
      (vlax-release-object TblObj) )  )
  (princ))

</yes>

thì báo lỗi 

Select objects:  ; error: no function definition: VLAX-ENAME->VLA-OBJECT 

một số lisp em được nhờ viết dùm thì báo lỗi

error: no function definition: vlax-curve-getEndParam

Nhờ mọi người sửa chữa dùm.


<<

Filename: 415056_qb.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 235054
Tên lệnh: sn%2B sn-
How to use Visual LISP Editor

 

Em là người mới bắt đầu học LISP, món này rất cần thiết đây!

 

@ Bác Thaistreetz ơi, Bác là...

>>

 

Em là người mới bắt đầu học LISP, món này rất cần thiết đây!

 

@ Bác Thaistreetz ơi, Bác là một trong các cao thủ trong ngành này, bác chia sẽ những kinh nghiệm của mình để hướng dẫn tụi em với, tựa đề bằng tiếng Anh thế mọi người cũng hiểu được mà, như Slogen của Bác đấy thôi, cũng toàn tiếng Anh cả đấy chứ!

 

Trong bài:  Lisp vẽ hình chữ nhật , line: http://www.cadviet.com/forum/topic/71167-yeu-cau-lisp-ve-hinh-chu-nhat/

Đã có các bác: Duy782006; Tue_NV và bác Doan Van Ha viết giúp bạn ấy rồi, em thấy vấn đề không phải khó lắm, cũng viết một lisp, nhưng không chạy được, vì còn sai nhiều chỗ, các Bác chắc đọc code sẽ phát hiện nhiều chỗ sai của em. Tuy nhiên, em mong muốn các Bác có thể hướng dẫn cách sử dụng các công cụ của Visual LISP Editor để phát hiện lỗi và sửa lỗi, từ đó những người mới học như tụi em sẽ rút ra những bài học kinh nghiệm!

 

Em xin trình bày lại yêu cầu của bạn ấy: Nhập vào 2 điểm và một khoảng offset, vẽ hình chữ nhật nhận 2 đỉnh ấy làm 2 đỉnh chéo, kết quả là HCN được offset từ HCN chuẩn ra hay vào trong một khoảng bằng khoảng nhập vào. Code của em đây:

(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) x))
(defun SN(id / )
(setq D1 (getpoint "\nVui long pick diem Bottom Left\n")
      D3 (getcorner D1 "\nVui long pick diem Top Right\n"))
(setq an  (getint "\nVui long nhap khoang offset: <110>\n")) (if (= an nil) (setq an 110))
(setq bn (- 0 an))
(setq D2 (list (car D1) (cadr D3))
      D4 (list (car D3) (cadr D1)))
(cond
((= id 1) (setq D11 (pxy D1 bn bn)
                D22 (pxy D2 bn an)
                D33 (pxy D3 an an)
                D44 (pxy D4 an bn))
((= id 2) (setq D11 (pxy D1 an an)
                D22 (pxy D2 an bn)
                D33 (pxy D3 bn bn)
                D44 (pxy D4 bn an)))))
(Command "_pline" D11 D22 D33 D44 "C")
(princ))
(defun C:SN+() (SN 1))
(defun C:SN-() (SN 2))
Chân thành cám ơn các Bác đã quan tâm!

Hề hề hề,

Bạn kiểm tra lại dòng code này:

D44 (pxy D4 bn an)))))

Sao m2 lắm ngoặc rứa???

Dòng code này:

(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) x))

Thế cho thằng y vào để làm chi vậy???


<<

Filename: 235054_sn%2B_sn-.lsp
Tác giả: nguyencanh160890
Bài viết gốc: 224082
Tên lệnh: ha1
XIN HỎI VỀ LỆNH FILLET

Nghĩa là bạn muốn nhập bán kính chỉ 1 lần, rồi lần sau thì không cần nhập bán kính nữa? Vậy thì dùng cái này.

Chú ý:...

>>

Nghĩa là bạn muốn nhập bán kính chỉ 1 lần, rồi lần sau thì không cần nhập bán kính nữa? Vậy thì dùng cái này.

Chú ý: khi cần thay đổi bán kính thì bạn phải load lisp lại nhé.

(setq bk nil)
(defun C:HA1 (/ e1 e2 p2 l e ss)
(setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "undo" "be")
(if (not bk) (setq bk (getreal (strcat "\nNhap ban kinh:"))))
(command "fillet" "R" bk)
(while (null (setq e1 (entsel "\nChon object 1: "))))
(while (null (setq e2 (entsel "\nChon object 2: "))))
(setq p2 (cadr e2))
(setq e2 (car e2))
(if
 (and
  (= (cdr (assoc 0 (entget (car e1)))) "LWPOLYLINE")
  (= (cdr (assoc 0 (entget e2))) "LWPOLYLINE"))
 (progn
  (setq l (entlast))
  (command "explode" e2)
  (setq ss (ssadd))
  (ssadd (setq e (entnext l)) ss)
  (while (setq e (entnext e))
   (ssadd e ss))
  (command "fillet" e1 (nentselp p2))
  (command "pedit" e1 "_J" ss "" "")
  (command "erase" ss ""))
 (command "fillet" e1 (nentselp p2)))
(setvar "cmdecho" cmd) (command "undo" "e") (princ))

 

 

 

HÌ HÌ , câu này Chú ý: khi cần thay đổi bán kính thì bạn phải load lisp lại nhé. Nghĩa là khi em muốn thay đổi bán kính lại load lại lisp, trong bài có 3 cái bán kính, em phải load 3 lần ạ?


<<

Filename: 224082_ha1.lsp

Trang 313/330

313