Jump to content

The direction of view (help)


AIberto

Recommended Posts

Hi all

Have a routine like this?

gif.gif

 

use dialog to choose

[ATTACH]50258[/ATTACH]

 

symbol: A,B,C,D......Z

scale: 1:1.5 ,1:2 ,1:2.5 ,1:3 ,1:4 ,1:5 ,1:10 and 2:1 , 2.5:1 , 4:1 , 5:1 ,10:1

Dir.of rotation: left rotation , right rotation , and rotation

 

example

sy.png

1. symbol "A" , scale"5:1" , "left rotation"

2. symbol "B" , scale "10:1" ,"right rotation"

3. symbol "B" , scale "10:1" , "rotation"

 

The height of rotating symbol (with arrow)= The text height

 

Thanks Alberto

Edited by AIberto
Link to comment
Share on other sites

  • Replies 39
  • Created
  • Last Reply

Top Posters In This Topic

  • AIberto

    24

  • hanhphuc

    14

  • andy_lee

    2

Top Posters In This Topic

Posted Images

Hi I didn't say clear ?

1st, draw arrow lines, specify the direction .

2nd, Place the words and symbols shown in figure 3

Link to comment
Share on other sites

hi rrulep, what is related the 1st gif arrow & the last img?

by dim qleader can't do?

 

step 1: you should help yourself by making an attributed block, then get it saved try insert into dwg

step 2: test function

