Chuyển đến nội dung
Diễn đàn CADViet

hiepttr

Thành viên
  • Số lượng nội dung

    1.237
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    51

Bài đăng được đăng bởi hiepttr


  1. 1 giờ trước, phongnh đã nói:

    Bạn sgcq,

     

    1. Mình thử lưu vào thư mục khác thì thấy file png đã pngout. Có điều file rất nhỏ, chất lượng kém.

     

    2. Cách khác hay hơn:

    2.1. Dùng máy in png/jpg của autocad sẽ được file chất lượng tốt hơn hẳn.

    2.2. Dùng trình snipping tool có sẵn trong windows chụp màn hình rồi save as png/jpg.

     

    3. Cách khác, các bạn cùng chia sẻ cho mọi người cùng biết.

     

    Phong

    Cách nữa là dùng phần mềm chuyên dụng để quét xem nó được lưu ở ô nhớ nào.

    Xong, đập máy móc nó ra rồi dùng phone để chụp :D :D :D


  2. Phải chăng như vầy ? ^^

    (defun c:msweep ( / BASEPOINT CNTR DELOBJVAR MESSAGE MPTH PRF SWEEPPATH)
    (setq
    delobjvar (getvar "delobj");Obtaining DELOBJ variable.
    prf (entsel "\nPick profile to sweep: ");Select one object that would be profile of new 3D solid or 3D surface.
    BasePoint (getpoint "\n Base point: ")
    )
    (princ "\nSelect paths to sweep along: ");Select multiple paths.
    (setq
    mpth (ssget)
    cntr 0
    )
    (princ (sslength mpth))
    (princ " - Paths selected.")
    (setvar "delobj" 0);Set DOLOBJ variable to 0 to remain profile and paths.
    (while (< cntr (sslength mpth))
    (setq
    sweeppath (ssname mpth cntr)
    )
    (command "sweep" prf "" "b" BasePoint sweeppath)
    (setq
    cntr (+ cntr 1)
    )
    )
    (setq
    message " - objects created using sweep command."
    )
    (princ cntr)
    (princ message)
    (setvar "delobj" delobjvar);Restoring Your DELOBJ variable.
    (princ)
    )

     

    • Like 1

  3. Có thể là như này ^^

    (defun c:-()
      (vl-load-com)  
         (setq sbt (car (entsel "\nChon so bi tru:"))
               st (car (entsel "\nChon so tru:\n"))
               kq (- (atof (vl-string-subst "." "," (cdr (assoc 1 (entget sbt)))))
                 (atof (vl-string-subst "." "," (cdr (assoc 1 (entget st)))))))      
         (princ kq)
      (setq obj (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua:"))))
      (vla-put-TextString obj (vl-string-subst "," "." (rtos kq 2 2)))  
      (princ))

     

    • Like 1

  4. Hôm nay xin phép được "đào mồ" tut này lên ^^

    Mọi người cho mình hỏi: Cho đến nay đã có văn bản nào thay thế công văn 29/GTĐB ngày 06/01/2003 của (Tổng) Cục ĐBVN) chưa? Nếu có cho mình xin chút thông tin!

    Hoặc nếu công văn 29/GTĐB ngày 06/01/2003 của (Tổng) Cục ĐBVN) vẫn còn hiệu lực thì bác nào còn lưu cho mình xin một bản.

    Mail của mình: hiepttr@gmail.com

    Thanks!

    p/s:
    GG sấp mặt mà chẳng tìm đc gì nên mới làm phiền các bác ^^


  5. Đang rảnh nên xào xáo được cho bạn cái này.

    Đề bài sơ sai nên nếu sản phẩm không như ý thì cũng đừng kêu quá to nhé :D :D :D

    ;lisp ve tiep tuyen cho cung trong LWPolyline
    (defun c:VTT( / ANG ANG1 BULGE DIST DXF10_LST DXF42_LST ENT I INFO LEN LST_VA OLD PT1 PT2 PT_D R TT)
    (setq lst_va '("osmode" "cmdecho" "AUNITS"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(0 0 3))
    (prompt "\nChon tuyen PL!")
    (setq ent (ssget "+.:E:S" '((0 . "LWPOLYLINE"))))
    (if ent
    	(progn
    		(setq info (entget(ssname ent 0))
    			  dxf10_lst (vl-remove-if-not '(lambda(x) (= (car x) 10)) info)
    			  dxf42_lst (vl-remove-if-not '(lambda(x) (= (car x) 42)) info)
    			  i 0
    			  len (length dxf42_lst)
    			  )
    		(while (< i (1- len))
    			(cond
    				((not (equal (setq bulge (cdr (nth i dxf42_lst))) 0))
    					(setq pt1 (cdr (nth i dxf10_lst))
    						  pt2 (if (< i (1- len)) (cdr (nth (1+ i) dxf10_lst)) (cdr (nth 0 dxf10_lst)))
    						  dist (distance pt1 pt2)
    						  ang (* 4 (atan bulge))
    						  R (/ (/ dist 2.) (cos (setq ang1 (- (* 0.5 pi) (* ang 0.5)))))
    						  TT (* R (/ (sin (* ang 0.5)) (cos (* ang 0.5))))
    						  pt_D (polar pt1 (- (angle pt1 pt2) (- (* pi 0.5) ang1)) TT)
    						  )
    						  (MakeLine pt1 pt_D nil nil nil 2 nil)
    						  (MakeLine pt2 pt_D nil nil nil 2 nil)
    						  )
    			)	;cond
    			(setq i (1+ i))
    		)	;while
    	)
    	(princ "\n*** Khong chon duoc PL nao! ***")
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )
    ;=================================
    (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))))
    );end

     


  6. Lại nghịch ^^

    Và lý do là tại bạn đăng bài theo cách của bạn nên mình code lisp theo cách của mình, cụ thể:

    File xuất ra có các cột: STT, k/c, góc rẽ & 02 cột tọa độ.

    Với cột góc, số liệu xuất ra có đơn vị là độ (phần nghuyên & phần thập phân),

    khi góc:

    <180 ==> rẽ trái,

    =180 ==> thẳng,

    >180 ==> rẽ phải (khi đó, giá trị trong dim của bạn bằng 360 trừ giá trị trong cột).

    Good luck!

     

    p/s:

    Bạn không nên lưu file CAD tên tiếng Việt, lisp ko thịt đc ^^

     

    ;; https://www.cadviet.com/forum/topic/171694-nh%E1%BB%9D-vi%E1%BA%BFt-gium-lisp-autocad/
    (defun c:EDAC( / ANG DIST ENT FN I LST_DATA LST_PT OLD PT PT_S PT_TR PW START VAR)
    ;;;export Distance, Angle, Coordinate
    (vl-load-com)
    (setq var '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar var))
    (mapcar 'setvar var '(0 0))
    (setq ent (car (entsel "\nChon PL: ")))
    (setvar "osmode" 1)
    (setq start (getpoint "\nPick chon diem dau: "))
    
    (cond 
    	((and ent start)
    		(setq lst_pt (acet-geom-vertex-list ent))
    		(if (not(equal (distance start (car lst_pt)) 0 0.001)) (setq lst_pt (reverse lst_pt)))
    		(setq i 0 
    			  lst_data (list (list 1 0 0 (car lst_pt)))
    			  )
    		(repeat (- (length lst_pt) 2)
    			(setq i (1+ i)
    				  pt_tr (nth (1- i) lst_pt)
    				  pt (nth i lst_pt)
    				  pt_s (nth (1+ i) lst_pt)
    				  dist (distance pt pt_tr)
    				  ang (deviant (angle pt pt_s) (angle pt_tr pt))
    				  lst_data (append lst_data (list (list (1+ i) dist ang pt)))
    				  )
    		)
    		(setq lst_data (append lst_data (list (list (+ 2 i) (distance pt_s pt) 0 pt_s))))
    	;;;-----------------
    		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
     		(setq pw (open fn "w"))
    		(write-line "DIST,ANG,COORD" pw)
    		(foreach elem lst_data
     			(write-line (strcat (rtos (cadr elem) 2 0) "," (rtos (caddr elem) 2 3) "," (rtos (cadr (last elem)) 2 3) "," (rtos (car (last elem)) 2 3)) pw)
    		)
    		(close pw)
    	)
    	(t (alert "*** Bam lung tung, moi bam lai ! ***"))
    )
    (mapcar 'setvar var old)
    (princ)
    )
    ;;;====================
    (defun deviant (ang2 ang1 / deviant_rad deviant_deg)
    (setq deviant_rad (if (> ang2 ang1) (- ang2 ang1) (- (+ (* 2 pi) ang2) ang1))
    	  deviant_deg (/ (* deviant_rad 180) pi))
    )

     

    • Like 1

  7. Uhm, thì tạo text vậy ^^

    ;lisp noi suy
    (defun c:NS( / CD CD1 CD2 DIS1 DIS2 LST_VA OLD PL1 PL2 PT TEXT1 TEXT2)
    (vl-load-com)
    (setq lst_va '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(4 0))
    (setq pl1 (car (entsel "\n Chon dinh (hoac chan) ta luy: "))
    	  text1 (car (entsel "\n Chon text cao do tuong ung: "))
    	  pl2 (car (entsel "\n Chon chan (hoac dinh) ta luy: "))
    	  text2 (car (entsel "\n Chon text cao do tuong ung: "))
    	  )
    (if (and pl1 pl2 text2 text2)
    	(progn
    		(setq cd1 (atof (Replace_First_Comma_by_Dot (cdr (assoc 1 (entget text1)))))
    			  cd2 (atof (Replace_First_Comma_by_Dot (cdr (assoc 1 (entget text2)))))
    		
    			;  pl1 (vlax-ename->vla-object pl1)
    			;  pl2 (vlax-ename->vla-object pl2)
    			)
    		(while
    			(setq pt (getpoint "\n Pick diem can noi suy cao do <Enter de thoat>: "))
    				(setq pt (reverse (cdr (reverse pt)))
    					  dis1 (distance pt (vlax-curve-getClosestPointTo pl1 pt))
    					  dis2 (distance pt (vlax-curve-getClosestPointTo pl2 pt))
    					  cd (+ cd1 (* dis1 (/ (- cd2 cd1) (+ dis1 dis2))))
    					  )
    				(princ (strcat "\n Cao do tai diem nay la: " (rtos cd 2 4)))
    				(MakeText (trans pt 1 0) (rtos cd 2 2) 1 0 "L" nil nil nil nil)
    		)
    	)
    	(princ "\n Bam lung tung roi ^^ Lam lai!")
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )
    ;;;===================================
    (defun Replace_First_Comma_by_Dot (string_with_comma / STR STR1 STR2 VT)
    (cond
    	((setq vt (vl-string-position (ascii ",") string_with_comma))
    		(setq str1 (substr string_with_comma 1 vt)
    			  str2 (substr string_with_comma (+ vt 2))
    			  str (strcat str1 "." str2)
    			  )
    			  )
    	(t (setq str string_with_comma))
    )
    )
    ;;;=======================================
    (defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
    ; Ang: Radial	
    (setq Lst (list '(0 . "TEXT")
    				(cons 8 (if Layer Layer (getvar "Clayer")))									
    				(cons 62 (if Color Color 256))									
    				(cons 10 point)									
    				(cons 40 Height)									
    				(cons 1 string)									
    				(if Ang (cons 50 Ang))									
    				(cons 7 (if Style Style (getvar "Textstyle")))									
    				(cons -3 (if xdata (list xdata) nil)))				
    				justify (strcase justify))	
    				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
    					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
    					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
    					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
    					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
    					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
    					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
    					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
    					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
    					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
    					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
    					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
    					  )	
    					  (entmakex Lst)
    );end

     

    • Like 1

  8. Lại vọc bậy vậy

    Lưu ý:

    - Cad có cài bộ express

    - Các thao tác chọn trắc ngang chuẩn / trắc ngang cần paste thực ra la chỉ cần chon được  2D polyline "PLINEMATPHAI" là được

    - Tất nhiên là lisp chỉ chậy được trên BV tương tự BV mẫu, dạng khác thì ko chắc :D :D :D

    ;;;Lisp co cong nang tuong tu lenh copy thiet ke trong nova
    (defun c:CPTK( / BASE_POINT LST_VA OLD SS SS1 SS2)
    (vl-load-com)
    (setq lst_va '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(0 0))
    (prompt "\nChon doi tuong can copy:")
    (setq ss (ssget))
    (prompt "\nChon trac ngang lam chuan:")
    ;(setq ss1 (ssget '((8 . "PLINEMATPHAI,PLINEMATTRAI"))))
    (setq ss1 (ssget '((8 . "PLINEMATPHAI"))))
    (prompt "\nChon trac ngang can paste:")
    ;(setq ss2 (ssget '((8 . "PLINEMATPHAI,PLINEMATTRAI"))))
    (setq ss2 (ssget '((8 . "PLINEMATPHAI"))))
    (if (and ss ss1 ss2)
    	(progn
    		(setq base_point (car (acet-geom-vertex-list (ssname ss1 0)))
    			  ss2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
    		(foreach elem ss2
    			(vl-cmdf ".copy" ss "" base_point (car (acet-geom-vertex-list elem)))
    		)
    		(princ (strcat "\nDa copy doi tuong ra " (itoa (length ss2)) " ban!"))
    	)
    	(princ "\nXay ra loi roi, nghien cuu lai!")
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )

     

    • Like 1

  9. 4 giờ trước, dinhtuongndvn1211 đã nói:

    lips sau khi nội suy có thể xuất cao độ tại điểm đó không bác.

    Nghĩa là tạo text cao độ ???

    4 giờ trước, dinhtuongndvn1211 đã nói:

    và có thể nội suy cao độ liên tục mà không cẩn pick chân với đỉnh ta luy không ạ

    Bạn có nhầm nhọt vào đâu không? Hiện tại nó thế mà ^^


  10. Đang rảnh, múc tới cho bạn vậy ^^

    ;lisp noi suy
    (defun c:NS( / CD CD1 CD2 DIS1 DIS2 LST_VA OLD PL1 PL2 PT TEXT1 TEXT2)
    (vl-load-com)
    (setq lst_va '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(4 0))
    (setq pl1 (car (entsel "\n Chon dinh (hoac chan) ta luy: "))
    	  text1 (car (entsel "\n Chon text cao do tuong ung: "))
    	  pl2 (car (entsel "\n Chon chan (hoac dinh) ta luy: "))
    	  text2 (car (entsel "\n Chon text cao do tuong ung: "))
    	  )
    (if (and pl1 pl2 text2 text2)
    	(progn
    		(setq cd1 (atof (Replace_First_Comma_by_Dot (cdr (assoc 1 (entget text1)))))
    			  cd2 (atof (Replace_First_Comma_by_Dot (cdr (assoc 1 (entget text2)))))
    		
    			;  pl1 (vlax-ename->vla-object pl1)
    			;  pl2 (vlax-ename->vla-object pl2)
    			)
    		(while
    			(setq pt (getpoint "\n Pick diem can noi suy cao do <Enter de thoat>: "))
    				(setq pt (reverse (cdr (reverse pt)))
    					  dis1 (distance pt (vlax-curve-getClosestPointTo pl1 pt))
    					  dis2 (distance pt (vlax-curve-getClosestPointTo pl2 pt))
    					  cd (+ cd1 (* dis1 (/ (- cd2 cd1) (+ dis1 dis2))))
    					  )
    				(princ (strcat "\n Cao do tai diem nay la: " (rtos cd 2 4)))
    		)
    	)
    	(princ "\n Bam lung tung roi ^^ Lam lai!")
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )
    ;;;===================================
    (defun Replace_First_Comma_by_Dot (string_with_comma / STR STR1 STR2 VT)
    (cond
    	((setq vt (vl-string-position (ascii ",") string_with_comma))
    		(setq str1 (substr string_with_comma 1 vt)
    			  str2 (substr string_with_comma (+ vt 2))
    			  str (strcat str1 "." str2)
    			  )
    			  )
    	(t (setq str string_with_comma))
    )
    )

     


  11. Mì ăn liền ^^

    (defun c:DON( / lst_va old view_lay ss lst_ss lst1 lst2 first_elem base_pt)
    (setq lst_va '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(0 0))
    (setq view_lay (entsel "\n Pick chon viewport mau: "))
    (prompt "\n Chon viewports !")
    ;(setq ss (ssget (list (cons 0 "VIEWPORT"))))
    (setq ss (ssget (list (cons 0 "LWPOLYLINE") (assoc 8 (entget (car view_lay))))))
    (if ss
    	(progn
    		(setq lst_ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    			  lst1 (mapcar '(lambda (x) (cons x (H:Getboundary x))) lst_ss)
    			  lst1 (vl-sort lst1 '(lambda(x y) (< (car (cadr x)) (car (cadr y)))))
    			  first_elem (car lst1)
    			  lst2 (cdr lst1)
    			  )
    			(setq base_pt (list (car (last first_elem)) (cadr (cadr first_elem))))
    		(foreach elem lst2
    			(command ".move" (car elem) "" (cadr elem) base_pt)
    			(setq base_pt (list (+ (car base_pt) (- (car (last elem)) (car (cadr elem)))) (cadr base_pt)))
    		)
    	)
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )
    ;------------------------------------------------------------------------
    (defun H:Getboundary (ent / dt tp)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'dt 'tp)
    (mapcar 'vlax-safearray->list (list dt tp))
    )
    ;-------------------------------------------------------------------------------
    (defun c:DDON( / lst_va old view_lay ss lst_ss lst1 lst2 first_elem base_pt)
    (setq lst_va '("osmode" "cmdecho"))
    (setq old (mapcar 'getvar lst_va))
    (mapcar 'setvar lst_va '(0 0))
    (setq view_lay (entsel "\n Pick chon viewport mau: "))
    (prompt "\n Chon viewports !")
    ;(setq ss (ssget (list (cons 0 "VIEWPORT"))))
    (setq ss (ssget (list (cons 0 "LWPOLYLINE") (assoc 8 (entget (car view_lay))))))
    (if ss
    	(progn
    		(setq lst_ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    			  lst1 (mapcar '(lambda (x) (cons x (H:Getboundary x))) lst_ss)
    			  lst1 (vl-sort lst1 '(lambda(x y) (< (cadr (cadr x)) (cadr (cadr y)))))
    			  first_elem (car lst1)
    			  lst2 (cdr lst1)
    			  )
    			(setq base_pt (last first_elem))
    		(foreach elem lst2
    			(command ".move" (car elem) "" (list (car (last elem)) (cadr (cadr elem))) base_pt)
    			(setq base_pt (list (car base_pt) (+ (cadr base_pt) (- (cadr (last elem)) (cadr (cadr elem))))))
    		)
    	)
    )
    ;;xong tra ve:
    (mapcar 'setvar lst_va old)
    (princ)
    )

     

    • Like 1

  12. @Tue_NV: Mỗi lần pick + 2 lần set sysvar chắc ko kéo dài thêm bao nhiêu so vơi việc duyệt qua nhiều tam giác bác ah(REGENAUTO = ON từ đầu)

    @Thaistreetz: Nếu duyệt trong kích thước 1screen  không có thì tăng lên 2Sc, 4Sc ... Mình nghĩ nếu số điểm đủ lớn thì duyệt vậy vẫn nhanh hơn duyệt tất cả. Tất nhiên là thằng nào duyệt rồi thì mark để không duyệt lại trong lần sau

×