Viết Lisp theo yêu cầu

Tháng 8 16, 2009

Chào các bác! Em muốn đánh số thứ tự 1A, 2A, 3A ... . Bác nào đã viết lisp mà chỉ cần copy 1A thì tự động
những text sau là 2A, 3A ko a. Nếu có thì có thể post lên được ko ạ. Cảm ơn các bác nhiều.

Chào bạn, ý tưởng của bạn thật là hay, nó sẽ giúp rất nhiều cho công việc của người biên tập bản vẽ trong cad, tránh được nhầm lẫn khi đánh số trang hoặc đánh số thửa. Trước kia mình đã từng in rất nhiều bản vẽ và phải đánh số trang cho từng bản vẽ, công việc này cứ lặp đi lặp lại nhiều lần làm cho mình cứ bị nhầm hoài. Vì vậy mình viết chương trình này nhằm đáp ứng cho người dùng cảm thấy thuận tiện trong công việc hơn và tránh được những nhầm lẫn không đáng có, nhưng nói chung nó chưa được hoàn thiện cho lắm, đối với số thực thì chưa được hỗ trợ và công sai mặc định là 1 và phải là số nguyên vì thế nó chưa thể sử dụng rộng dãi cho nhiều mục đích được, cái thứ hai nữa đối với MTEXT cũng chưa được hỗ trợ, hy vọng cái này giải quyết được phần nào cho công việc của bạn, xài thử và cho ý kiến nhé!.. lần sau mình sẽ bổ sung cho hoàn chỉnh hơn.

