« previous next »
Pages: [1] |   Go Down

Author Topic: mark many radius at middle point of arc at once  (Read 2998 times)

0 Members and 1 Guest are viewing this topic.

meja

  • Newt
  • Posts: 47
mark many radius at middle point of arc at once
« on: May 23, 2015, 10:02:57 PM »
I have a code like this below
Code - Auto/Visual Lisp: [Select]
  1. (defun c:darp (/ oldos ent obj elst plst blst p par pd i pt ssl)
  3. (setq oldos (getvar "osmode"))
  4. (setvar "osmode" 0)
  5. (setq ent (car (entsel "\n SELECT arc in lwpolyline "))
  6.         obj (vlax-ename->vla-object ent)
  7.         elst (entget ent)
  8.         plst (list)
  9.         blst (list)
  10. )
  11. (foreach a elst
  12.         (if (= (car a) 10)
  13.         (setq plst (append plst (list (cdr a))))
  14.         )
  15.         (if (= (car a) 42)
  16.         (setq blst (append blst (list (cdr a))))
  17.         )
  18. )
  19. (setq i 0)
  20. (foreach b blst
  21.         (if (not (equal b 0 0.000001))
  22.         (progn
  23.                 (setq p (nth i plst)
  24.                           par (vlax-curve-getparamatpoint obj p)
  25.                           pd (vlax-curve-getpointatparam obj (+ par 0.5))
  26.                 )
  27.                 (command "undo" "be")
  28.                 (setq ssl  (acet-explode ent))
  29.                 (setq pt (cdr (assoc 10 (entget (ssname ssl i)))))
  30.                 (command "undo" "e")
  31.                 (command "undo" 1)
  32.                 (command "dimradius" pd (list (/ (+ (car pt) (car pd)) 2) (/ (+ (cadr pt)
  33.  
  34. (cadr pd)) 2)))
  35.         )
  36.         )
  37.         (setq i (1+ i))
  38. )
  39. (setvar "osmode" oldos)
  41. )
  42.  

NOW.i want to mark many arcs at once in my landscape job
HOW CAN REPEAT FUNCTION DO IT?
« Last Edit: May 23, 2015, 10:52:05 PM by meja »
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: mark many radius at middle point of arc at once
« Reply #1 on: May 24, 2015, 06:09:57 AM »
Please try the following program:
Code - Auto/Visual Lisp: [Select]
  1. ;; Automatic Radial Dimensions  -  Lee Mac
  2. ;; Automatically generates radial dimensions for a selection of arcs & polylines with arc segments.
  3.  
  4. (defun c:dimrads ( / dimrad midang ent enx idx sel )
  5.  
  6.     (defun dimrad ( cen chd )
  7.         (eval
  8.             (list 'defun 'dimrad '( cen chd )
  9.                 (list 'vla-adddimradial
  11.                         (if (= 1 (getvar 'cvport))
  12.                             'paperspace
  13.                             'modelspace
  14.                         )
  15.                     )
  16.                    '(vlax-3D-point cen)
  17.                    '(vlax-3D-point chd)
  18.                    '(/ (distance cen chd) -2.0)
  19.                 )
  20.             )
  21.         )
  22.         (dimrad cen chd)
  23.     )
  24.  
  25.     (defun midang ( a1 a2 )
  26.         (if (< a2 a1) (midang a1 (+ a2 pi pi)) (/ (+ a1 a2) 2.0))
  27.     )
  28.  
  29.     (if
  30.         (setq sel
  31.             (ssget
  32.                '(   (-4 . "<OR")
  33.                         (0 . "ARC")
  34.                         (-4 . "<AND")
  35.                             (0 . "LWPOLYLINE")
  36.                             (-4 . "<>")
  37.                             (42 . 0.0)
  38.                         (-4 . "AND>")
  39.                     (-4 . "OR>")
  40.                 )
  41.             )
  42.         )
  43.         (repeat (setq idx (sslength sel))
  44.             (setq ent (ssname sel (setq idx (1- idx)))
  45.                   enx (entget ent)
  46.             )
  47.             (if (= "ARC" (cdr (assoc 0 enx)))
  48.                 (dimrad
  49.                     (trans (cdr (assoc 10 enx)) ent 0)
  50.                     (trans
  51.                         (polar
  52.                             (cdr (assoc 10 enx))
  53.                             (midang (cdr (assoc 50 enx)) (cdr (assoc 51 enx)))
  54.                             (cdr (assoc 40 enx))
  55.                         )
  56.                         ent 0
  57.                     )
  58.                 )
  59.                 (   (lambda ( lst )
  60.                         (mapcar
  61.                            '(lambda ( x y / b c p q r )
  62.                                 (if (not (equal 0.0 (setq b (cdr (assoc 42 x))) 1e-8))
  63.                                     (progn
  64.                                         (setq p (cdr (assoc 10 x))
  65.                                               q (cdr (assoc 10 y))
  66.                                               r (/ (* (distance p q) (1+ (* b b))) 4 b)
  67.                                               c (polar p (+ (angle p q) (- (/ pi 2) (* 2 (atan b)))) r)
  68.                                         )
  69.                                         (dimrad
  70.                                             (trans c ent 0)
  71.                                             (trans (polar c (midang (angle c p) (angle c q)) r) ent 0)
  72.                                         )
  73.                                     )
  74.                                 )
  75.                             )
  76.                             lst
  77.                             (if (= 1 (logand 1 (cdr (assoc 70 enx))))
  78.                                 (append (cdr lst) (list (car lst)))
  79.                                 (cdr lst)
  80.                             )
  81.                         )
  82.                     )
  83.                     (LM:lwvertices enx)
  84.                 )
  85.             )
  86.         )
  87.     )
  88.     (princ)
  89. )
  90.  
  91. ;; LW Vertices  -  Lee Mac
  92. ;; Returns a list of lists in which each sublist describes
  93. ;; the position, starting width, ending width and bulge of the
  94. ;; vertex of a supplied LWPolyline
  95.  
  96. (defun LM:lwvertices ( e )
  97.     (if (setq e (member (assoc 10 e) e))
  98.         (cons
  99.             (list
  100.                 (assoc 10 e)
  101.                 (assoc 40 e)
  102.                 (assoc 41 e)
  103.                 (assoc 42 e)
  104.             )
  105.             (LM:lwvertices (cdr e))
  106.         )
  107.     )
  108. )
  109.  