;hp# 06/08/14
;edit attrib string
(defun eat$ (en l) ; where en is entity name, l = string list 
 (if (and (setq ve (vlax-ename->vla-object en))
   (vlax-get-property ve 'hasAttributes))
   (mapcar ''((a b) (vla-put-textstring a b))
    (vlax-safearray->list (vlax-variant-value (vla-GetAttributes ve)))
   l ;(list symbol scale)
    ) ;_ end of mapcar
   ) ;_ end of if
 (princ)
 ) ; _ end of defun

example:

(eat$ (car(entsel)) '("A" "1:5"))

it should work.

Link to comment
Share on other sites

hi rrulep, what is related the 1st gif arrow & the last img?

by dim qleader can't do?

 

step 1: you should help yourself by making an attributed block, then get it saved try insert into dwg

step 2: test function

;hp# 06/08/14
;edit attrib string
(defun eat$ (en l) ; where en is entity name, l = string list 
 (if (and (setq ve (vlax-ename->vla-object en))
   (vlax-get-property ve 'hasAttributes))
   (mapcar ''((a b) (vla-put-textstring a b))
    (vlax-safearray->list (vlax-variant-value (vla-GetAttributes ve)))
   l ;(list symbol scale)
    ) ;_ end of mapcar
   ) ;_ end of if
 (princ)
 ) ; _ end of defun

example:

(eat$ (car(entsel)) '("A" "1:5"))

it should work.

 

hanhphuc, thanks for reply.

why use attributed block ? I think lisp can do this.

Link to comment
Share on other sites

hi rrulep, what is related the 1st gif arrow & the last img?

by dim qleader can't do?

 

Hi hanhphuc.

This is a complete example.

draw.png

Link to comment
Share on other sites

In order to make the looks beautiful, I think :

Arrowed line length=text height*2 , Size of the arrow=text height

arc radius(with arrow)=text height , Size of the arrow=text height / 2

 

Hope someone can help me.

Link to comment
Share on other sites

hanhphuc, thanks for reply.

why use attributed block ? I think lisp can do this.

 

1. lisp can do many things, using command TEXT also can do easily, which "symbol" over "%%o" "scale"

2. my suggestion making 2 attributed blocks with arc arrow mirror (name it "CW.dwg" for clock-wise & "ACW.dwg" for anti-clockwise),

the reason attrib block you can D.I.Y (customize it to suit your need) without lisp code :)

Link to comment
Share on other sites

use command INSERT & Qleader method, no need complicated coding.

i have finished my part in vanilla coding, without using my old post func: (eat$ e l)

have you made your attributed blocks as i proposed? clockwise: "CW.dwg" & anti-clockwise: "ACW.dwg"

put it in valid support path.

 

Latest Updated v1.2: 31/08/2014

>added dynamic visual arrow

>Draw ARC function to replace INSERT if no attrib block exists in support path or broken path

v1.1: 11/08/2014

;;;v1.2: 31/08/2014
;;;     (hp:pointer pt c nil)
;;;	 (dov:arc ....)
;;;	 (LM:Arc->Bulge ..)
;;;      (sk_mk_arc01 ..)
;;;	  dov:dcl localized

;;v1.1: 11/08/2014
;;;	 inside qleader, setvar sz removed 
;;;	 (setvar var...)
;;;	 "dimtxsty" "textstyle"
;;;	 fixed textsize bug
;;;	 define (dov:MTEXT ...)
;;;	 arrow Alan J Thomas
;;;	 (Trans p .. )
;;;	 Format Mtext Ref: CAB's Strip_Text.lsp CopyRight© 2005-2007
;;;	 *DEF* *SYM* *VSC* *VDR* *TSZ* *dov:run-once*
;;;	 define (dov:dcl)
;;;	 setvar
;;;	 cancel exit
;;;	 redefine (qleader p1 p2 str sz sty ass ) ; associative T/nil, T = normal / nil = by arrow
;;;	 (hp:pt pt os) fixed osnap bug
;;;	 Prompt [option] to active dialog

;;;Reference / courtesy of
;;;Arrow* 	 	 Alan J. Thomas							
;;;Format Mtext* 	 CAB's Strip_Text.lsp CopyRight© 2005-2007			
;;;Dialog style* 	 http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm	
;;;Dialog to temp*	 Inspired by Tharwat & LM					
;;;Undocumented vlax-get Thanx Tharwat & LM						
;;;Quoted lambda* 	 Inspired by Lee Mac defun-q LM:doc
;;;sub: LM:Arc->Bulge 	 Lee Mac	 
;;;sub: sk_mk_arc01	 mjtd's coder (shared by AIberto)
;;;sub: dov:arc		 ditto


(if (and txh (tblsearch "style" "COMPLEX"))
     (progn (mapcar ''((x) (setvar x "COMPLEX")) '("dimtxsty" "textstyle"))
	    (setq txs (entget (tblobjname "style" "COMPLEX")))
	    (entmod (subst (cons 40 txh) (assoc 40 txs) txs))
	    ) ;_ end of progn
     ) ;_ end of if

(setq *DEF*	     '(*SYM* *VSC* *VDR* *TSZ*)
     *dov:run-once* t
     ) ;_ end of setq
(if (vl-some ''((x) (not (eval x))) *DEF*)
 (mapcar 'set *DEF* '("A" "1:1" "Rotation" "1.0"))
 ) ;_ end of if


;http://www.cadtutor.net/forum/showthread.php?88027-The-direction-of-view-(help)

(defun c:DOV (/	p dd *error* dcl dcl_id	key pop	i txh var oldvar pt bp A-Z blk Symbol ViewScale	ViewDir	Textsize txs
	dov:dcl ;<--
      );*dcl_gt*

(defun hp:pt (msg fun os / o p)
 (setq o (getvar "osmode"))
 (setvar "osmode" os)
 (setq p T)
 (while (or (not (listp p)) (= p nil))
   (initget "Options")
   (setq p (getpoint msg))
   (if	(= p "Options")
     (progn (eval fun) (setq p nil))
     ) ;_ end of if
   ) ;_ end of while
 (setvar "osmode" o)
 p
 ) ;_ end of defun

(defun dov:MTEXT (str pt sz)
 (entmakex (mapcar 'cons
	   '(0 100 100 1 10 40 50 7 71 72)
	   (list "MTEXT"
		 "AcDbEntity"
		 "AcDbMText"
		 (strcat "{\\fComplex|b0|i0|c0|p34;" str "}") ;<-- Ref: CAB's Strip_Text.lsp CopyRight© 2005-2007
		 pt
		 sz
		 0.0
		 (getvar "textstyle")
		 5
		 5
		 ) ; _ end of
	   ) ;_ end of mapcar
   ) ;_ end of entmake
 ) ;_ end of defun
 
 (defun qleader (p1 p2 str sz sty ass / p1 p2) ; R1.0 : string ,textsize, textstyle, associative 
   (if	(and p1 p2)
     (if ass

(vl-cmdf "LEADER" p1 p2 "" str "")
(progn

  (vl-cmdf "_.leader" "_non" p1 "_non" p2 "" "" "_N") ;  <----- Arrow : Alan J. Thompson
       (dov:MTEXT str (trans (polar P2 (angle P1 P2) (* txh 1.5)) 1 0) txh)
  ) ;_ end of progn
) ;_ end of if
     ) ;_ end of if
   (redraw)
   ) ;_ end of defun
 
 (setq	dcl    (strcat (getvar "tempprefix") "tmp.dcl")
key    '("Symbol" "ViewScale" "ViewDir" "Textsize")
pop    '((key lst) (start_list key) (mapcar 'add_list lst) (end_list))
i      90
txh    (getvar "textsize") ;<--- default
var    '("cmdecho" "osmode" "dimtxt" "dimasz" "textsize")
oldvar (mapcar 'getvar var)
) ;_ end of setq
 
 (defun *error* (msg)
   (if	(not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     ) ;_ end of if
   (mapcar 'setvar var oldvar)
   (princ)
   ) ;_ end of defun

 
 ('((lst / f)
    (setq f (open dcl "w"))
    (mapcar ''(($) (write-line $ f)) lst)
    (close f)
    (setq f nil)
    )
   (apply 'append
   (list '("DOV:dialog{key =\"Title\";" "label =\"Direction of View\";" "spacer;")
	 (mapcar ''((a b)
		    (strcat		   ":row{fixed_width = true;"		       ":column{width = 20.;"
		     "fixed_width = true;" "spacer;"		 ":text{label = \""    a
		     "\";}}"		   ":popup_list{key = "	 b		       ";"
		     "width = 15.0;}}"	   ""
		     )
		    )
		 '("Symbol number" "ViewScale" "Direction of View" "Text Height")
		 key
		 ) ;_ end of mapcar
	 '("spacer;"			 "        : paragraph{"	       "        : text_part{"
	   "\tlabel =\"hanhphuc 2014 \";"			       "\talignment = right;"
	   "}}"
	   )
	 '("spacer;ok_cancel;}")
	 ) ;_ end of list
   ) ;_ end of apply
   )
 (repeat 26
   (setq A-Z (cons (vl-list->string (list i)) A-Z)
  i   (1- i)
  ) ;_ end of setq
   ) ;_ end of repeat
 (mapcar ''((a b) (set (eval '(read a)) b))
  key
  (list	A-Z
	'("1 : 1" "1 : 1.5" "1 : 2" "1 : 2.5" "1 : 3" "1 : 4" "1 : 5" "1 : 10" "2 : 1" "2.5 : 1" "4 : 1" "5 : 1"
	  "10 : 1") ;<----- you can add more scale here
	'("Rotation" "Left rotation" "Right rotation")
	(list (rtos (getvar "textsize") 2 1) "0.1" "0.2" "0.5" "1.0" "1.5" "2.5" "5.0")  ;<---- you can add more text size here

	) ;_ end of list
  ) ;_ end of mapcar
 
(setq dov:dcl '(nil
	(setq dcl_id (load_dialog dcl))
	(new_dialog "DOV" dcl_id)
	(if
	 *dcl_gt*
	 (mapcar 'set_tile key *dcl_gt*)
	 (mapcar 'set_tile key '("0" "0" "0" "0"))
	 ) ;_ end of if
	(mapcar
	 ''(($) (pop $ (eval (read $))) (action_tile $ (strcat "(get_tile \"" $ "\")")))
	 key
	 ) ;_ end of mapcar
	(action_tile "accept" "(setq *dcl_gt* (mapcar 'get_tile key))(done_dialog 1)")
	(if
	 (zerop (setq dd (start_dialog)))
	 (exit)
	 ) ;_ end of if
	(mapcar
	 ''((a b c) (set (eval 'a) (nth (atoi ((eval b) *dcl_gt*)) (eval (read c)))))
	 *DEF*
	 '(car cadr caddr cadddr)
	 key
	 ) ;_ end of mapcar
	(setq txh (atof *TSZ*)) ;_ end of setq
	)
     ) ;_ end of setq



 
 (if *dov:run-once*
   (dov:dcl)
   ) ;_ end of if
 (while (or (= p nil) (= p "Options"))
   (initget "Options")
   (setq p (getpoint (strcat "\nPick Point or [Options] < Symbol= "
		      *SYM*
		      " | Scale="
		      *VSC*
		      " | "
		      *VDR*
		      " | Height: "
		      (rtos txh)
		      " > ? : "
		      ) ;_ end of strcat
	      ) ;_ end of getpoint
  ) ;_ end of setq
   (if	(= p "Options")
     (progn (dov:dcl) (setq p nil))
     ) ;_ end of if
   ) ;_ end of while
 (if (/= dd 0)
   (progn (if (and txh (tblsearch "style" "COMPLEX"))
     (progn (mapcar ''((x) (setvar x "COMPLEX")) '("dimtxsty" "textstyle"))
	    (setq txs (entget (tblobjname "style" "COMPLEX")))
	    (entmod (subst (cons 40 txh) (assoc 40 txs) txs))
	    ) ;_ end of progn
     ) ;_ end of if
   (mapcar 'setvar var (list 0 47 txh txh txh))


     (if (not (tblsearch "Layer" "dov"))
(vl-cmdf "-Layer" "make" "dov" "c" 3 "" "")
) ;_ end of if

   (setq mtx (dov:MTEXT *SYM* 
	  '(0. 0. 0.)
	  (* 15. (/ (getvar "viewsize") (cadr (getvar "screensize"))))
	  ))
     
   (cond ((= (caddr *dcl_gt*) "1")
	  (setq	ld  (qleader p  (hp:pointer p 2 mtx) *SYM* txh "COMPLEX" nil)
		blk "ACW" arc t ; R1.2
		) ;_ end of setq
	  )
	 ((= (caddr *dcl_gt*) "2")
	  (setq	ld  (qleader p (hp:pointer p 2 mtx) *SYM* txh "COMPLEX" nil) 
		blk "CW"  arc nil ;R1.2
		) ;_ end of setq
	  )
	 ((= (caddr *dcl_gt*) "0")
	  (progn

	    (qleader p (hp:pointer p 2 mtx) *SYM* txh "COMPLEX" nil)

		   (setq arc "" pt (getpoint "\nInsert label.."))

		 ) ;_ end of progn
	  )
	 (t nil);R1.2
	 ) ;_ end of cond

     (if mtx (vla-delete (vlax-ename->vla-object mtx)))
     
   (if

     (and blk (setq pt (getpoint "\nInsert label.."))
	    (setq bp (findfile (strcat blk ".dwg"))))
     
     (vl-cmdf "_INSERT"
	      bp
	      pt ; R1.1
	      txh
	      txh
	      0
	      *SYM*
	      (strcat "%%O" *VSC*)
	      ) ;_ end of vl-cmdf
     
(progn (setq pt (trans pt 1 0))
 
      (dov:MTEXT

 (if (= arc "")
 (strcat *SYM* " Rotation\\P\\O" *VSC*)(strcat *SYM* "\\P\\O" *VSC*))
 
	  (polar pt (atan (apply '/ (cdr (reverse (getvar "ucsxdir"))))) (* txh 4.))
	  txh
	  ) ;_ end of dov:MTEXT
 
      (dov:arc pt txh arc)
      ) ;_ end of progn
     ) ;_ end of if

   ) ;_ end of progn
   (if	(= dd 1)
     (unload_dialog dcl_id)
     ) ;_ end of if
   ) ;_ end of if
 
 (setq *dov:run-once* nil)
 (princ)
 ) ;_ end of defun


;; Arc to Bulge  -  Lee Mac
;; c     - center
;; a1,a2 - start, end angle
;; r     - radius
;; Returns: (<vertex> <bulge> <vertex>)

(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
           (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)

; by mjtd's lisper
(defun sk_mk_arc01 (pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )
 (if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
                 )
   )
 )


; sub-function refer to #15 credit to mjtd's lisper
(defun dov:arc ( pt r ccw? /  l obj ap bp p1 p2 p3 ang1 ang2 bulge )

(if (and pt (not (= ccw? "")))
   (progn (setq l (* 0.5 r))
   (setq obj (vlax-ename->vla-object (sk_mk_arc01 pt r 0 pi nil nil nil nil nil)))

(setq ap    '("StartPoint" "EndPoint")
     bp    (mapcar ''((a b) (set (eval 'a) (vlax-get obj b)))
	    '(p1 p3)
	    (if	ccw?
	      ap
	      (reverse ap)
	      ) ;_ end of if
	    ) ;_ end of mapcar
     
     p2    (vlax-curve-getPointAtDist
      obj
      (if ccw?
	(- (vla-get-arclength obj) l)
	l
	) ;_ end of if
      ) ;_ end of vlax-curve-getPointAtDist
     ang1  (angle pt p2)
     ang2  (if	ccw?
      0
      pi
      ) ;_ end of if
     
     bulge (cadr (LM:Arc->Bulge
	    pt
	    (if	ccw?
	      ang2
	      ang1
	      ) ;_ end of if
	    (if	ccw?
	      ang1
	      ang2
	      ) ;_ end of if
	    r
	    ) ;_ end of LM:Arc->Bulge
	  ) ;_ end of cadr
     ) ;_ end of setq
     
   (vla-delete obj)
   (entmakex (list '(0 . "LWPOLYLINE")
		   '(100 . "AcDbEntity")
		   '(100 . "AcDbPolyline")
		   (cons 90 3)
		   (cons 10 p1)
		   (cons 42
			 (if ccw?
			   bulge
			   (* -1.0 bulge)
			   ) ;_ end of if
			 ) ;_ end of cons
		   (cons 10 p2)
		   (cons 40  (/ l 3.0))
		   (cons 41 0)
		   (cons 10 p3)
		   ) ;_ end of list
	     ) ;_ end of entmakex
   ) ;_ end of progn
   ) ;_ end of if
 (princ)
 ) ;_ end of defun


http://www.theswamp.org/index.php?topic=12813.225
;R1.1: add object
(defun hp:pointer (_pt c obj / p tp l ip vs) ; v1.1
(if obj (setq obj(vlax-ename->vla-object obj)))
 (while (and (= (setq p (car (setq tp (grread t 15 0)))) 5) (setq l (cadr tp)))
   (redraw)
      (grvecs
(apply
 'append
 (mapcar
  ''((x)
     (list
      6
      _pt
      (polar _pt (* pi x)(* 50. (setq vs (/ (getvar "viewsize") (cadr (getvar "screensize"))))))
      )
     )
  '(0.0 0.5 1.0 1.5)
  ) ;_ end of mapcar
 ) ;_ end of apply
) ;_ end of grvecs


 (setq	ip  (osnap l "_nea")
ip  (if	ip
      ip
      l
      ) ;_ end of if

a   (angle _pt ip)
sz  (* 50. vs)
ang (/ pi 6.37)
d   (* sz 0.25)
ep  (polar ip (+ a pi) 0. );(* sz 0.5)
) ;_ end of setq
  (grvecs
    (apply 'append
    (mapcar ''((x) (list c ep x))
	    (list (polar ip a sz ) (polar ep (+ a ang) d) (polar ep (- a ang) d))
	    ) ;_ end of mapcar
    ) ;_ end of apply
    ) ;_ end of grvecs
   
 (if obj 
 (vlax-put obj "InsertionPoint" (trans(polar _pt (angle _pt ip) (+(distance _pt ip) 0.2 sz))1 0)))

   ) ;_ end of while
 
;;;  (redraw)
 ip
 ) ;_ end of defun

http://www.cadtutor.net/forum/member.php?117971-hanhphuc
(princ "\nhanhphuc 2014. Label Direction of View. Command: DOV")
(grtext -1 "DOV.lsp© v1.2 hanhphuc")
(princ)

Edited by hanhphuc
Requested by OP, code updated see comment header
Link to comment
Share on other sites

use command INSERT & Qleader method, no need complicated coding.

i have finished my part in vanilla coding, without using my old post func: (eat$ e l)

have you made your attributed blocks as i proposed? clockwise: "CW.dwg" & anti-clockwise: "ACW.dwg"

put it in valid support path.

 

Hi hanhphuc , You're one in a million.I'm truly grateful for your help.

The attributed blocks must include "Symbol number" & "ViewScale" ???

what's name of the 'tag" ? Can upload a sample?

Link to comment
Share on other sites

Hi hanhphuc , You're one in a million.I'm truly grateful for your help.

The attributed blocks must include "Symbol number" & "ViewScale" ???

what's name of the 'tag" ? Can upload a sample?

 

i'm glad to help meanwhile i can improve my coding.

The Tag can be any name example, upper SYM & lower SCALE

i encourage you to give a try, with scale 1x then customize font style, type, color, without coding :)

CW.png

 

There are many dcl examples to refer here, credit to:

http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm

Link to comment
Share on other sites

i'm glad to help meanwhile i can improve my coding.

The Tag can be any name example, upper SYM & lower SCALE

i encourage you to give a try, with scale 1x then customize font style, type, color, without coding :)

CW.png

 

There are many dcl examples to refer here, credit to:

http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm

 

Thank you ,I made attributed blocks yet. but there is no graphic inserted .

Link to comment
Share on other sites

i'm glad to help meanwhile i can improve my coding.

The Tag can be any name example, upper SYM & lower SCALE

i encourage you to give a try, with scale 1x then customize font style, type, color, without coding :)

CW.png

 

There are many dcl examples to refer here, credit to:

http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm

 

Hi hanhphuc , can use this code to draw arrow arc ? is from leemac. modify by edata.

 

 

;; Arc to Bulge  -  Lee Mac
;; c     - center
;; a1,a2 - start, end angle
;; r     - radius
;; Returns: (<vertex> <bulge> <vertex>)

(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
           (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)
;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
 (if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
                 )
   )
 )
(vl-load-com) 
(defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3)
 (if(and (setq r(getdist "\nRadius:"));; Radius = text height
         (setq pt(getpoint "\nCenter:"));;Placement point
         )
   (progn
     (setq l(* 0.5 r))
     (setq w(/ l 3.0))
     (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
     (setq obj(vlax-ename->vla-object en))
     (setq arc_len(vla-get-arclength obj))
     (setq p1(vlax-curve-getstartpoint obj))
     (setq p2(vlax-curve-getPointAtDist obj (- arc_len l)))
     (setq p3(vlax-curve-getEndpoint obj))      
     (setq ang1(angle pt p2 ))
     (setq ang2 0)
     (setq bulge(cadr(LM:Arc->Bulge pt ang2 ang1 r)))
     (vla-delete obj)      
     (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 bulge)
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                      
                     (cons 10 p3)))
     )
   )
 (princ)
 )

Edited by AIberto
Link to comment
Share on other sites

Hi hanhphuc , can use this code to draw arrow arc ?

Maybe you not fully understand the concept?

I told you no need code for making attrib block.

1.draw arc using command: ARC

2.draw arrow command: DIMARC

explode it then remove one side arrow

3.make 2 attrib Tag, align nicely

4.save drawing as CW.dwg or ACW.dwg

5.put in valid support folder

Then load the lisp, run.

 

As you can see Lee Mac's codes drawing arc already has such long code, i still light years to achieve his level :)

That's why my concept is simple just by INSERTing attrib block

 

My code still has bugs, but I'll fix it soon.

Link to comment
Share on other sites

As you can see Lee Mac's codes drawing arc already has such long code, i still light years to achieve his level :)

That's why my concept is simple just by INSERTing attrib block

My code still has bugs, but I'll fix it soon.

 

Hi hanhphuc ,Thanks for reply! lee's code Has been modified , only input "Radius" and pick “insertion point” , the Radius = text height.

Link to comment
Share on other sites

As you can see Lee Mac's codes drawing arc already has such long code, i still light years to achieve his level :)

That's why my concept is simple just by INSERTing attrib block

My code still has bugs, but I'll fix it soon.

 

Hi , hanhphuc, This more perfect, can choose direction of arrow(Left or right)modifyed by edata (@mjtd.com)

 

;; Arc to Bulge  -  Lee Mac
;; c     - center
;; a1,a2 - start, end angle
;; r     - radius
;; Returns: (<vertex> <bulge> <vertex>)

(defun LM:Arc->Bulge ( c a1 a2 r )
   (list
       (polar c a1 r)
       (   (lambda ( a ) (/ (sin a) (cos a)))
           (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
       )
       (polar c a2 r)
   )
)

;;(sk_mk_arc01 pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw)
(defun sk_mk_arc01(pt r ang1 ang2 l_lay l_col l_lt l_lts l_lw )
 (if(and pt r ang1 ang2)
   (entmakex (list '(0 . "ARC")
                   (cons 8 (if l_lay l_lay (getvar 'clayer)))
                   (if l_col (cons 62 l_col)(cons 62 256))
                   (if l_lt (cons 6 l_lt)(cons 6 "bylayer"))
                   (cons 48 (if l_lts l_lts (getvar 'celtscale)))
                   (if l_lw (cons 370 l_lw)(cons 370 0))
                   (cons 10 pt)
                   (cons 40 r)
                   (cons 50 ang1)
                   (cons 51 ang2)
                   )
                 )
   )
 )

(defun c:tt(/  ANG1 ARC_LEN EN L OBJ P1 P2 PT R W ANG2 BULGE P3 keys)
 (or *sk_rad_jt001* (setq *sk_rad_jt001* 10.0))
 (setq *sk_rad_jt001*(cond((getdist (strcat "\nRadius<" (rtos *sk_rad_jt001* 2 4) ">:")))(*sk_rad_jt001*)))
 (princ (strcat "\rCurrent Radius<" (rtos *sk_rad_jt001* 2 4) ">:"))
 (if(setq pt(getpoint "\nCenter:"))
   (progn
     (setq r *sk_rad_jt001*)
     (initget "L R _l r")      
     (setq keys(cond((getkword "\rDirection of arrow[L/R]<L>: "))("l")))
     (setq l(* 0.5 r))
     (setq w(/ l 3.0))
     (setq en(sk_mk_arc01 pt r 0 pi nil nil nil nil nil))
     (setq obj(vlax-ename->vla-object en))
     (setq arc_len(vla-get-arclength obj))
     (setq p1(if (= keys "l") (vlax-curve-getstartpoint obj) (vlax-curve-getEndpoint obj)))
     (setq p2(vlax-curve-getPointAtDist obj (if (= keys "l") (- arc_len l) l)))
     (setq p3(if (= keys "l") (vlax-curve-getEndpoint obj)(vlax-curve-getstartpoint obj) ))      
     (setq ang1(angle pt p2 ))
     (setq ang2 (if (= keys "l") 0 pi ))
     (setq bulge(cadr(LM:Arc->Bulge pt (if (= keys "l") ang2 ang1 ) (if (= keys "l") ang1 ang2 ) r)))
     (vla-delete obj)      
     (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 3)
                     (cons 10 p1)
                     (cons 42 (if (= keys "l") bulge (* -1.0 bulge) ))
                     (cons 10 p2)
                     (cons 40 w)
                     (cons 41 0)                      
                     (cons 10 p3)))
     )
   )
 (princ)
 )

Link to comment
Share on other sites

please try download this sample, the arc by command no lisp at all.

ACW.dwg

AC.dwg

save it in support path.

i appreciate Lee Mac's codes cool always be good resources, i'll learn step by step i'm not going to leap before i can walk stable :)

Link to comment
Share on other sites

please try download this sample, the arc by command no lisp at all.

ACW.dwg

AC.dwg

save it in support path.

i appreciate Lee Mac's codes cool always be good resources, i'll learn step by step i'm not going to leap before i can walk stable :)

 

BTW.I Can't download the dwg file ,  Why don't you upload this forum?

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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...