(defun c:cps (/ input redraws copyit)
 (defun input (/ sset)
   (setq sset (ssget))
 )
;;;  ---------endsub input--------
 (defun redraws (val idx / n i entn)
   (setq n (sslength val)
  i 0
   )
   (repeat n
     (setq entn (ssname val i))
     (redraw entn idx)
     (setq i (+ i 1))
   )
 )
;;;  -------endsub redraws--------
 (defun copyit	(val / copy_clsic copy_ntyp n)
   (defun copy_clsic (val p /)
     (if (not p)
(setq p (getpoint "Specify base point or displacement:"))
     )
     (if p
(command "copy" val "" "m" p pause)
(redraws val 4)
     )
   )
				;end copy_clsic
   (defun copy_ntyp (val   /	  text_loc    change	  entn	entg
	      dxf   ans	  tt	ok    p	    typ	  ptext	dt
	      at    pn	  pkt	dkt   akt   txt ntxt
	     )
     (defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
  (progn
    (setq jum72 (cdr (assoc 72 entg)))
    (setq jum73 (cdr (assoc 73 entg)))
    (cond
      ((= jum72 1) (setq i 11))
      ((= jum72 2) (setq i 11))
      ((= jum72 4) (setq i 11))
      ((= jum72 3) (setq i 10))
      ((= jum72 5) (setq i 10))
      ((= jum72 0)
       (progn
	 (if (= jum73 0)
	   (setq i 10)
	   (setq i 11)
	 )
       )
      )
    )
    (setq loc (cdr (assoc i entg)))
    (setq p loc)
  )
)
(setq ketqua p)
     )
				;end text_loc
     (defun change (txt tt / ans len n num ott )
(if (= tt "Prefix")
  (progn
    (setq txt (vl-string-left-trim " " txt)
	  ans (vl-string-left-trim "0123456789" txt)
	  len (strlen txt)
	  n(strlen ans)
	  num(- len n)
	  ott(itoa(+ (atoi(substr txt 1 num)) 1))
	  txt(strcat ott ans)
    )
  )
  (progn
    (setq txt (vl-string-right-trim " " txt)
	  ans (vl-string-right-trim "0123456789" txt)
	  len (strlen txt)
	  n(strlen ans)
	  num(- len n)
	  ott(itoa(+ (atoi(substr txt (+ n 1) num)) 1))
	  txt(strcat  ans ott)
    )
  )
)
txt
     )
				;end change 
     (setq entn (ssname val 0)
    entg (entget entn)
     )
     (setq dxf (cdr (assoc 0 entg)))
     (if (= dxf "TEXT")
(progn
  (setq ans (getvar "users1"))
  (if (or (= ans "Prefix") (= ans "Suffix") (= ans "Off"))
    (setq tt ans)
    (setq tt "Prefix")
  )
  (setq ok "YES")
  (while (= ok "YES")
    (initget "Prefix Suffix Off")
    (setq p
	   (getpoint
	     (strcat "\nSpecify base point or [Prefix/Suffix/Off] <"
		     tt
		     ">: "
	     )
	   )
    )
    (if	p
      (progn
	(setq typ (type p))
	(if (= typ 'LIST)
	  (setq ok "NO")
	  (setq tt (setvar "users1" p))
	)
      )
      (setq ok "NO")
    )
  )
  (if p
    (progn
      (if (/= tt "Off")
	(progn
	  (setq
	    ptext (text_loc (ssname val 0))
	    ptext (subst 0 (nth 2 ptext) ptext)
	    dt	  (distance '(0 0 0) ptext)
	    at	  (angle '(0 0 0) ptext)
	    ok	  "YES"
	  )
	  (while (= ok "YES")
	    (command "copy" val "" p)
	    (prompt
	      "\nSpecify second point of displacement or :"
	    )
	    (command pause)
	    (setq pn  (text_loc (entlast))
		  pn  (subst 0 (nth 2 pn) pn)
		  pkt (subst 0 (nth 2 p) p)
		  dkt (distance pkt pn)
		  akt (angle pkt pn)
	    )
	    (if
	      (and (equal dt dkt 0.0001) (equal at akt 0.0001))
	       (progn
		 (entdel (entlast))
		 (setq ok "NO")
	       )
	       (progn
		 (setq entg (entget (entlast))
		       txt  (cdr (assoc 1 entg))
		       )
		 (if (not ntxt) (setq ntxt txt))
		 (setq
		       ntxt  (change ntxt tt)
		       entg (subst (cons 1 ntxt) (assoc 1 entg) entg)
		 )
		 (entmod entg)
	       )
	    )
	  )
	)
	(copy_clsic val p)
      )
    )
    (redraws val 4)
  )
)
     )
   )
;;;    -------mainsub copyit-------
   (if	val
     (progn
(setq n (sslength val))
(if (> n 1)
  (copy_clsic val '())
  (copy_ntyp val)
)
     )
   )

 )
;;;  ---------MAIN----------------
 (setq val (ssget))
 (redraws val 3)
 (copyit val)
)

Tháng 8 16, 2009

Các bạn có lisp chuyển text của font TCVN3(ABC) về font VNI Windows cho tớ xin nha. Chứ chuyển thủ công đuối quá.

đây là chương trình chuyển mã phục vụ cho công việc riêng của mình, nên có 1 số phần bạn sẽ không dùng tới, nhưng ko sao nó cũng không ảnh hưởng tới công việc của bạn đâu. Chương trình này mình chưa TEST nên có thể chưa thể chuyển mã được 100%, nếu khi sử dụng bạn thấy mã nào chưa chuyển được thì bạn gửi bản vẽ đó cho mình nhé để mình cập nhật mã nhé.

(defun c:chm (/ makefile st duyet chuyenma option inget ok ma-ltr name)
 (defun makefile (/ path fn fs find f)
   (setq path (getvar "dwgprefix"))
   (setq fn (getvar "dwgname"))
   (setq fs (strcat path (substr fn 1 (- (strlen fn) 6)) ".dwg"))
   (setq find (findfile fs))
   (if	(not find)
     (progn
(setq fo (findfile "MAU.dwg"))
(if fo
  (vl-file-copy fo fs)
)
     )
   )
 )
;;;-----------------end sub----------------------
 (defun st (stn font)
   (command "style" stn font 0 1 0 "N" "N" " ")
 )
 (defun duyet (nentg / bv ok ext ok la txt)
   (setq bv (getvar "dwgname"))
   (setq ok "YES")
   (setq ext (STRCASE (substr bv (- (strlen bv) 5) 2)))
   (if	(in ext "CS,DC,DH,GT,RG,TH" ",")
     (setq ok "NO")
   )
   (if	(= ok "NO")
     (progn
(setq la (cdr (assoc 8 nentg)))
(if (not (in la "15,13,53,8,30,37,18,22,38,44,24,27" ","))
  (setq ok "YES")
)
(if (in la "8,53,24" ",")
  (progn
    (setq txt (cdr (assoc 1 nentg)))
    (if	(distof txt)
      (setq ok "NO")
      (progn
	(if (in	txt
		"110KV,110 KV,220V,220 V,22KV,22 KV,15KV,15 KV"
		","
	    )
	  (setq ok "NO")
	  (setq ok "YES")
	)
      )
    )
  )
)
     )
   )
   ok
 )
;;;-----------------end sub----------------------

 (defun chlst5	(lst / len i newmss ok aaj ix aas ees aj aar of	aax ef
	 awf er	mss)
   (setq len (length lst))
   (setq i	 0
  newmss '()
  ok	 "YES"
  aaj	 '(37 37 50 48 51)
  ix	 '(37 37 50 50 48)
  aas	 '(37 37 50 48 50)
  ees	 '(37 37 50 49 51)
  aj	 '(37 37 49 56 53)
  aar	 '(37 37 50 48 48)
  of	 '(37 37 50 50 51)
  aax	 '(37 37 50 48 49)
  ef	 '(37 37 50 48 52)
  awf	 '(37 37 49 56 55)
  er	 '(92 85 43 50 53 54 67)
  ux	 '(92 85 43 50 48 49 55)
  aaf	 '(37 37 49 57 57)
  ow	 '(37 37 49 55 50)
  oos	 '(37 37 50 51 50)
  ax	 '(37 37 49 56 51)
  uw	 '(37 37 49 55 51)
  af	 '(37 37 49 56 49)
  ij	 '(37 37 50 50 50)
  uwr	 '(37 37 50 52 54)
  es	 '(37 37 50 48 56)
  dd	 '(37 37 49 55 52)
  ddd	 '(37 37 49 54 55)
  ooj	 '(37 37 50 51 51)
  aa	 '(37 37 49 54 57)
  uwj	 '(37 37 50 52 57)
  orr	 '(37 37 50 50 53)
  ee	 '(37 37 49 55 48)
  oo	 '(37 37 49 55 49)
  awj	 '(37 37 49 57 56)
  as	 '(37 37 49 56 52)
  oor	 '(37 37 50 51 48)
  iff	 '(37 37 50 49 53)
  uf	 '(37 37 50 51 57)
  owf	 '(37 37 50 51 52)
  owj	 '(37 37 50 51 56)
  oof	 '(37 37 50 50 57)
  ar	 '(37 37 49 56 50)
  ows	 '(37 37 50 51 55)
  aw	 '(37 37 49 54 56)
  oj	 '(37 37 50 50 56)
  eej	 '(37 37 50 49 52)
  eer	 '(37 37 50 49 49)
  uws	 '(37 37 50 52 56)
  os	 '(37 37 50 50 55)
  is	 '(37 37 50 50 49)
  aws	 '(37 37 49 57 48)
  ir	 '(37 37 50 49 54)
  uj	 '(37 37 50 52 52)
  uwf	 '(37 37 50 52 53)
  owr	 '(37 37 50 51 53)
  oox	 '(37 37 50 51 49)
  ur	 '(37 37 50 52 49)
  eef	 '(37 37 50 49 48)
  yr	 '(37 37 50 53 49)
  us	 '(37 37 50 52 51)
  ex	 '(37 37 50 48 55)
  oo-S	 '(37 37 49 54 52)
  yx	 '(37 37 50 53 50)
   )
   (while (= ok "YES")
     (setq mss	(list (nth i lst)
	      (nth (+ i 1) lst)
	      (nth (+ i 2) lst)
	      (nth (+ i 3) lst)
	      (nth (+ i 4) lst)
	)
     )
     (cond
((equal mss aaj)
 (progn
   (setq mss '(97 228)
	 ok  "NO"
   )
 )
)
((equal mss ix)
 (progn
   (setq mss '(243)
	 ok  "NO"
   )
 )
)
((equal mss aas)
 (progn
   (setq mss '(97 225)
	 ok  "NO"
   )
 )
)
((equal mss ees)
 (progn
   (setq mss '(101 225)
	 ok  "NO"
   )
 )
)
((equal mss aj)
 (progn
   (setq mss '(97 239)
	 ok  "NO"
   )
 )
)
((equal mss aar)
 (progn
   (setq mss '(97 229)
	 ok  "NO"
   )
 )
)
((equal mss of)
 (progn
   (setq mss '(111 248)
	 ok  "NO"
   )
 )
)
((equal mss aax)
 (progn
   (setq mss '(97 227)
	 ok  "NO"
   )
 )
)
((equal mss ef)
 (progn
   (setq mss '(101 248)
	 ok  "NO"
   )
 )
)
((equal mss awf)
 (progn
   (setq mss '(97 232)
	 ok  "NO"
   )
 )
)
((equal mss er)
 (progn
   (setq mss '(101 251)
	 ok  "NO"
   )
 )
)
((equal mss ux)
 (progn
   (setq mss '(117 245)
	 ok  "NO"
   )
 )
)
((equal mss aaf)
 (progn
   (setq mss '(97 224)
	 ok  "NO"
   )
 )
)
((equal mss ow)
 (progn
   (setq mss '(244)
	 ok  "NO"
   )
 )
)
((equal mss oos)
 (progn
   (setq mss '(111 225)
	 ok  "NO"
   )
 )
)
((equal mss ax)
 (progn
   (setq mss '(97 245)
	 ok  "NO"
   )
 )
)
((equal mss uw)
 (progn
   (setq mss '(246)
	 ok  "NO"
   )
 )
)
((equal mss af)
 (progn
   (setq mss '(97 248)
	 ok  "NO"
   )
 )
)
((equal mss ij)
 (progn
   (setq mss '(242)
	 ok  "NO"
   )
 )
)
((equal mss uwr)
 (progn
   (setq mss '(246 251)
	 ok  "NO"
   )
 )
)
((equal mss es)
 (progn
   (setq mss '(101 249)
	 ok  "NO"
   )
 )
)
((equal mss dd)
 (progn
   (setq mss '(241)
	 ok  "NO"
   )
 )
)
((equal mss ddd)
 (progn
   (setq mss '(209)
	 ok  "NO"
   )
 )
)
((equal mss ooj)
 (progn
   (setq mss '(111 228)
	 ok  "NO"
   )
 )
)
((equal mss aa)
 (progn
   (setq mss '(97 226)
	 ok  "NO"
   )
 )
)
((equal mss uwj)
 (progn
   (setq mss '(246 239)
	 ok  "NO"
   )
 )
)
((equal mss orr)
 (progn
   (setq mss '(111 251)
	 ok  "NO"
   )
 )
)
((equal mss ee)
 (progn
   (setq mss '(101 226)
	 ok  "NO"
   )
 )
)
((equal mss oo)
 (progn
   (setq mss '(111 226)
	 ok  "NO"
   )
 )
)
((equal mss awj)
 (progn
   (setq mss '(97 235)
	 ok  "NO"
   )
 )
)
((equal mss as)
 (progn
   (setq mss '(97 249)
	 ok  "NO"
   )
 )
)
((equal mss oor)
 (progn
   (setq mss '(111 229)
	 ok  "NO"
   )
 )
)
((equal mss iff)
 (progn
   (setq mss '(236)
	 ok  "NO"
   )
 )
)
((equal mss uf)
 (progn
   (setq mss '(117 248)
	 ok  "NO"
   )
 )
)
((equal mss owf)
 (progn
   (setq mss '(244 248)
	 ok  "NO"
   )
 )
)
((equal mss owj)
 (progn
   (setq mss '(244 239)
	 ok  "NO"
   )
 )
)
((equal mss oof)
 (progn
   (setq mss '(111 224)
	 ok  "NO"
   )
 )
)
((equal mss ar)
 (progn
   (setq mss '(97 251)
	 ok  "NO"
   )
 )
)
((equal mss ows)
 (progn
   (setq mss '(244 249)
	 ok  "NO"
   )
 )
)
((equal mss aw)
 (progn
   (setq mss '(97 234)
	 ok  "NO"
   )
 )
)
((equal mss oj)
 (progn
   (setq mss '(111 239)
	 ok  "NO"
   )
 )
)
((equal mss eej)
 (progn
   (setq mss '(101 228)
	 ok  "NO"
   )
 )
)
((equal mss eer)
 (progn
   (setq mss '(101 229)
	 ok  "NO"
   )
 )
)
((equal mss uws)
 (progn
   (setq mss '(246 249)
	 ok  "NO"
   )
 )
)
((equal mss os)
 (progn
   (setq mss '(111 249)
	 ok  "NO"
   )
 )
)
((equal mss is)
 (progn
   (setq mss '(237)
	 ok  "NO"
   )
 )
)
((equal mss aws)
 (progn
   (setq mss '(97 233)
	 ok  "NO"
   )
 )
)
((equal mss ir)
 (progn
   (setq mss '(230)
	 ok  "NO"
   )
 )
)
((equal mss uj)
 (progn
   (setq mss '(117 239)
	 ok  "NO"
   )
 )
)
((equal mss uwf)
 (progn
   (setq mss '(246 248)
	 ok  "NO"
   )
 )
)
((equal mss owr)
 (progn
   (setq mss '(244 251)
	 ok  "NO"
   )
 )
)
((equal mss oox)
 (progn
   (setq mss '(111 227)
	 ok  "NO"
   )
 )
)
((equal mss ur)
 (progn
   (setq mss '(117 251)
	 ok  "NO"
   )
 )
)
((equal mss eef)
 (progn
   (setq mss '(101 224)
	 ok  "NO"
   )
 )
)
((equal mss yr)
 (progn
   (setq mss '(121 251)
	 ok  "NO"
   )
 )
)
((equal mss us)
 (progn
   (setq mss '(117 249)
	 ok  "NO"
   )
 )
)
((equal mss ex)
 (progn
   (setq mss '(101 245)
	 ok  "NO"
   )
 )
)
((equal mss oo-S)
 (progn
   (setq mss '(79 194)
	 ok  "NO"
   )
 )
)
((equal mss yx)
 (progn
   (setq mss '(121 245)
	 ok  "NO"
   )
 )
)
     )
     (if (= ok "YES")
(setq mss (list (nth i lst)))
     )
     (setq newmss (append newmss mss))
     (if (= ok "NO")
(progn
  (setq i (+ i 5))
  (setq len (- len i))
  (repeat len
    (setq newmss (append newmss (list (nth i lst))))
    (setq i (+ i 1))
  )
  (setq	lst    newmss
	i      -1
	len    (length lst)
	ok     "YES"
	newmss '()
  )
)
     )
     (setq i (+ i 1))
     (if (= i len)
(setq ok "NO")
     )
   )
   newmss
 )
;;;-----------------end sub----------------------
 (defun chlst (lst / len i newmss ok aaj ix aas ees aj	aar of aax ef
	awf er mss)
   (setq len (length lst))
   (setq i	 0
  newmss '()
  ok	 "YES"
  aaj	 '(92 85 43 50 53 54 54)
  ix	 '(92 85 43 50 53 56 52)
  aas	 '(92 85 43 50 53 54 57)
  ees	 '(92 85 43 48 49 51 49)
  aj	 '(92 85 43 50 53 54 51)
  aar	 '(92 85 43 50 53 53 65)
  of	 '(92 85 43 50 53 56 48)
  aax	 '(92 85 43 50 53 53 52)
  ef	 '(92 85 43 50 53 54 48)
  awf	 '(92 85 43 50 53 53 55)
  er	 '(92 85 43 50 53 54 67)
  ux	 '(92 85 43 50 48 49 55)
   )
   (while (= ok "YES")
     (setq mss	(list (nth i lst)
	      (nth (+ i 1) lst)
	      (nth (+ i 2) lst)
	      (nth (+ i 3) lst)
	      (nth (+ i 4) lst)
	      (nth (+ i 5) lst)
	      (nth (+ i 6) lst)
	)
     )
     (cond
((equal mss aaj)
 (progn
   (setq mss '(97 228)
	 ok  "NO"
   )
 )
)
((equal mss ix)
 (progn
   (setq mss '(243)
	 ok  "NO"
   )
 )
)
((equal mss aas)
 (progn
   (setq mss '(97 225)
	 ok  "NO"
   )
 )
)
((equal mss ees)
 (progn
   (setq mss '(101 225)
	 ok  "NO"
   )
 )
)
((equal mss aj)
 (progn
   (setq mss '(97 239)
	 ok  "NO"
   )
 )
)
((equal mss aar)
 (progn
   (setq mss '(97 229)
	 ok  "NO"
   )
 )
)
((equal mss of)
 (progn
   (setq mss '(111 248)
	 ok  "NO"
   )
 )
)
((equal mss aax)
 (progn
   (setq mss '(97 227)
	 ok  "NO"
   )
 )
)
((equal mss ef)
 (progn
   (setq mss '(101 248)
	 ok  "NO"
   )
 )
)
((equal mss awf)
 (progn
   (setq mss '(97 232)
	 ok  "NO"
   )
 )
)
((equal mss er)
 (progn
   (setq mss '(101 251)
	 ok  "NO"
   )
 )
)
((equal mss ux)
 (progn
   (setq mss '(117 245)
	 ok  "NO"
   )
 )
)
     )
     (if (= ok "YES")
(setq mss (list (nth i lst)))
     )
     (setq newmss (append newmss mss))
     (if (= ok "NO")
(progn
  (setq i (+ i 7))
  (setq len (- len i))
  (repeat len
    (setq newmss (append newmss (list (nth i lst))))
    (setq i (+ i 1))
  )
  (setq	lst    newmss
	i      -1
	len    (length lst)
	ok     "YES"
	newmss '()
  )
)
     )
     (setq i (+ i 1))
     (if (= i len)
(setq ok "NO")
     )
   )
   newmss
 )
;;;-----------------end sub----------------------
 (defun chuyenma (sset	  /	 len	i      entn   entg   txt
	   lst	  lstlen j	newlst num    typ    newtxt
	   nentg  ans
	  )
   (progn
     (setq len (sslength sset))
     (setq i 0)
     (repeat len
(setq entn (ssname sset i))
(setq entg (entget entn))
(setq txt (cdr (assoc 1 entg)))
(setq lst (vl-string->list txt))
(setq lstlen (length lst))
(setq j	0
      newlst '()
)
(repeat	lstlen
  (setq num (nth j lst))
  (cond
    ((= num 161) (setq num '(246)))
    ((= num 175) (setq num '(244 239)))
    ((= num 171) (setq num '(241)))
    ((= num 184) (setq num '(246 245)))
    ((= num 193) (setq num '(97 248)))
    ((= num 213) (setq num '(111 224)))
    ((= num 172) (setq num '(101 226)))
    ((= num 227) (setq num '(97 235)))
    ((= num 189) (setq num '(111 226)))
    ((= num 204) (setq num '(242)))
    ((= num 223) (setq num '(111 251)))
    ((= num 222) (setq num '(111 225)))
    ((= num 247) (setq num '(246 251)))
    ((= num 195) (setq num '(97 224)))
    ((= num 240) (setq num '(101 249)))
    ((= num 218) (setq num '(111 228)))
    ((= num 174) (setq num '(97 226)))
    ((= num 168) (setq num '(246 239)))
    ((= num 169) (setq num '(97 249)))
    ((= num 206) (setq num '(236)))
    ((= num 180) (setq num '(117 248)))
    ((= num 219) (setq num '(244 248)))
    ((= num 194) (setq num '(97 251)))
    ((= num 221) (setq num '(244 249)))
    ((= num 191) (setq num '(97 234)))
    ((= num 205) (setq num '(101 228)))
    ((= num 203) (setq num '(101 229)))
    ((= num 176) (setq num '(246 249)))
    ((= num 181) (setq num '(111 229)))
    ((= num 206) (setq num '(236)))
    ((= num 210) (setq num '(111 249)))
    ((= num 245) (setq num '(111 239)))
    ((= num 166) (setq num '(237)))
    ((= num 186) (setq num '(209)))
    ((= num 165) (setq num '(97 233)))
    ((= num 207) (setq num '(230)))
    ((= num 192) (setq num '(97 245)))
    ((= num 182) (setq num '(117 239)))
    ((= num 167) (setq num '(246 248)))
    ((= num 217) (setq num '(244 251)))
    ((= num 188) (setq num '(244)))
    ((= num 254) (setq num '(111 227)))
    ((= num 185) (setq num '(121 251)))
    ((= num 190) (setq num '(117 249)))
    ((= num 164) (setq num '(101 245)))
    ((= num 185) (setq num '(230)))
    ((= num 177) (setq num '(117 251)))
    ((= num 178) (setq num '(121 249)))
    ((= num 241) (setq num '(79 194)))
    ((= num 179) (setq num '(121 245)))
    ((= num 202) (setq num '(101 224)))
    ((= num 200) (setq num '(101 227)))
    ((= num 209) (setq num '(212)))
    ((= num 237) (setq num '(65 202)))
    ((= num 243) (setq num '(65 197)))
  )
  (setq typ (type num))
  (if (= typ 'LIST)
    (setq newlst (append newlst num))
    (setq newlst (append newlst (list num)))
  )
  (setq j (+ j 1))
)
(setq i (+ i 1))
(setq newlst (chlst newlst))
(setq newtxt (vl-list->string (chlst5 newlst)))
(setq nentg (subst (cons 1 newtxt) (assoc 1 entg) entg))
(setq nentg (subst (cons 7 "vni") (assoc 7 nentg) nentg))
(setq ans (duyet nentg))
(if (= ans "YES")
  (entmod nentg)
)

     )

   )
;;;    (command "zoom" "e" "")
 )
;;;-----------------end sub----------------------
 (defun option	( / option_id ok_cancel usi1)
   (setq usi1(getvar "useri1"))
   (setq option_id (load_dialog "acadfun.dcl"))
   (new_dialog "chuyen_ma_lytr" option_id)
   (if (= usi1 0)
     (set_tile "chmachu" "1")
     (set_tile "chlytrinh" "1")
     )
   (action_tile "chmachu" "(setq usi1 0)")
   (action_tile "chlytrinh" "(setq usi1 1)")
   (setq ok_cancel (start_dialog))
   (if (= ok_cancel 1)
     (setvar "useri1" usi1)
     )
 )
;;;-----------------end sub---------------------- 
 (defun chuyenlytrinh (sset / i newtxt len entn entg txt txtlst lentxt j )
   (setq len(sslength sset))
   (setq i 0)
   (repeat len
     (setq newtxt "")
     (setq entn(ssname sset i))
     (setq entg(entget entn))
     (setq txt(cdr(assoc 1 entg)))
     (setq txtlst(str2lst txt "/"))
     (setq lentxt(length txtlst)
    j 0)
     (repeat lentxt
(setq newtxt(strcat newtxt (nth j txtlst)))
(setq j(+ j 1))
)
     (setq entg(subst (cons 1 newtxt) (assoc 1 entg) entg))
     (entmod entg) 
     (setq i(+ i 1))
     )
   )
;;;----------------MAIN--------------------
;;;  (makefile)
 (st "vni" "VNI-Times")
 (setq inget "Option")
 (setq ok "YES")
 (while (= ok "YES")
   (setq ma-ltr (getvar "useri1"))
   (if	(= ma-ltr 0)
     (setq name "\nChon vao text can chuyen ma or [Option]:  ")
     (setq
name "\nChon vao text can chuyen ma or [Option]:  "
     )
   )
   (setq sset (getss name
	      inget
	      '((0 . "TEXT"))
       )
   )
   (if	sset
     (if (= sset inget)
(option)
(progn
  (if (= ma-ltr 0)
    (chuyenma sset)
    (chuyenlytrinh sset)
  )
)
     )
     (setq ok "NO")
   )
 )
)

chuyen_ma_lytr : dialog{
label = "Convertion";
:radio_button {
	label = "Chuyen ma chu";
	key = chmachu;}
:radio_button {
	label = "Chuyen Ly Trinh";
	key = chlytrinh;}
ok_cancel;
}

bạn hãy lưu đoạn mã này với tên file ACADFUN.DCL và chép vào chung với thư mục chứa file chm.lsp nhé, nhớ phải đánh đường dẫn trong option của cad thì nó mới chạy êm ái được.

Tháng 8 16, 2009

Chào bạn t031285

file của bạn hoàn toàn không thể đọc được.

Xin lỗi mình xài 2007 đã chuyển xuống 2003,gửi lại bạn mong giúp đỡ.Thanks

http://www.cadviet.com/upfiles/2/dim100_2.rar

Tháng 8 16, 2009

Chào bạn, ý tưởng của bạn thật là hay, nó sẽ giúp rất nhiều cho công việc của người biên tập bản vẽ trong cad, tránh được nhầm lẫn khi đánh số trang hoặc đánh số thửa. Trước kia mình đã từng in rất nhiều bản vẽ và phải đánh số trang cho từng bản vẽ, công việc này cứ lặp đi lặp lại nhiều lần làm cho mình cứ bị nhầm hoài. Vì vậy mình viết chương trình này nhằm đáp ứng cho người dùng cảm thấy thuận tiện trong công việc hơn và tránh được những nhầm lẫn không đáng có, nhưng nói chung nó chưa được hoàn thiện cho lắm, đối với số thực thì chưa được hỗ trợ và công sai mặc định là 1 và phải là số nguyên vì thế nó chưa thể sử dụng rộng dãi cho nhiều mục đích được, cái thứ hai nữa đối với MTEXT cũng chưa được hỗ trợ, hy vọng cái này giải quyết được phần nào cho công việc của bạn, xài thử và cho ý kiến nhé!.. lần sau mình sẽ bổ sung cho hoàn chỉnh hơn.

Cảm ơn bác nhưng em đã load lisp này về và gõ lệnh cps thì cad nó báo unknown cammand. Bác check lại giúp em nhé!

Tháng 8 16, 2009

Chào em svba. Sinh nhật vui vẻ nhé.
Điiều em nói trên thì chưa cần sử dụng tới Lisp. Lệnh này sẽ giúp em: DIMOVERRIDE

Vâng, em cảm ơn anh Tue_NV nhiều! Cad còn có lệnh này à. Hay quá! Thế mà giờ em mới biết.

(2) : Hàng này xác định tên biến sẽ thay đổi kích thước. ở đây mình xác định biến DimLfac sẽ thay đổi
(4) : Xác định tiếp tên biến sẽ thay đổi. Cón không xác định nữa thì ấn Enter. Ở đây ta ấn Enter

Anh cho em hỏi, ngoài biến Dimlfac ra, lệnh này còn biến gì nữa không. Em đã xem trong Help, nhưng chẳng thấy có gì.

Một lần nữa cảm ơn anh!

Tháng 8 16, 2009

Cảm ơn bác nhưng em đã load lisp này về và gõ lệnh cps thì cad nó báo unknown cammand. Bác check lại giúp em nhé!

mình đã test rồi, ok mà. Bây giờ bạn thử lại lần nữa xem sao, chứ tại vì nếu máy báo unknown cammand tức là bạn chưa load được đấy hoặc là khi load no báo lỗi nên nó không thể thực hiện được lệnh vừa rồi. Chúc bạn thành công nha

:bigsmile:

(defun c:cps (/ input redraws copyit)

(defun input (/ sset)

(setq sset (ssget))

)

;;; ---------endsub input--------

(defun redraws (val idx / n i entn)

(setq n (sslength val)

i 0

)

(repeat n

(setq entn (ssname val i))

(redraw entn idx)

(setq i (+ i 1))

)

;;; -------endsub redraws--------

(defun copyit (val / copy_clsic copy_ntyp n)

(defun copy_clsic (val p /)

(if (not p)

(setq p (getpoint "Specify base point or displacement:"))

)

(if p

(command "copy" val "" "m" p pause)

(redraws val 4)

)

;end copy_clsic

(defun copy_ntyp (val / text_loc change entn entg

dxf ans tt ok p typ ptext dt

at pn pkt dkt akt txt ntxt

)

(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)

(setq p '())

(setq entg (entget entn))

(setq text (cdr (assoc 0 entg)))

(if (= text "TEXT")

(progn

(setq jum72 (cdr (assoc 72 entg)))

(setq jum73 (cdr (assoc 73 entg)))

(cond

((= jum72 1) (setq i 11))

((= jum72 2) (setq i 11))

((= jum72 4) (setq i 11))

((= jum72 3) (setq i 10))

((= jum72 5) (setq i 10))

((= jum72 0)

(progn

(if (= jum73 0)

(setq i 10)

(setq i 11)

)

(setq loc (cdr (assoc i entg)))

(setq p loc)

)

(setq ketqua p)

)

;end text_loc

(defun change (txt tt / ans len n num ott )

(if (= tt "Prefix")

(progn

(setq txt (vl-string-left-trim " " txt)

ans (vl-string-left-trim "0123456789" txt)

len (strlen txt)

n(strlen ans)

num(- len n)

ott(itoa(+ (atoi(substr txt 1 num)) 1))

txt(strcat ott ans)

)

(progn

(setq txt (vl-string-right-trim " " txt)

ans (vl-string-right-trim "0123456789" txt)

len (strlen txt)

n(strlen ans)

num(- len n)

ott(itoa(+ (atoi(substr txt (+ n 1) num)) 1))

txt(strcat ans ott)

)

txt

)

;end change

(setq entn (ssname val 0)

entg (entget entn)

)

(setq dxf (cdr (assoc 0 entg)))

(if (= dxf "TEXT")

(progn

(setq ans (getvar "users1"))

(if (or (= ans "Prefix") (= ans "Suffix") (= ans "Off"))

(setq tt ans)

(setq tt "Prefix")

)

(setq ok "YES")

(while (= ok "YES")

(initget "Prefix Suffix Off")

(setq p

(getpoint

(strcat "\nSpecify base point or [Prefix/Suffix/Off] <"

tt

">: "

)

(if p

(progn

(setq typ (type p))

(if (= typ 'LIST)

(setq ok "NO")

(setq tt (setvar "users1" p))

)

(setq ok "NO")

)

(if p

(progn

(if (/= tt "Off")

(progn

(setq

ptext (text_loc (ssname val 0))

ptext (subst 0 (nth 2 ptext) ptext)

dt (distance '(0 0 0) ptext)

at (angle '(0 0 0) ptext)

ok "YES"

)

(while (= ok "YES")

(command "copy" val "" p)

(prompt

"\nSpecify second point of displacement or :"

)

(command pause)

(setq pn (text_loc (entlast))

pn (subst 0 (nth 2 pn) pn)

pkt (subst 0 (nth 2 p) p)

dkt (distance pkt pn)

akt (angle pkt pn)

)

(if

(and (equal dt dkt 0.0001) (equal at akt 0.0001))

(progn

(entdel (entlast))

(setq ok "NO")

)

(progn

(setq entg (entget (entlast))

txt (cdr (assoc 1 entg))

)

(if (not ntxt) (setq ntxt txt))

(setq

ntxt (change ntxt tt)

entg (subst (cons 1 ntxt) (assoc 1 entg) entg)

)

(entmod entg)

)

(copy_clsic val p)

)

(redraws val 4)

)

;;; -------mainsub copyit-------

(if val

(progn

(setq n (sslength val))

(if (> n 1)

(copy_clsic val '())

(copy_ntyp val)

)

;;; ---------MAIN----------------

(setq val (ssget))

(redraws val 3)

(copyit val)

)

Tháng 8 17, 2009

trong lĩnh vực thiết kế xây dựng của bạn thì mình không rành về chuyên môn lắm, nên bạn có thể gửi bản vẽ có wall trong đó đc không, tại vì mình không biết wall mà bạn vẽ thuộc đối tượng nào: LINE hay LWPOLYLINE, vẽ nét đôi hay nét đơn ... và tim trục nằm ở đâu. Nếu được mình sẽ cố gắng giúp bạn

vẽ line thôi bạn, trục bạn có thể đặt ở giữa. lúc vẽ thì nó tự động OFFSET sang 2 bên, khi vẽ 2 đường đó chéo nhau thì nó sẽ cắt nhau.

Tháng 8 17, 2009

Vâng, em cảm ơn anh Tue_NV nhiều! Cad còn có lệnh này à. Hay quá! Thế mà giờ em mới biết.
Anh cho em hỏi, ngoài biến Dimlfac ra, lệnh này còn biến gì nữa không. Em đã xem trong Help, nhưng chẳng thấy có gì.

Một lần nữa cảm ơn anh!

Em có thể xem bằng cách ấn phím F1

-> Command Reference -> System Variables

Có đủ cả

Ngoài ra, để xem tên biến -> gõ setvar ngay tại dòng Command

Command: SETVAR

Enter variable name or [?]: ? : gõ ? enter

Enter variable(s) to list : enter

ACADVER "16.0s (LMS Tech)" (read only)

ACISOUTVER 70

AFLAGS 0

ANGBASE 0

........

Press ENTER to continue:

Ấn Enter để xem tiếp nhá -> Các biến về DIMENSION.

Còn ý nghĩa các biến thì svba chịu khó tìm hiểu -> Nhiều quá

Lệnh DIMOVERRIDE có thể xác định nhiều biến về DIM cho em thay đổi đấy

:bigsmile:

Chào bạn t031285.

Bạn có thể upload luôn file CAD chứa tên Dim1-100 được không?

Tháng 8 17, 2009

Chào bạn t031285.

Bạn có thể upload luôn file CAD chứa tên Dim1-100 được không?

File đó nè bạn.Thanks

http://www.cadviet.com/upfiles/2/dim100.dwg

Tháng 8 17, 2009

bác NH oi!!!

em cài lệnh sd vào thì được,đánh lệnh nó hiểu nhưng tới đoạn này thì nó báo lỗi thế này,chẳng biết làm thế nào hết.

Bác giúp em với!! cảm ơn bác nhiều!!!

Command: sd

Chon duong dim goc: Unknown command "SD". Press F1 for help.

bad point argument

Tháng 8 18, 2009

Cảm ơn bạn,mình muốn khi đánh dim100 nó sẽ tự tạo tất cả các thông số của dim100 khi đó chỉ việc sử dụng thôi.Bạn có thể viết giùm mình được không.Thanks

Bạn sử dụng Code này Tue_NV viết theo ý bạn xem sao :

(defun c:dim100()
(command "style" "style1" "VHELVCN.TTF" "0" "1" "0" "n" "n")
(if (not (tblsearch "DImstyle" "Dim100"))
(progn
(command "dimstyle" "S" "Dim100")
(command "dim" "style" "style1"
"DIMADEC"   0                  
"DIMALT"      0                  
"DIMALTD"     3                    
"DIMALTF"     0.0394             
"DIMALTRND"   0.0000              
"DIMALTTD"    3                    
"DIMALTTZ"    0                   
"DIMALTU"     2                  
"DIMALTZ"     0                                         
"DIMASZ"      1.2000              
"DIMATFIT"    3                    
"DIMAUNIT"    0                    
"DIMAZIN"     0                    
"DIMBLK"      "_Dot"                  
"DIMBLK1"     ""        
"DIMBLK2"     ""                     
"DIMCLRD"     8                    
"DIMCLRE"     8                    
"DIMCLRT"     4 
"DIMDEC"      0                    
"DIMDLE"      0.0000              
"DIMDLI"      7.0000               
"DIMEXE"      2.0000               
"DIMEXO"      2.0000               
"DIMFRAC"     0                   
"DIMGAP"      0.5000               
"DIMJUST"     0                           
"DIMLFAC"     1.0000               
"DIMLIM"      0                 
"DIMLUNIT"    2                   
"DIMLWD"     9                    
"DIMLWE"      9                                             
"DIMRND"      0.0000               
"DIMSAH"      0                  
"DIMSCALE"    100.0000            
"DIMSD1"      0                  
"DIMSD2"      0                  
"DIMSE1"      0                 
"DIMSE2"      0                  
"DIMSOXD"     0                 
"DIMTAD"      1                   
"DIMTIH"      0                  
"DIMTIX"      1                   
"DIMTM"       0.0000               
"DIMTMOVE"    0                    
"DIMTOFL"     1                   
"DIMTOH"      0                  
"DIMTSZ"      0.0000              
"DIMTVP"      0.0000               
"DIMTXSTY"    "style1"              
 "DIMTXT"      2.5000 \e)
(command "dimstyle" "S" "Dim100" "Y")
)
)
(graphscr)
(princ)
)

@ruamap : Dưới đây là lời khuyên và góp ý của Tue_NV cho bạn 790312 và cũng chính là lời khuyên và góp ý cho bạn đấy.

@790312 : Đề nghị bạn đọc từ đầu đến cuối những bài viết liên quan đến Lisp sắp dim của bác Hoành .
Bạn đọc bài mà bỏ dở giữa chừng thì bạn làm không được đó cũng là điều dễ hiểu và chẳng có ai có thể giúp bạn được trong trường hợp này cả

Khi làm việc thì nên làm đến nơi đến chốn đừng bao giờ bỏ dở giữa chừng. Điều đó là không nên.

Vài lời khuyên và góp ý cùng bạn

Chỉnh sửa Tháng 11 5, 2009 theo Tue_NV

Tháng 8 18, 2009

Chào các bác! Em là thành viên mới nhập cuộc, em không biết nhiều về lisp nhưng công việc của em lại cần đến nó rất nhiều. Em đang làm san nền, làm thủ công thì nâu quá. Tìm trên diễn đàn thì có nhiều lisp của nhiều tác giả, em không biết cái nào Pro nhất. Bác nào có lisp san nền Pro nhất cho em xin nhé, em đang rất cần. Mong các Bác giúp em. Thank!

Tháng 8 18, 2009

... mình muốn khi đánh dim100 nó sẽ tự tạo tất cả các thông số của dim100 khi đó chỉ việc sử dụng thôi.
.......

Các bạn viết giùm 1 lisp như sau với:khi ta đánh dim100 thì sẽ hiện ra 1 loại dim giá trị như dim100 trong dimtyle,tương tự
dim20,dim50....

Chào t031285

Các yêu cầu của bạn đã đuợc bạn Tue_NV viết rồi.

Tuy nhiên để tạo mới (copy) 1 DimStyle từ file Cad có sẵn bạn có thể dùng 2 cách sau :

- sử dụng DesignCenter (nhấn Ctr+2), duyệt đến file Cad có DimStyle cần copy, chọn DimStyles -> kéo thả các DimStyle cần copy vào bản vẽ mới.

- sử dụng Express Tools : Xuất và Nhập các kiểu DimStyle.

dòng lệnh DimEx ,DimIm

Menu: Express -> Dimensions -> Dimstyle Export hay Dimstyle Import

Tháng 8 18, 2009

Bạn thử test Code này xem sao. Test cả trường hợp LINE và cả POLYLINE luôn bạn nhé :

TUE ơi!sao LISP vạt góc mình dùng lại bị lỗi nữa rồi!TUE xem file CAD kèm theo giúp mình nhé!mình test lại bị sai nữa!thank bạn nhé!

http://www.cadviet.com/upfiles/2/vat_goc.dwg

Tháng 8 18, 2009

Chào cả nhà, mình muốn nhờ các bạn viết dùng mình lisp như sau : sai khi dùng lệnh DI (để đo khoảng cách) thì lisp sẽ tự động cộng giá trị khoảng cách mình vừa đo, cụ thể hơn là : ví dụ mình DI 10 lần liên tiếp thì sau khi kết thúc lệnh Di thứ 10 thì lisp sẽ cho ta tổng khoảng cách 10 lần mà ta vừa đo - cảm ơn các bạn cadviet :bigsmile:

Tháng 8 18, 2009

TUE ơi!sao LISP vạt góc mình dùng lại bị lỗi nữa rồi!TUE xem file CAD kèm theo giúp mình nhé!mình test lại bị sai nữa!thank bạn nhé!
http://www.cadviet.com/upfiles/2/vat_goc.dwg

Lỗi này do bạn mà ra cả thôi. Sao bạn không nói ngay từ đầu??

Lisp trên không thể đo được kích thước vạt góc của cung arc được chỉ đo là các đoạn thẳng LINE,POLYLINE thôi

Bản thân hoạt động của Lisp là kéo dài đoạn thẳng thứ nhất , kéo dài đoạn thẳng thứ hai -> giao hai đoạn thẳng đó làm tâm vạt góc.

Nay bạn chuyển 1 đoạn thẳng làm cung thì giao của đoạn thẳng thứ nhất với đoạn thẳng nối hai đầu mút của dây cung. Giao hai đoạn thẳng này làm tâm vạt góc thì há chẳng phải là không đúng ý bạn hay sao?

Tue_NV gửi lại file cho bạn xem :

http://www.cadviet.com/upfiles/2/vat_goc_1.dwg

Tháng 8 18, 2009

Lỗi này do bạn mà ra cả thôi. Sao bạn không nói ngay từ đầu??
Lisp trên không thể đo được kích thước vạt góc của cung arc được chỉ đo là các đoạn thẳng LINE,POLYLINE thôi

Bản thân hoạt động của Lisp là kéo dài đoạn thẳng thứ nhất , kéo dài đoạn thẳng thứ hai -> giao hai đoạn thẳng đó làm tâm vạt góc.

Nay bạn chuyển 1 đoạn thẳng làm cung thì giao của đoạn thẳng thứ nhất với đoạn thẳng nối hai đầu mút của dây cung. Giao hai đoạn thẳng này làm tâm vạt góc thì há chẳng phải là không đúng ý bạn hay sao?

xin lỗi TUE nhé!cái này mình mới làm Quy Hoạch 1 khu sinh thái nên mới phát hiện ra!vậy bây giờ mình nâng cấp lên cho arc được ko vậy TUE?cảm ơn ạn nhiều nhen!

Tháng 8 18, 2009

xin lỗi TUE nhé!cái này mình mới làm Quy Hoạch 1 khu sinh thái nên mới phát hiện ra!vậy bây giờ mình nâng cấp lên cho arc được ko vậy TUE?cảm ơn ạn nhiều nhen!

Bạn làm ơn nói rõ một lần nữa đi.

Cơ sở để ghi kích thước theo phương 1, theo phương 2????

Bạn nói rõ nhé.

@NguyenKhoaDung : Bạn xem Lisp này của Tue_NV có thể giúp bạn đấy :

http://www.cadviet.com/forum/index.php?showtopic=12179

Tháng 8 18, 2009

Chào cả nhà, mình muốn nhờ các bạn viết dùng mình lisp như sau : sai khi dùng lệnh DI (để đo khoảng cách) thì lisp sẽ tự động cộng giá trị khoảng cách mình vừa đo, cụ thể hơn là : ví dụ mình DI 10 lần liên tiếp thì sau khi kết thúc lệnh Di thứ 10 thì lisp sẽ cho ta tổng khoảng cách 10 lần mà ta vừa đo - cảm ơn các bạn cadviet :bigsmile:

Hình như bạn cũng biết về lisp mà, bạn dung vòng lặp while cho các lần pick là được

(setq p1 (getpoint) tong_chieu_dai 0)

(while (setq p2 (getpoint "\nDiem tiep theo:" p1))

(setq tong_chieu_dai (+ tong_chieu_dai (distance p1 p2))

p1 p2)

)

Tháng 8 18, 2009

Bạn làm ơn nói rõ một lần nữa đi.
Cơ sở để ghi kích thước theo phương 1, theo phương 2????

Bạn nói rõ nhé.

xin lỗi đã ko nói rõ nhé!làm phiền TUE quá!mình gửi file CAD sau nè!TUE giúp mình nhé!

http://www.cadviet.com/upfiles/2/vatgoc2.dwg

Tháng 8 18, 2009

Bạn sử dụng Code này Tue_NV viết theo ý bạn xem sao :

(defun c:dim100()
(command "style" "style1" "VHELVCN.TTF" "0" "1" "0" "n" "n")
(if (not (tblsearch "DImstyle" "Dim100"))
(progn
(command "dimstyle" "S" "Dim100")
(command "dim" "style" "style1"
"DIMADEC"   0                  
"DIMALT"      0                  
"DIMALTD"     3                    
"DIMALTF"     0.0394             
"DIMALTRND"   0.0000              
"DIMALTTD"    3                    
"DIMALTTZ"    0                   
"DIMALTU"     2                  
"DIMALTZ"     0                                         
"DIMASZ"      1.2000              
"DIMATFIT"    3                    
"DIMAUNIT"    0                    
"DIMAZIN"     0                    
"DIMBLK"      "_Dot"                  
"DIMBLK1"     ""        
"DIMBLK2"     ""                     
"DIMCLRD"     8                    
"DIMCLRE"     8                    
"DIMCLRT"     4 
"DIMDEC"      0                    
"DIMDLE"      0.0000              
"DIMDLI"      7.0000               
"DIMEXE"      2.0000               
"DIMEXO"      2.0000               
"DIMFRAC"     0                   
"DIMGAP"      0.5000               
"DIMJUST"     0                           
"DIMLFAC"     1.0000               
"DIMLIM"      0                 
"DIMLUNIT"    2                   
"DIMLWD"     9                    
"DIMLWE"      9                                             
"DIMRND"      0.0000               
"DIMSAH"      0                  
"DIMSCALE"    100.0000            
"DIMSD1"      0                  
"DIMSD2"      0                  
"DIMSE1"      0                 
"DIMSE2"      0                  
"DIMSOXD"     0                 
"DIMTAD"      1                   
"DIMTIH"      0                  
"DIMTIX"      1                   
"DIMTM"       0.0000               
"DIMTMOVE"    0                    
"DIMTOFL"     1                   
"DIMTOH"      0                  
"DIMTSZ"      0.0000              
"DIMTVP"      0.0000               
"DIMTXSTY"    "style1"              
 "DIMTXT"      2.5000 \e)
(command "dimstyle" "S" "Dim100" "Y")
)
)
(graphscr)
(princ)
)

Cảm ơn bạn rất nhiều,bạn thật là tốt bụng.

Tháng 8 18, 2009

xin lỗi đã ko nói rõ nhé!làm phiền TUE quá!mình gửi file CAD sau nè!TUE giúp mình nhé!
http://www.cadviet.com/upfiles/2/vatgoc2.dwg

Trường hợp của bạn thì tâm của đường tròn có bán kính = 8 chính là tâm vạt góc và tâm này nằm trên phương của đường thẳng. Bạn đã tính đến trường hợp tâm của đường tròn đó không trùng với phương của đường thẳng chưa?

Hay nói cách khác kích thước vạt góc theo phương 1 và theo phương 2 không bằng nhau? Còn của bạn thì bằng nhau.

Hãy nêu ra 1 yêu cầu thật tổng quát

Tháng 8 18, 2009

Trường hợp của bạn thì tâm của đường tròn có bán kính = 8 chính là tâm vạt góc và tâm này nằm trên phương của đường thẳng. Bạn đã tính đến trường hợp tâm của đường tròn đó không trùng với phương của đường thẳng chưa?
Hay nói cách khác kích thước vạt góc theo phương 1 và theo phương 2 không bằng nhau? Còn của bạn thì bằng nhau.

Hãy nêu ra 1 yêu cầu thật tổng quát

Đối với những góc vạt mà giữa ARC và PLINE mình chỉ cần trường hợp là tâm vạt góc và tâm này nằm trên phương của đường thẳng!bạn giúp mình tí nhé!thanks TUE rất nhiều!mình ghép cái trường hợp này vào cung 1 LISP với trường hợp cũ luôn được ko TUE?

Tháng 8 18, 2009

vẽ line thôi bạn, trục bạn có thể đặt ở giữa. lúc vẽ thì nó tự động OFFSET sang 2 bên, khi vẽ 2 đường đó chéo nhau thì nó sẽ cắt nhau.

ok, bạn chạy thử chương trình này rồi cho ý kiến nhé! lệnh là: WALL

note: đọc kỹ hướng dẫn sử dụng trước khi dùng.

(defun c:wall (/ ang_213 entn2lst getreals input undo trim draw next)
 (defun ang_213 (p1 p2 p3 / ang_p12 ang_p13 ang_2-1-3 ketqua)
   (if	(equal (distance p3 p1) 0 0.0001)
     (setq ang_2-1-3 0)
     (progn
(if (equal (distance p3 p2) 0 0.0001)
  (setq ang_2-1-3 0)
  (progn
    (setq ang_p12 (angle p1 p2)
	  ang_p13 (angle p1 p3)
    )
    (if	(< ang_p13 ang_p12)
      (setq ang_2-1-3 (- ang_p12 ang_p13))
      (if (> ang_p13 ang_p12)
	(setq ang_2-1-3 (- (* 2 pi) (- ang_p13 ang_p12)))
	(if (= ang_p13 ang_p12)
	  (setq ang_2-1-3 0)
	)
      )
    )
    (if	(equal ang_2-1-3 (* 2 pi) 0.0001)
      (setq ang_2-1-3 0)
    )
    (setq ketqua ang_2-1-3)
  )
)
     )
   )
 )
				;end ang_213
 (defun entn2lst
	  (entn	      /		 entt	    entg
	   object     lst	 fromLWPolyline
	   fromARC    fromLINE	 ketqua
	  )
   (defun fromLWPolyline
		  (entg	   /	   assoc_10	   i
		   ok	   nth_lst j	   ma	   h
		   len	   p	   bulge   gate	   gate_ans
		   ketqua
		  )
     (setq assoc_10 (assoc 10 entg))
     (setq i 0)
     (setq ok "YES")
     (while (= ok "YES")
(progn
  (setq nth_lst (nth i entg))
  (if (equal nth_lst assoc_10)
    (setq ok "NO")
  )
  (setq i (+ i 1))
)
     )
     (setq j i)
     (setq ma '())
     (setq h (cdr (assoc 38 entg)))
     (setq len (length entg))
     (repeat (/ (- len i) 4)
(progn
  (setq p (append (cdr (nth (- i 1) entg)) (list h)))
  (setq bulge (cdr (nth (+ i 2) entg)))
  (setq ma (append ma (list p) (list bulge)))
  (setq i (+ i 4))
)
     )
     (setq gate     (cdr (assoc 70 entg))
    gate_ans (getgate 1 gate 10)
     )
     (if (= gate_ans 1)
(progn
  (setq p (append (cdr (nth (- j 1) entg)) (list h)))
  (setq bulge 1)
  (setq ma (append ma (list p) (list bulge)))
)
     )
     (setq ketqua ma)
   )
;;;--------------------------
   (defun fromARC (entg / cen r p1 p2 p3 bulge ang_2-1-3 ketqua)
     (setq cen (cdr (assoc 10 entg)))
     (setq r (cdr (assoc 40 entg)))
     (setq p1 (polar cen (cdr (assoc 50 entg)) r))
     (setq p2 (polar cen (cdr (assoc 51 entg)) r))
     (setq p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
     (setq bulge (/ (* (- (distance cen p1) (distance cen p3)) 2)
	     (distance p1 p2)
	  )
     )
     (setq ang_2-1-3 (ang_213 p1 p2 CEN))
     (if (< ang_2-1-3 pi)
(setq bulge (/ (* (+ (distance cen p3) r) 2) (distance p1 p2)))
     )
     (setq ketqua (list p1 bulge p2 0.0))
   )
;;;--------------------------
   (defun fromLINE (entg / p1 p2 ketqua)
     (setq p1 (cdr (assoc 10 entg)))
     (setq p2 (cdr (assoc 11 entg)))
     (setq ketqua (list p1 0.0 p2 0.0))
   )
;;;--------------------------
   (defun fromCIRCLE (entg / cen r ketqua)
     (setq cen	(cdr (assoc 10 entg))
    r	(cdr (assoc 40 entg))
    p1	(polar cen 0 r)
    p2	(polar cen pi r)
     )
     (setq ketqua (list p1 1 p2 1 p1 1))
   )
;;;--------------------------
   (setq entt (type entn))
   (if	(= entt 'ENAME)
     (progn
(setq entg (entget entn))
(setq object (cdr (assoc 0 entg)))
(cond
  ((= object "LWPOLYLINE") (setq lst (fromLWPolyline entg)))
  ((= object "ARC") (setq lst (fromARC entg)))
  ((= object "LINE") (setq lst (fromLINE entg)))
  ((= object "CIRCLE") (setq lst (fromCIRCLE entg)))
)
     )
     (setq lst nil)
   )
   (setq ketqua lst)
 )
				;end entn2lst
 (defun getreals (real text init / old_real realt name ketqua)
   (if	(not real)
     (setq real 0)
   )
   (setq old_real real)
   (setq realt (rtos real 2))
   (initget init)
   (setq name (strcat text "<" realt "> :"))
   (setq real (getdist name))
   (if	(not real)
     (setq real old_real)
   )
   (setq ketqua real)
 )
				;end getreals
 (defun input (/ j w ok p)
   (setq j (getvar "users1")
  w (getvar "userr3")
   )
   (if	(not (or (= j "Center") (= j "Left") (= j "Right")))
     (setq j (setvar "users1" "Center"))
   )
   (if	(< w 0)
     (setq w 0)
   )
   (setq ok "YES")
   (while (= ok "YES")
     (initget "Center Left Right Width")
     (setq p
     (getpoint
       (strcat "Specify start point or [Center/Left/Right/Width] <"
	       j
	       ": "
	       (rtos w 2)
	       ">: "
       )
     )
     )
     (if p
(cond
  ((= p "Center") (setq j (setvar "users1" p)))
  ((= p "Left") (setq j (setvar "users1" p)))
  ((= p "Right") (setq j (setvar "users1" p)))
  ((= p "Width")
   (setq w (setvar "userr3"
		   (getreals w "\nChieu day buc tuong " "")
	   )
   )
  )
  ((= (type p) 'LIST) (setq ok "NO"))
)
(setq ok "NO")
     )
   )
   p
 )

				;enf input
 (defun undo (val i / nval p j)
   (if	(> i 0)
     (progn
(setq i	   (- i 1)
      nval '()
      p	   (nth 0 (nth i val))
      j	   0
)
(if (not p)
  (alert "thieu p1")
)
(repeat	(1+ i)
  (setq	nval (append nval (list (nth j val)))
	j    (1+ J)
  )
)
(setq val nval)
(command "Undo" "")
     )
     (setq p (nth 0 (nth 0 val)))
   )
   (list p val i)
 )
				;end undo
 (defun trim (sset val / taodanhsachcat yeucaucat cat)
   (defun taodanhsachcat (sset	  val	 /	sslen  hand_lst
		   i	  len	 sec1	sec2   hand3  hand4
		   data	  hand1	 hand2	entg   hand   dxf
		   pos	  len	 ent
		  )
     (setq sslen    (sslength sset)
    hand_lst '()
    i	     0
    len	     (length val)
    sec1     (nth (- len 2) val)
    sec2     (nth (- len 1) val)
    hand3    (nth 1 sec2)
    hand4    (nth 2 sec2)
    data     '()
     )
     (if (> (length sec1) 1)
(setq hand1 (nth 1 sec1)
      hand2 (nth 2 sec1)
      data  (append data
		    (list (list hand1 (entn2lst (handent hand1))))
	    )
      data  (append data
		    (list (list hand2 (entn2lst (handent hand2))))
	    )
)
     )
     (setq data (append data
		 (list (list hand3 (entn2lst (handent hand3))))
	 )
    data (append data
		 (list (list hand4 (entn2lst (handent hand4))))
	 )
     )
     (repeat sslen
(setq entg (entget (ssname sset i))
      hand (cdr (assoc 5 entg))
      dxf  (cdr (assoc 0 entg))
      pos  (vl-position dxf '("LINE"))
      i	   (1+ i)
)
(if pos
  (setq hand_lst (append hand_lst (list hand)))
)
     )
     (setq len	(length data)
    i	0
     )
     (repeat len
(setq hand_lst (vl-remove (nth 0 (nth i data)) hand_lst)
      i	       (1+ i)
)
     )
     (setq len	(length hand_lst)
    i	0
     )
     (repeat len
(setq ent      (handent (nth i hand_lst))
      hand_lst (subst
		 (list (cdr (assoc 5 (entget ent))) (entn2lst ent))
		 (nth i hand_lst)
		 hand_lst
	       )
      i	       (1+ i)
)
;;;	(redraw ent 3)
     )
     (list data hand_lst)
   )
				;end taodanhsachcat
   (defun yeucaucat (pt_lst / m k entg)
     (setq oldpt_lst pt_lst)
     (progn
(setq m	(fix (/ ptlen 2))
      k	0
)
(if (> m 1)
  (progn
    (setq entg (entget (handent hand)))
    (repeat (- m 1)
      (setq entg (subst	(cons 10 (nth 1 (nth k pt_lst)))
			(assoc 10 entg)
			entg
		 )
	    entg (subst	(cons 11 (nth 1 (nth (+ k 1) pt_lst)))
			(assoc 11 entg)
			entg
		 )
	    k	 (+ k 2)
      )
      (entmake entg)
    )
    (setq entg (subst (cons 10 (nth 1 (nth k pt_lst)))
		      (assoc 10 entg)
		      entg
	       ))
(if (= (rem ptlen 2) 0 )	  
(setq	  entg
	       (subst (cons 11 (nth 1 (nth (+ k 1) pt_lst)))
		      (assoc 11 entg)
		      entg
	       )
    )
  (setq	  entg
	       (subst (cons 11 (nth 1 (nth (+ k 2) pt_lst)))
		      (assoc 11 entg)
		      entg
	       )
    )
  )

    (entmod entg)
  )
)
     )
   )
				;end yeucaucat
   (defun cat (hand_lst    data  idx	/     len   i	  n	hand
	line line2 pt_lst	  p1	p2    j	    p3	  p4	p
	sr    ptlen rems  entg	pd    pc    ang	  m	k
       )
     (setq len	(length hand_lst)
    i	0
    n	(length data)
     )
     (repeat len
(setq hand   (nth 0 (nth i hand_lst))
      line   (nth 1 (nth i hand_lst))
      pt_lst '()
      p1     (nth 0 line)
      p2     (nth 2 line)
      pt_lst (append pt_lst (list (list 0 p1)))
      pt_lst (append pt_lst (list (list (distance p1 p2) p2)))
)
(setq j 0)
(repeat	n
  (setq	line (nth 1 (nth j data))
	p3   (nth 0 line)
	p4   (nth 2 line)
	p    (inters p1 p2 p3 p4 t)
  )
  (if (or (equal p p2 0.000001) (equal p p1 0.000001)) (setq p '()))
  (if (= (rem j 2) 0)
    (setq sr (list p4 p3))
    (setq sr (list p3 p4))
  )
  (if p
    (setq
      pt_lst
       (append pt_lst (list (list (distance p1 p) p sr)))
      p '()
    )
  )
  (setq j (+ j 1))
)
(setq pt_lst (vl-sort pt_lst
		      (function	(lambda	(e1 e2)
				  (< (nth 0 e1) (nth 0 e2))
				)
		      )
	     )
)
(setq ptlen (length pt_lst)
      rems  (rem ptlen 2)
)
(if (= idx 1)
  (progn
    (if	(= rems 0)
      (yeucaucat pt_lst)
      (progn
	(setq entg (entget (handent hand)))
	(setq p1 (cdr (assoc 10 entg))
	      p2 (cdr (assoc 11 entg))
	      p	 (nth 1 (nth 1 pt_lst))
	      sr (nth 2 (nth 1 pt_lst))

	)
	(if sr
	  (progn
	    (setq
	      pd (nth 0 sr)
	      pc (nth 1 sr)
	    )
	    (setq ang (ang_213 pd pc p1))
	    (if	(> ang pi)
	      (setq
		entg (subst (cons 10 p) (assoc 10 entg) entg)
	      )
	      (setq
		entg (subst (cons 11 p) (assoc 11 entg) entg)
	      )
	    )
	    (entmod entg)
	  )
	)
      )
    )
  )
  (progn
    (setq m (fix (/ ptlen 2))
	  k 0
    )
    (if	(> m 1)
      (yeucaucat pt_lst)
    )

  )
)
(setq i (+ i 1))
     )
   )
				;end cat
   (setq ans	   (taodanhsachcat sset val)
  data	   (nth 0 ans)
  hand_lst (nth 1 ans)
   )
   (cat hand_lst data 1)		;cat thuc the chan cua no idx=0,1 Khong/Co cat
   (cat data hand_lst 0)
 )
				;end trim
 (defun draw (val   /	   j	 w     len   sec1  sec2	 c1    c2
       ang   p1	   p2	 p3    p4    entg1 entg2 ps1   ps2
       ps3   ps4   pt_list     sset
      )
   (setq j    (getvar "users1")
  w    (getvar "userr3")
  len  (length val)
  sec1 (nth (- len 2) val)
  sec2 (nth (- len 1) val)
  c1   (nth 0 sec1)
  c2   (nth 0 sec2)
   )
   (cond
     ((= j "Left") (setq s w))
     ((= j "Center") (setq s (/ w 2)))
     ((= j "Right") (setq s 0))
   )
   (setq ang (angle c1 c2)
  p1  (polar c1 (+ ang (/ pi 2)) s)
  p2  (polar c2 (+ ang (/ pi 2)) s)
  p3  (polar p1 (- ang (/ pi 2)) w)
  p4  (polar p2 (- ang (/ pi 2)) w)
   )
   (if	(> (length sec1) 1)
     (progn
(setq entg1   (entget (handent (nth 1 sec1)))
      entg2   (entget (handent (nth 2 sec1)))
      ps1     (cdr (assoc 10 entg1))
      ps2     (cdr (assoc 11 entg1))
      ps3     (cdr (assoc 10 entg2))
      ps4     (cdr (assoc 11 entg2))
      p1      (inters ps1 ps2 p1 p2 nil)
      p3      (inters ps3 ps4 p3 p4 nil)
      entg1   (subst (cons 11 p1) (assoc 11 entg1) entg1)
      entg2   (subst (cons 11 p3) (assoc 11 entg2) entg2)
      pt_list (list ps4 p3 p4 p2 p1)
)
(entmod entg1)
(entmod entg2)
     )
   )
   (if	(not pt_list)
     (setq pt_list (list p1 p2 p4 p3))
   )
   (command "line" p1 p2 "")
   (setq hand (cdr (assoc 5 (entget (entlast)))))
   (setq sec2 (append sec2 (list hand)))
   (command "line" p3 p4 "")
   (setq hand (cdr (assoc 5 (entget (entlast)))))
   (setq sec2 (append sec2 (list hand)))
   (setq val (subst sec2 (nth (- len 1) val) val))
   (setq sset (ssget "f" pt_list))
   (if	sset
     (trim sset val)
   )
   val
 )
				;end draw
 (defun next (p1 / ok val i p2 ans p1)
   (if	(= (type p1) 'LIST)
     (progn
(setq ok  "YES"
      val (list (list p1))
      i	  0
)
(while (= ok "YES")
  (if (= i 0)
    (setq name "\nSpecify next point:")
    (setq name "\nSpecify next point or [undo]: ")
  )
  (initget "Undo")
  (setq p2 (getpoint name p1))
  (if p2
    (progn
      (if (= p2 "Undo")
	(progn
	  (setq ans (undo val i))
	  (setq	p1  (nth 0 ans)
		val (nth 1 ans)
		i   (nth 2 ans)
	  )
	)
	(progn
	  (setq	p1  p2
		val (append val (list (list p1)))
		i   (+ i 1)
	  )
	  (command "Undo" "group")
	  (setq val (draw val))
	  (command "undo" "end")
	)
      )
    )
    (setq ok "NO")
  )
)
     )
   )
 )
				;end next
;;;--------MAIN-----------
 (command "Undo" "group")
 (setq p (vl-catch-all-apply 'input '()))
 (next p)
;;;  (vl-catch-all-apply 'next '(p))
 (command "Undo" "End")
)

Tháng 8 19, 2009

Chào conghoan
Lisp này Tue_NV đã viết xong. Conghoan chạy thử xem sao :

http://www.cadviet.com/upfiles/2/vbun6.lsp

Conghoan cho ý kiến nhé

Tue_NV xem lại giúp mình với mình test trên cad 2007 nó bị như thế này: http://www.cadviet.com/upfiles/2/tnct.dwg

Cảm ơn Tue_NV nhiều!

Đăng nhập

Viết Lisp theo yêu cầu

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

tomboy 21

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tomboy 21

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

t031285 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

viennv 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

svba1608 627

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tomboy 21

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hailuavnn 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

t031285 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ruamap 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kiukiu. 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.548

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyenkhoadung98 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 325

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7