Logged

meja

  • Newt
  • Posts: 47
Re: mark many radius at middle point of arc at once
« Reply #2 on: May 24, 2015, 12:06:15 PM »
THX LEE,MY BIG SAINT OF LISP 8-)

I MODIFY CODE LIKE THIS
Code - Auto/Visual Lisp: [Select]
  1. (defun c:DRO  ()
  2.  
  3. &#65288;setvar "DIMTIX" 1&#65289; (setvar "DIMSOXD"     1)
  4.  
  5.  (setvar "DIMTMOVE"    1)  (setvar "DIMATFIT"     0)
  6.  
  7.  (setvar "DIMTOFL"     0)
  8.  
  9. (setvar "DIMTAD" 1)
  10.  
  11. (setq objEnt (entsel "\n Select a arc... "))
  12.      
  13. (setq pt (osnap (cadr objEnt) "_midp"))
  14.  
  15.  
  16. (command "dimradius" pt "" )
  17.  
  18.  (princ)
  19.  
  20. )

how to repeat?

It is hard to newbie
« Last Edit: May 25, 2015, 01:48:48 AM by meja »
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: mark many radius at middle point of arc at once
« Reply #3 on: May 24, 2015, 12:33:31 PM »
You're welcome! It was fun to write  :-)
Logged

meja

  • Newt
  • Posts: 47
Re: mark many radius at middle point of arc at once
« Reply #4 on: May 25, 2015, 09:23:57 PM »
LEE.another question , I hope dimstyle like the rightest dimradius? How to change the code you write?
PLS
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: mark many radius at middle point of arc at once
« Reply #5 on: May 26, 2015, 01:02:51 PM »
Quote from: meja on May 25, 2015, 09:23:57 PM
LEE.another question , I hope dimstyle like the rightest dimradius? How to change the code you write?
PLS

Change:
Code - Auto/Visual Lisp: [Select]
  1. (/ (distance cen chd) -2.0)
to:
Code - Auto/Visual Lisp: [Select]
  1. (/ (distance cen chd) 2.0)
Logged
Pages: [1] |   Go Up
« previous next »