Quick DimAngular Whole-Circle-Angle

June 8, 2014

hey guys ,my 1st attempt in vanilla

It's just a quick whole-Circle dimension-Angular for line selection

Example: select 2 lines of 120° acute, you can get the rest 240° which >180°

(normal case command: _dimangular only get angle 60° which is

Its not the new topic but other threads show method

so just i share an alternative method for test.

;hanhphuc@cadtutor acad2007

(defun c:test (/ l1 l2 m et1 et2 *error*)
(setvar "osmode" 0) ; bug if not zero
(setvar "cmdecho" 0)  
(setq *cancel* *error*)
(defun *error* (msg)
 (if
 (or(= msg "Function cancelled")(= msg "quit / exit abort")
)
(princ "*Cancel*")
(princ (strcat "\n\; error: " msg ))
 );if
 (setq *error* *cancel*)
 (princ)
 )

(if  (and(setq l1 (car (entsel "\nPick line..")))
    (=(setq et1 (cdr (assoc 0 (entget l1)))) "LINE"))
(progn
(if
(setq l2 (car (entsel "\nNext..")))
(setq et2 (cdr (assoc 0 (entget l2))))
(setq et2 et1 )
)
   )
 )
     (cond
       (
        (= et1 "ARC" )  
        (command "_dimangular")  ;if not line, need to re-select ARC entity
       )

       (
        (apply 'and
               (mapcar '(lambda (x) (member x '("LINE"))) (list et1 et2))
        ) ;_  apply
        (progn
          (vl-remove-if '(lambda (x) (equal x (car m) 1e-5))
                        (setq m
                               (list (linterp l1 l2)
                                     (midl l1)
                                     (midl l2)
                               ) ;_  list
                        ) ;_  setq
          ) ;_  vl-remove-if
          (command "_dimangular" "" (car m) (cadr m) (caddr m))
        ) ;_  progn
       )

       (t (command "_dimangular" "")); <vertex-1st-2nd angle point> 
     ) ;_  cond

) ;_  defun


;must load this sub-routine


(defun[color="red"] flatz[/color] (_pt) ;
 (if (and (vl-consp _pt) (= (length _pt) 3))
   (reverse (cdr (reverse (mapcar 'float _pt))))
   ) ;_ end of if
 ) ;_ end of defun


(defun midp (a b / c d) ;get center
   (mapcar '(lambda (c d) (* (+ c d) 0.5)) a b)
 ) ;_  defun


 
(defun midL (_entl /) ; mid point, by 2 line entity

 (if (= (cdr (assoc 0 (entget _entl))) "LINE")

   (apply 'midp (mapcar '(lambda (x) (flatz (cdr (assoc x (entget _entl))))) '(10 11)))

   (alert "Not a line!")
 ) ;_  if
) ;_  defun


(defun linterp (u v / lst) ; 2 Lines intersection 2D
 (setq lst '(nil))
 (apply 'inters
        (foreach z (list u v)
          (setq lst (append
                      (mapcar '(lambda (a b)
                                 (flatz
                                   (cdr (assoc a
                                               (entget b)
                                        ) ;_  assoc
                                   ) ;_  cdr
                                 ) ;_  flatz
                               ) ;_  lambda
                              '(10 11)
                              (list z z)
                      ) ;_  mapcar
                      lst
                    ) ;_  append
          ) ;_  setq
        ) ; foreach
 ) ;_  apply
) ;_  defun

hp#001

Edited October 25, 2014 by hanhphuc
flatz function updated

June 9, 2014

;dear guys, the 'if' logical in entsel normally should be this way:

(if

(and

(setq l1...)

(setq et1...)

(setq l2...)

(setq et2...)

)

;... T

;... Else

)

;the reason I didn't put in my code in order to skip selecting next entity if the 1st entity not a LINE.

If anybody has better practice is welcome to modify it, thank you

June 22, 2014

Multiple DimAngular on LWPolyline

;Works both closed & open LWPolyline

;can get 180° if vertex to vertex parallel;

;command: AngLWP

latest version v1.1 at post#13 - 11/12/14


;Multiple DimAngular method in Visual Lisp
;hanhphuc  22/06/14
;v1.0  
(defun c:AngLWP	(/ pl lst p1 p2 cc m en i v doc midp)
 (setvar "cmdecho" 0)
 (setq	*cancel* *error*
_oldos	 (getvar "osmode")
lst	 '() ; ** can not omit this
midp	 '((a b / c d) (mapcar '(lambda (c d) (/ (+ c d) 2.)) a b))
*error*	 '((msg)
	   (if
	    (wcmatch (strcase msg) "*CANCEL*,*QUIT*") ;"Function cancelled" "quit / exit abort"
	    (princ "*CANCEL*")
	    (princ (strcat "\nError: " msg))
	   )
	   (setq *error* *cancel*)
	   (princ)
	  )
 ) ;_ end of setq
 (if (and (setq en (car (entsel "\nPick LWpolyline..")))
   (equal (cdr (assoc 0 (entget en))) "LWPOLYLINE")
   (setq v (cdr (assoc 90 (entget en)))
	 i -1
   ) ;_ end of setq
     ) ;_ end of and
   (progn
     (repeat v (setq pl (cons (vlax-curve-getPointAtParam en (setq i (1+ i))) pl)))
     (if (= (cdr (assoc 70 (entget en))) 1)
(setq pl (append pl (list (car pl) (cadr pl))))
     ) ;_ end of if
     (vla-StartUndoMark (setq doc (hp:doc)))
     (setvar "osmode" 0) ; Edit
     (foreach x (mapcar '(lambda (pt) (trans pt 0 1)) pl)
(setq lst (cons x lst))
(if (>= (length lst) 3)
  (progn
    (mapcar '(lambda (a b) (set (read a) ((eval b) lst))) '("p1" "cc" "p2") '(car cadr caddr))
    (setq m (midp p1 p2))
    
    (apply 'vla-AddDim3PointAngular
	   (vl-list* (vlax-get-property
		       doc
		       (if (= "Model" (getvar "CTAB"))
			 "modelspace"
			 "paperspace"
		       ) ;_ end of if
		     ) ;_ end of vlax-get-property
		     (mapcar '(lambda (p) (vlax-3d-point (trans p 1 0))) ;lambda
			     (list cc (midp p1 cc) (midp cc p2) (polar m (angle m cc) (* (distance m cc) 1.25)))
		     ) ;_ end of mapcar
	   ) ;_ end of vl-list*
    ) ;_ end of apply
   
  ) ;_ end of progn
) ;_ end of if
     ) ;_ end of foreach
     (vla-EndUndoMark doc)
     (vlax-release-object doc)
   ) ;_ end of progn
 ) ;_ end of if
(setvar "osmode" _oldos); EDIT 
 (princ)
) ;_ end of defun

(vl-load-com)
(defun-q-list-set 'hp:doc '(nil (vla-get-ActiveDocument (vlax-get-acad-object)))) ;inspired by LM:acdoc :-)

Edited December 11, 2014 by hanhphuc

June 22, 2014

(defun-q-list-set 'hp:doc '(nil (vla-get-ActiveDocument (vlax-get-acad-object)))) ;inspired by LM:acdoc :-)

Many thanks for the nod, though note that your function hp:doc is no different to writing (only defined as a list):

(defun hp:doc nil (vla-get-activedocument (vlax-get-acad-object)))

As the expression: (vla-get-activedocument (vlax-get-acad-object)) will be evaluated for every call of the hp:doc function - hence, there is no gain in efficiency as with LM:acdoc (where the active document object is only retrieved once).

June 23, 2014

Many thanks for the nod, though note that your function hp:doc is no different to writing (only defined as a list):
(defun hp:doc nil (vla-get-activedocument (vlax-get-acad-object)))
As the expression: (vla-get-activedocument (vlax-get-acad-object)) will be evaluated for every call of the hp:doc function - hence, there is no gain in efficiency as with LM:acdoc (where the active document object is only retrieved once).

ya the only difference is with normal defun, returns: #<USUBR @2042d9d8 HP:DOC>

however, LM:acdoc gains its uniqueness!

June 23, 2014

just noticed

(setvar "osmode" _oldos)

shouldn't put inside "foreach"...

so, code just updated.

November 7, 2014

Hello hanhphuc,

The code works like a charm!! Thanks !!

It would still be of great help if by some change in the code, we can annotate complementary angles (e.g by this code if some angle is shown as 90 degrees, the complementary angle would be 360-90= 270 Degrees)

I think it is possible with the code as we just need to reverse the angle measurement, but I have no clue as to how it can be done..

Can you help?

Thanks in advance

Edited November 7, 2014 by torn_apart

November 7, 2014

Many thanks ,my friend hanhphuc ,

but ,I can't understand. can you make a demo ?

November 7, 2014

Hello hanhphuc,

The code works like a charm!! Thanks !!

It would still be of great help if by some change in the code, we can annotate complementary angles (e.g by this code if some angle is shown as 90 degrees, the complementary angle would be 360-90= 270 Degrees)

I think it is possible with the code as we just need to reverse the angle measurement, but I have no clue as to how it can be done..

Can you help?

Thanks in advance

hi torn_apart

welcome to the forum!

i not really understand, do you mean acute angle? but you can actually drag the to opposite side which >270

November 7, 2014

Hello hanhphuc,

Thanks for quick reply and warm welcome..

I get that, dragging it to the opposite side will give me the opposite angle.

But there are 100s of them...out of which the code is showing correct internal angles for 60...for the rest 40 this reversing would be needed...so I thought if we just reverse the angle measuring mechanism of the code and run it over the same set..then we would get correct angles for 40 and wrong for 60..

Then we can just merge the correct ones to get the whole thing.

November 7, 2014

Hello hanhphuc,

Thanks for quick reply and warm welcome..

I get that, dragging it to the opposite side will give me the opposite angle.

But there are 100s of them...out of which the code is showing correct internal angles for 60...for the rest 40 this reversing would be needed...so I thought if we just reverse the angle measuring mechanism of the code and run it over the same set..then we would get correct angles for 40 and wrong for 60..

Then we can just merge the correct ones to get the whole thing.

The code put the larger angle >180, so what you mean put acute angle as well?

November 7, 2014

Yes

Only smaller angles.

November 7, 2014

Yes
Only smaller angles.

updated v1.1



;Multiple DimAngular method in Visual Lisp
;AngLwp.lsp
;http://www.cadtutor.net/forum/showthread.php?86844-Quick-DimAngular-Whole-Circle-Angle&p=613297&viewfull=1#post613297
;v1.0: 22/06/14 
;v1.1: 10/12/2014
;	*dimsuppressed* dimension suppressed, only dimension text visible
;	*dimtxtinside* dimension text positin inside / outside 
;	*error* localize & optimized
;	text placement works in UCS
;	credits: MakeReadable & LM:ListClockwise-p

; users can adjust global settings to suit their need here ,[color="red"] t / nil[/color]
[color="blue"]
(setq 
*dimsuppressed* [color="red"][b]nil[/b] [/color] ; t= suppressed / [b][u]nil[/u]= normal [/b]
*dimtxtinside* [color="red"][b]t [/b][/color] ; [b][u]t[/u]= acute angle[/b] / nil= obtuse large > 180
)[/color]

(defun c:AngLWP	( / *error* pl lst p1 p2 cc m en l i v doc midp var sz box vobj )  
;hanhphuc 10/12/2014 anglwp.lsp (v1.1)
(setq	l   '("cmdecho" "osmode" )
var  (mapcar 'getvar l) 
sz	(getvar "dimtxt")
lst	 '() ; ** can not omit this
midp	 '((a b / c d) (mapcar '(lambda (c d) (/ (+ c d) 2.)) a b)));_ end of setq
 
 (mapcar 'setvar l '(0 0 ))
 
(defun *error* (msg)
  (if (= 8 (logand 8 (getvar "undoctl")))
    (vla-EndUndoMark (hp:doc))
    ) ;_ end of if
  (if doc
    (vlax-release-object doc)
    ) ;_ end of if
  (if (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")
    (princ (strcat "\nError: " msg))
    ) ;_ end of if
    (mapcar 'setvar l var)
  (princ)
  ) ;_ end of defun
 
 (if (and (setq en (car (entsel "\nPick LWpolyline..")))
   (eq (cdr (assoc 0 (entget en))) "LWPOLYLINE")
   (setq v (cdr (assoc 90 (entget en)))
	 i -1
   ) ;_ end of setq
     ) ;_ end of and
   (progn
     (repeat v (setq pl (cons (vlax-curve-getPointAtParam en (setq i (1+ i))) pl)))
     (if (= (cdr (assoc 70 (entget en))) 1)
(setq pl (append pl (list (car pl) (cadr pl))))
     ) ;_ end of if
     (vla-StartUndoMark (setq doc (hp:doc)))
       (foreach x (mapcar '(lambda (pt) (trans pt 0 1)) pl)
(setq lst (cons x lst))
(if (>= (length lst) 3)
  (progn
    (mapcar '(lambda (a b) (set (read a) ((eval b) lst))) '("p1" "cc" "p2") '(car cadr caddr))
    (setq m    (midp p1 p2)
	  vobj (apply
		 'vla-AddDim3PointAngular
		 (vl-list* (vlax-get-property
			     doc
			     (if (= "Model" (getvar "CTAB"))
			       "modelspace"
			       "paperspace"
			       ) ;_ end of if
			     ) ;_ end of vlax-get-property
			   (mapcar '(lambda (p) (vlax-3d-point (trans p 1 0)))
				   (list cc (midp p1 cc) (midp cc p2) (polar m (angle m cc) (* (distance m cc) (if *dimtxtinside* 0.5 1.25 ))))
				   ) ;_ end of mapcar
			   ) ;_ end of vl-list*
		 ) ;_ end of apply
	  ) ;_ end of setq
    
(if  *dimsuppressed* (progn
	((lambda (obj)
    		(mapcar
     		'(lambda (a b) (vlax-put obj a b))
     		'("Arrowhead1Type"	 "Arrowhead2Type"	  "extensionlineextend"	   "extensionlineoffset"
	"TextHeight"		 "VerticalTextPosition"   "TextGap"	"TextInside"
 	"DimLine1Suppress"   "DimLine2Suppress" ;<--- "line" visibility, thanks marko :-)
	"ExtLine1Suppress" "ExtLine2Suppress"
	"TextInsideAlign" "TextOutsideAlign"
	  )
     		(list 19 19 0. 0. sz (if (LM:ListClockwise-p pl) 1 2) sz 1 1 1 1 1 0 0)
    	 	)
    		(vlax-put-property obj 'TextFill :vlax-true)  ;<-- text masked:  1 / 0
    		)
   vobj
	) ;_ end of lambda
	
   (command "_explode"  (vlax-vla-object->ename vobj))
   (setq rot(cdr(assoc 50 (entget(entlast)))))
    (command "_U")
    (vla-put-TextRotation (vlax-ename->vla-object (entlast))
      (MakeReadable(+ rot (* pi 0.5)
	(atan (apply '/ (cdr (reverse (getvar "ucsxdir" ))))))))
      )
    )
  ) ;_ end of progn
) ;_ end of if
  
     ) ;_ end of foreach
     (vla-EndUndoMark doc)
     (vlax-release-object doc)
   ) ;_ end of progn
 ) ;_ end of if
(mapcar 'setvar l var ); EDIT 
 (princ)
) ;_ end of defun

(vl-load-com)
(defun-q-list-set 'hp:doc '(nil (vla-get-ActiveDocument (vlax-get-acad-object)))) ;inspired by LM:acdoc :-)
(princ "\nMultiple DimAngular on polygon. command: anglwp")(princ)


;; coutesy & reference
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
http://www.lee-mac.com/mathematicalfunctions.html
(defun LM:ListClockwise-p ( lst )
   (minusp
       (apply '+
           (mapcar
               (function
                   (lambda ( a b )
                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                   )
               )
               lst (cons (last lst) lst)
           )
       )
   )
)

;; 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))  
 )

Edited December 12, 2014 by hanhphuc
updated v1.1

November 7, 2014

Thanks hanhphuc,

That worked...

I am a bit new to lisp and autocad, if you can please explain me a bit about the code (and the logic behind it) which you have written, it would be of much help and would also help me in writing a few of my own and thereby helping people.

Thanks again

November 7, 2014

Thanks hanhphuc,

That worked...

I am a bit new to lisp and autocad, if you can please explain me a bit about the code (and the logic behind it) which you have written, it would be of much help and would also help me in writing a few of my own and thereby helping people.

Thanks again

im not good explain, dimension was created using activeX method vla-AddDim3PointAngular which refered to developer documentations.

same as manually command requires arguments (in red)

object.AddDimAngular (AngleVertex, FirstEndPoint, SecondEndPoint, TextPoint)

see inside the code :

(list cc (midp p1 cc) (midp cc p2) (polar m (angle m cc) (* (distance m cc) 1.25))) ;

AngleVertex = cc

FirstEndPoint = (midp p1 cc)

SecondEndPoint = (midp cc p2)

TextPoint = (polar m (angle m cc) (* (distance m cc) 1.25)) ;

;note: midp is the sub-function to obtain midpoint of 2 vertex

since you are new i just brief the method:

1.collect the coordinates of lwpolyline's vertex, check closed or not.

2.get the midpoint each leg for FirstEndPoint, SecondEndPoint

3.collect every 3 points AngleVertex , FirstEndPoint , SecondEndPoint respectively

4.using polar to obtain TextPoint

5.repeat the loop using foreach function

when you do manually almost same, the difference is just we need to automate determining every 3-vertex

HTH

November 7, 2014

I know , this is dim ang.

But, is time to rest ,my friend , Don't be too hard !

September 25, 2020

On 11/7/2014 at 7:35 PM, hanhphuc said:

updated v1.1


;Multiple DimAngular method in Visual Lisp
;AngLwp.lsp
;http://www.cadtutor.net/forum/showthread.php?86844-Quick-DimAngular-Whole-Circle-Angle&p=613297&viewfull=1#post613297
;v1.0: 22/06/14 
;v1.1: 10/12/2014
;	*dimsuppressed* dimension suppressed, only dimension text visible
;	*dimtxtinside* dimension text positin inside / outside 
;	*error* localize & optimized
;	text placement works in UCS
;	credits: MakeReadable & LM:ListClockwise-p

; users can adjust global settings to suit their need here ,[color="red"] t / nil[/color]
[color="blue"]
(setq 
*dimsuppressed* [color="red"][b]nil[/b] [/color] ; t= suppressed / [b][u]nil[/u]= normal [/b]
*dimtxtinside* [color="red"][b]t [/b][/color] ; [b][u]t[/u]= acute angle[/b] / nil= obtuse large > 180
)[/color]

(defun c:AngLWP	( / *error* pl lst p1 p2 cc m en l i v doc midp var sz box vobj )  
;hanhphuc 10/12/2014 anglwp.lsp (v1.1)
(setq	l   '("cmdecho" "osmode" )
var  (mapcar 'getvar l) 
sz	(getvar "dimtxt")
lst	 '() ; ** can not omit this
midp	 '((a b / c d) (mapcar '(lambda (c d) (/ (+ c d) 2.)) a b)));_ end of setq
 
 (mapcar 'setvar l '(0 0 ))
 
(defun *error* (msg)
  (if (= 8 (logand 8 (getvar "undoctl")))
    (vla-EndUndoMark (hp:doc))
    ) ;_ end of if
  (if doc
    (vlax-release-object doc)
    ) ;_ end of if
  (if (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")
    (princ (strcat "\nError: " msg))
    ) ;_ end of if
    (mapcar 'setvar l var)
  (princ)
  ) ;_ end of defun
 
 (if (and (setq en (car (entsel "\nPick LWpolyline..")))
   (eq (cdr (assoc 0 (entget en))) "LWPOLYLINE")
   (setq v (cdr (assoc 90 (entget en)))
	 i -1
   ) ;_ end of setq
     ) ;_ end of and
   (progn
     (repeat v (setq pl (cons (vlax-curve-getPointAtParam en (setq i (1+ i))) pl)))
     (if (= (cdr (assoc 70 (entget en))) 1)
(setq pl (append pl (list (car pl) (cadr pl))))
     ) ;_ end of if
     (vla-StartUndoMark (setq doc (hp:doc)))
       (foreach x (mapcar '(lambda (pt) (trans pt 0 1)) pl)
(setq lst (cons x lst))
(if (>= (length lst) 3)
  (progn
    (mapcar '(lambda (a b) (set (read a) ((eval b) lst))) '("p1" "cc" "p2") '(car cadr caddr))
    (setq m    (midp p1 p2)
	  vobj (apply
		 'vla-AddDim3PointAngular
		 (vl-list* (vlax-get-property
			     doc
			     (if (= "Model" (getvar "CTAB"))
			       "modelspace"
			       "paperspace"
			       ) ;_ end of if
			     ) ;_ end of vlax-get-property
			   (mapcar '(lambda (p) (vlax-3d-point (trans p 1 0)))
				   (list cc (midp p1 cc) (midp cc p2) (polar m (angle m cc) (* (distance m cc) (if *dimtxtinside* 0.5 1.25 ))))
				   ) ;_ end of mapcar
			   ) ;_ end of vl-list*
		 ) ;_ end of apply
	  ) ;_ end of setq
    
(if  *dimsuppressed* (progn
	((lambda (obj)
    		(mapcar
     		'(lambda (a b) (vlax-put obj a b))
     		'("Arrowhead1Type"	 "Arrowhead2Type"	  "extensionlineextend"	   "extensionlineoffset"
	"TextHeight"		 "VerticalTextPosition"   "TextGap"	"TextInside"
 	"DimLine1Suppress"   "DimLine2Suppress" ;<--- "line" visibility, thanks marko :-)
	"ExtLine1Suppress" "ExtLine2Suppress"
	"TextInsideAlign" "TextOutsideAlign"
	  )
     		(list 19 19 0. 0. sz (if (LM:ListClockwise-p pl) 1 2) sz 1 1 1 1 1 0 0)
    	 	)
    		(vlax-put-property obj 'TextFill :vlax-true)  ;<-- text masked:  1 / 0
    		)
   vobj
	) ;_ end of lambda
	
   (command "_explode"  (vlax-vla-object->ename vobj))
   (setq rot(cdr(assoc 50 (entget(entlast)))))
    (command "_U")
    (vla-put-TextRotation (vlax-ename->vla-object (entlast))
      (MakeReadable(+ rot (* pi 0.5)
	(atan (apply '/ (cdr (reverse (getvar "ucsxdir" ))))))))
      )
    )
  ) ;_ end of progn
) ;_ end of if
  
     ) ;_ end of foreach
     (vla-EndUndoMark doc)
     (vlax-release-object doc)
   ) ;_ end of progn
 ) ;_ end of if
(mapcar 'setvar l var ); EDIT 
 (princ)
) ;_ end of defun

(vl-load-com)
(defun-q-list-set 'hp:doc '(nil (vla-get-ActiveDocument (vlax-get-acad-object)))) ;inspired by LM:acdoc :-)
(princ "\nMultiple DimAngular on polygon. command: anglwp")(princ)


;; coutesy & reference
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
http://www.lee-mac.com/mathematicalfunctions.html
(defun LM:ListClockwise-p ( lst )
   (minusp
       (apply '+
           (mapcar
               (function
                   (lambda ( a b )
                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                   )
               )
               lst (cons (last lst) lst)
           )
       )
   )
)

;; 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))  
 )

Giờ mới để ý, cách tìm phía nhỏ hơn và lớn hơn của bác rất hay, k phải xét CW như mình vẫn làm ^^

Sign In

Quick DimAngular Whole-Circle-Angle

Recommended Posts

hanhphuc

hanhphuc

hanhphuc

Lee Mac

hanhphuc

hanhphuc

torn_apart

AIberto

hanhphuc

torn_apart

hanhphuc

torn_apart

hanhphuc

torn_apart

hanhphuc

AIberto

ketxu

Join the conversation

Tutorials

Forums

Activity