Jump to content
prodromosm

Out Angle lisp--> help with the code

Recommended Posts

prodromosm

Hi. I am using this code to dimension the out angles of a polyline.Is it possible to update the code to work for polylines and lines? Now work only for polylines. If i have two lines i can not dimension the out angle.

 

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

(setq 
*dimsuppressed*  ; t= suppressed nil = normal
*dimtxtinside* ; t acute angle nil= obtuse large > 180
)

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

Thanks

1.JPG

Share this post


Link to post
Share on other sites
BIGAL

You will need to write a new selection method, something like a window 1st cnr implies the side of the angle, as its a small box can uses ssget "F" and look at what is crossed is it a pline or 2 lines.

 

image.png.ff2a041449b490b073b5d7bfa2f51e69.png

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...