+ Reply to Thread
Page 2 of 2 FirstFirst 1 2
Results 11 to 13 of 13
  1. #11
    Super Member hanhphuc's Avatar
    Using
    AutoCAD 2007
    Join Date
    Apr 2013
    Location
    Happy Garden
    Posts
    749

    Default

    Registered forum members do not see this ad.

    my attempt have some fun with command call, but may need to
    consider osmode angdir mirrtext etc..

    Code:
    ;; Make Angle Readable by: ymg  
    (defun MakeReadable (a)
      (setq a (rem (+ a pi pi) (+ pi pi)))
      (rem (if (< (* pi 0.5) a (* pi 1.5))
    	 (+ a pi)
    	 a
    	 ) 
           (+ pi pi)
           ) 
      ) 
    
     (defun _mirror (x / en ie) ;*global variable= s & ip 
     ;simply calling standard command "mirror" to manipulate or flip the reference annotation
        (cons 'progn
    	  (list	(cons 'setq '(ie 0))
    		(cons 'repeat
    		      (list (sslength s)
    			    (cons 'vl-cmdf
    				  (list	"_.mirror"
    					'(setq en (ssname s ie))
    					""
    					(cons 'list ip)
    					(cons 'polar (list (cons 'list ip) x 1.0))
    					"Y"
    					) 
    				  ) 
    			    (cons 'setq '(ie (1+ ie)))
    			    ) 
    		      ) 
    		) 
    	  ) 
        ) ;_ end of defun
    
    
     (defun delta (p1 p2 ip / xy id dxy s i a l e)
     ;hanhphuc 
          (setq xy     '((p) (list (car p) (cadr p)))
    	    id	(mapcar	''((x) (equal x (apply 'mapcar (cons '>= (mapcar 'xy (list p2 p1))))))
    			'((T T) (nil T) (nil nil) (T nil))
    			)
    	    
    	    dxy	(mapcar '- p1 p2)
    	    
    	    s	(apply ''((txh pt dX dY / ss next ro yd p) 
    			  (setvar 'osmode 0) 
    			  (setq
    			   yd
    			   (getvar 'ucsydir)
    			   ro
    			   (MakeReadable
    			    (if
    			     (equal (car yd) 0.0 1e-10)
    			     0.0
    			     (atan (/ (car yd) (cadr yd)))
    			     ) 
    			    )
    			   )
    			  
     ; Draw arrow by standard command: PLINE 
    			  (vl-cmdf
    			   "_PLINE"
    			   (list (car pt) (+ (cadr pt) (* 2. txh)))
    			   "w"
    			   0.0
    			   (* 0.3 txh)
    			   (list (car pt) (+ (cadr pt) txh))
    			   "w"
    			   0.0
    			   0.0
    			   pt
    			   "w"
    			   0.0
    			   0.0
    			   (list (+ (car pt) txh) (cadr pt))
    			   "w"
    			   (* 0.3 txh)
    			   0.0
    			   (list (+ (car pt) (* 2. txh)) (cadr pt))
    			   ""
    			   ) ; command
    			  
    			  (setq next (ssadd))
    			  (foreach
    			   ss
    			   (vl-list*
    			    (entlast)
    			    (mapcar
    			     ''((a b c d)
    				(entmakex
    				 (mapcar
    				  'cons
    				  '(0 1 8 10 11 40 50 62 72 73) 
    				  (list "TEXT" a "DIFF" (setq p (polar (trans pt 1 0) (- b ro) c)) p txh (- d ro) 256 1 2)
    				  )
    				 )
    				)
    			     (list dY dX)
    			     (list  (* pi 0.5) 0.) 
    			     (list (* 4.0 txh) (* 4.0 txh)) 
    			     (list (* pi 0.5) 0.0)
    			     
    			     ) ; mapcar  
    			    ) ; vl-list* 
    			   (ssadd ss next)
    			   ) 
    			  next
    			  ) 
    		       (vl-list* (getvar 'textsize)
    				 ip
    				 (mapcar ''((f) (rtos (abs (* (f dxy) 1000.)) 2 0)) (list car cadr))
    				 )
    		       )
    	    ) 
          (eval (cons 'cond
    		  (vl-list* (list (nth 0 id) T)
    			    (mapcar ''((a b)
    				       (list
    					(setq i (nth a id))
    					(_mirror b)
    					(if
    					 (and i (nth 2 id))
    					 (_mirror (* pi 0.5))
    					 )
    					)
    				       )
    				    '(1 2 3)
    				    (list (* pi 0.5) 0.0 pi)
    				    )
    			    )
    		  ) 
    	    ) ;eval
         (repeat (setq i (sslength s))
        (setq e (ssname s (setq i (1- i)))
    	  l (entget e)
    	  a (cdr (assoc 50 l))
    	  ) 
        (if	(assoc 1 l)
          (entmod (subst (cons 50 (MakeReadable a)) (assoc 50 l) l))
          ) 
        ) ;repeat
    
          )
    
    
    (defun c:test (/ p1 p2 p3 )
     
      (terpri)
      (while (and (setq p1 (getpoint "\rTheoretical point..       "))
    	      (setq p2 (getpoint p1 "\rActual point..            "))
    	      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
    	      )
        (delta p1 p2 p3)
        ) 
      (princ)
      )
    _$ ( apply 'equal "hp" "happy" "hạnh phúc" "ハッピー" "幸福" "행복" )
    ; error: too many arguments

  2. #12
    Super Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    892

    Default

    Another:
    Code:
    (defun c:foo (/ _text d p1 p2 s)
      (defun _text (p h s)
        (entmakex (list '(0 . "TEXT")
    		    '(100 . "AcDbEntity")
    		    '(67 . 0)
    		    '(62 . 1)
    		    '(8 . "text")
    		    '(100 . "AcDbText")
    		    (cons 10 p)
    		    (cons 40
    			  (if (> (getvar 'dimscale) 0)
    			    (* h (getvar 'dimscale))
    			    h
    			  )
    		    )
    		    (cons 1 (vl-princ-to-string s))
    		    '(50 . 0.0)
    		    '(41 . 1.0)
    		    '(51 . 0.0)
    		    '(7 . "Standard")
    		    '(71 . 0)
    		    '(72 . 1)
    		    (cons 11 p)
    		    '(100 . "AcDbText")
    		    '(73 . 2)
    	      )
        )
      )
      (if (setq s (ssget '((0 . "point"))))
        (progn (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
    			   (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    		   )
    		 s (vl-sort s '(lambda (a b) (< (cadr a) (cadr b))))
    	   )
    	   (while (cadr s)
    	     (setq p1 (car s))
    	     (setq
    	       p2 (car (vl-sort (setq s (cdr s)) '(lambda (a b) (< (distance p1 a) (distance p1 b)))))
    	     )
    	     (setq d (mapcar 'abs (mapcar '- p1 p2)))
    	     (entmakex (list '(0 . "LWPOLYLINE")
    			     '(100 . "AcDbEntity")
    			     '(67 . 0)
    			     '(62 . 8)
    			     '(8 . "difference")
    			     '(100 . "AcDbPolyline")
    			     '(90 . 3)
    			     (cons 10 p1)
    			     (cons 10 (list (car p2) (cadr p1)))
    			     (cons 10 p2)
    		       )
    	     )
    	     (_text p1 0.1 (car d))
    	     (_text p2 0.1 (cadr d))
    	     (setq s (vl-remove p2 s))
    	   )
        )
      )
      (princ)
    )
    Attached Images

  3. #13
    Junior Member
    Discipline
    Construction
    Using
    AutoCAD 2018
    Join Date
    Oct 2017
    Posts
    17

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by hanhphuc View Post
    my attempt have some fun with command call, but may need to
    consider osmode angdir mirrtext etc..

    Code:
    ;; Make Angle Readable by: ymg  
    (defun MakeReadable (a)
      (setq a (rem (+ a pi pi) (+ pi pi)))
      (rem (if (< (* pi 0.5) a (* pi 1.5))
    	 (+ a pi)
    	 a
    	 ) 
           (+ pi pi)
           ) 
      ) 
    
     (defun _mirror (x / en ie) ;*global variable= s & ip 
     ;simply calling standard command "mirror" to manipulate or flip the reference annotation
        (cons 'progn
    	  (list	(cons 'setq '(ie 0))
    		(cons 'repeat
    		      (list (sslength s)
    			    (cons 'vl-cmdf
    				  (list	"_.mirror"
    					'(setq en (ssname s ie))
    					""
    					(cons 'list ip)
    					(cons 'polar (list (cons 'list ip) x 1.0))
    					"Y"
    					) 
    				  ) 
    			    (cons 'setq '(ie (1+ ie)))
    			    ) 
    		      ) 
    		) 
    	  ) 
        ) ;_ end of defun
    
    
     (defun delta (p1 p2 ip / xy id dxy s i a l e)
     ;hanhphuc 
          (setq xy     '((p) (list (car p) (cadr p)))
    	    id	(mapcar	''((x) (equal x (apply 'mapcar (cons '>= (mapcar 'xy (list p2 p1))))))
    			'((T T) (nil T) (nil nil) (T nil))
    			)
    	    
    	    dxy	(mapcar '- p1 p2)
    	    
    	    s	(apply ''((txh pt dX dY / ss next ro yd p) 
    			  (setvar 'osmode 0) 
    			  (setq
    			   yd
    			   (getvar 'ucsydir)
    			   ro
    			   (MakeReadable
    			    (if
    			     (equal (car yd) 0.0 1e-10)
    			     0.0
    			     (atan (/ (car yd) (cadr yd)))
    			     ) 
    			    )
    			   )
    			  
     ; Draw arrow by standard command: PLINE 
    			  (vl-cmdf
    			   "_PLINE"
    			   (list (car pt) (+ (cadr pt) (* 2. txh)))
    			   "w"
    			   0.0
    			   (* 0.3 txh)
    			   (list (car pt) (+ (cadr pt) txh))
    			   "w"
    			   0.0
    			   0.0
    			   pt
    			   "w"
    			   0.0
    			   0.0
    			   (list (+ (car pt) txh) (cadr pt))
    			   "w"
    			   (* 0.3 txh)
    			   0.0
    			   (list (+ (car pt) (* 2. txh)) (cadr pt))
    			   ""
    			   ) ; command
    			  
    			  (setq next (ssadd))
    			  (foreach
    			   ss
    			   (vl-list*
    			    (entlast)
    			    (mapcar
    			     ''((a b c d)
    				(entmakex
    				 (mapcar
    				  'cons
    				  '(0 1 8 10 11 40 50 62 72 73) 
    				  (list "TEXT" a "DIFF" (setq p (polar (trans pt 1 0) (- b ro) c)) p txh (- d ro) 256 1 2)
    				  )
    				 )
    				)
    			     (list dY dX)
    			     (list  (* pi 0.5) 0.) 
    			     (list (* 4.0 txh) (* 4.0 txh)) 
    			     (list (* pi 0.5) 0.0)
    			     
    			     ) ; mapcar  
    			    ) ; vl-list* 
    			   (ssadd ss next)
    			   ) 
    			  next
    			  ) 
    		       (vl-list* (getvar 'textsize)
    				 ip
    				 (mapcar ''((f) (rtos (abs (* (f dxy) 1000.)) 2 0)) (list car cadr))
    				 )
    		       )
    	    ) 
          (eval (cons 'cond
    		  (vl-list* (list (nth 0 id) T)
    			    (mapcar ''((a b)
    				       (list
    					(setq i (nth a id))
    					(_mirror b)
    					(if
    					 (and i (nth 2 id))
    					 (_mirror (* pi 0.5))
    					 )
    					)
    				       )
    				    '(1 2 3)
    				    (list (* pi 0.5) 0.0 pi)
    				    )
    			    )
    		  ) 
    	    ) ;eval
         (repeat (setq i (sslength s))
        (setq e (ssname s (setq i (1- i)))
    	  l (entget e)
    	  a (cdr (assoc 50 l))
    	  ) 
        (if	(assoc 1 l)
          (entmod (subst (cons 50 (MakeReadable a)) (assoc 50 l) l))
          ) 
        ) ;repeat
    
          )
    
    
    (defun c:test (/ p1 p2 p3 )
     
      (terpri)
      (while (and (setq p1 (getpoint "\rTheoretical point..       "))
    	      (setq p2 (getpoint p1 "\rActual point..            "))
    	      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
    	      )
        (delta p1 p2 p3)
        ) 
      (princ)
      )
    Hi,

    This is olmosta done but, is it possible edit code like this: activ osnap stay ON and number is always same direction!

    Best,
    Margus

Similar Threads

  1. Theoretical Sharp Corner Dimension Placement
    By gbradley in forum Autodesk Inventor
    Replies: 9
    Last Post: 23rd Jul 2014, 09:43 pm
  2. Plot Actual Size
    By magic-chef in forum AutoCAD Drawing Management & Output
    Replies: 7
    Last Post: 1st Dec 2008, 04:09 pm
  3. Fonts that use an actual Ampersand (&)?
    By RhoadBlock in forum AutoCAD Beginners' Area
    Replies: 7
    Last Post: 21st Jul 2008, 06:15 pm
  4. dimensioning a theoretical sharp corner
    By Dazed and Confused in forum AutoCAD Drawing Management & Output
    Replies: 8
    Last Post: 1st Feb 2005, 12:45 am
  5. Renders from actual photos
    By hyposmurf in forum AutoCAD 3D Modelling & Rendering
    Replies: 20
    Last Post: 30th Apr 2004, 12:17 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts