Topic: how can i keep settings

[PKENEWELL]

If your code use while loop,how can I use ESC end loop?

With any of our LISP codes, You don't have to press the ESC key, you just press the Enter key to end the loop. They are not the same as the "*" character in a button macro forcing a repeat until you escape out.

[PKENEWELL]

Hi,I just want to change setting and loop dimcenter.

but use lisp can not like "*^C^C_dimcenter "  use on “circle” “arc” “circle or arc on block” and loop.

FWIW: I wrote a short program to replicate the DIMCENTER command. If this doesn't give you what you want I don't know what will:

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ i cpt dc el ent vals vars _Entsel *error* _MCS-to-WCS p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 rad)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    (defun _MCS-to-WCS (pt mx)
17.       (list
18.          (+
19.             (* (car (car   mx)) (car   pt))
20.             (* (car (cadr  mx)) (cadr  pt))
21.             (* (car (caddr mx)) (caddr pt))
22.             (car (cadddr mx))
23.          )
24.          (+
25.             (* (cadr (car   mx)) (car   pt))
26.             (* (cadr (cadr  mx)) (cadr  pt))
27.             (* (cadr (caddr mx)) (caddr pt))
28.             (cadr (cadddr mx))
29.          )
30.          (+
31.             (* (caddr (car   mx)) (car   pt))
32.             (* (caddr (cadr  mx)) (cadr  pt))
33.             (* (caddr (caddr mx)) (caddr pt))
34.             (caddr (cadddr mx))
35.          )
36.       )
37.    )
38.    
39.    (command "._Undo" "_BEgin")
40.  
41.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
42.          vals  (mapcar 'getvar vars)
43.    )
44.  
45.    (setvar "cmdecho" 0)
46.  
47.    (if (= (tblsearch "ltype" "center") nil)
48.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
49.    )
50.    
51.    (mapcar 'setvar (cdr vars) '("1" "CENTER" -2))
52.  
53.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
54.       (if (wcmatch (cdr (assoc 0 (setq el (entget (car ent))))) "ARC,CIRCLE")
55.          (progn
56.             (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
57.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
58.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
59.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
60.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
61.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
62.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
63.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
64.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
65.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
66.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
67.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
68.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
69.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
70.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
71.             )
72.             (command "._line" "_non" p1 "_non" p2 "")
73.             (command "._line" "_non" p3 "_non" p4 "")
74.             (if (> (getvar "dimcen") 0)
75.                (progn
76.                   (command "._line" "_non" p5 "_non" p9 "")
77.                   (command "._line" "_non" p6 "_non" p10 "")
78.                   (command "._line" "_non" p7 "_non" p11 "")
79.                   (command "._line" "_non" p8 "_non" p12 "")
80.                )
81.             )
82.          )
83.          (princ (strcat "\nInvalid object " (cdr (assoc 0 el)) " Selected. Select an ARC or CIRCLE."))
84.       )
85.    )
86.  
87.    (mapcar 'setvar vars vals)
88.    (command "._Undo" "_End")
89.    (princ)
90. )
91.  

[masao]

Hi,I just want to change setting and loop dimcenter.

but use lisp can not like "*^C^C_dimcenter "  use on “circle” “arc” “circle or arc on block” and loop.

FWIW: I wrote a short program to replicate the DIMCENTER command. If this doesn't give you what you want I don't know what will:

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ i cpt dc el ent vals vars _Entsel *error* _MCS-to-WCS p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 rad)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    (defun _MCS-to-WCS (pt mx)
17.       (list
18.          (+
19.             (* (car (car   mx)) (car   pt))
20.             (* (car (cadr  mx)) (cadr  pt))
21.             (* (car (caddr mx)) (caddr pt))
22.             (car (cadddr mx))
23.          )
24.          (+
25.             (* (cadr (car   mx)) (car   pt))
26.             (* (cadr (cadr  mx)) (cadr  pt))
27.             (* (cadr (caddr mx)) (caddr pt))
28.             (cadr (cadddr mx))
29.          )
30.          (+
31.             (* (caddr (car   mx)) (car   pt))
32.             (* (caddr (cadr  mx)) (cadr  pt))
33.             (* (caddr (caddr mx)) (caddr pt))
34.             (caddr (cadddr mx))
35.          )
36.       )
37.    )
38.    
39.    (command "._Undo" "_BEgin")
40.  
41.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
42.          vals  (mapcar 'getvar vars)
43.    )
44.  
45.    (setvar "cmdecho" 0)
46.  
47.    (if (= (tblsearch "ltype" "center") nil)
48.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
49.    )
50.    
51.    (mapcar 'setvar (cdr vars) '("1" "CENTER" -2))
52.  
53.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
54.       (if (wcmatch (cdr (assoc 0 (setq el (entget (car ent))))) "ARC,CIRCLE")
55.          (progn
56.             (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
57.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
58.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
59.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
60.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
61.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
62.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
63.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
64.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
65.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
66.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
67.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
68.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
69.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
70.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
71.             )
72.             (command "._line" "_non" p1 "_non" p2 "")
73.             (command "._line" "_non" p3 "_non" p4 "")
74.             (if (> (getvar "dimcen") 0)
75.                (progn
76.                   (command "._line" "_non" p5 "_non" p9 "")
77.                   (command "._line" "_non" p6 "_non" p10 "")
78.                   (command "._line" "_non" p7 "_non" p11 "")
79.                   (command "._line" "_non" p8 "_non" p12 "")
80.                )
81.             )
82.          )
83.          (princ (strcat "\nInvalid object " (cdr (assoc 0 el)) " Selected. Select an ARC or CIRCLE."))
84.       )
85.    )
86.  
87.    (mapcar 'setvar vars vals)
88.    (command "._Undo" "_End")
89.    (princ)
90. )
91.  

Hi,i have some question.

use your code can fix to get polyline arc center point?  like dimcenter.

[PKENEWELL]

Hi,i have some question.

use your code can fix to get polyline arc center point?  like dimcenter.

Try This:

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ *error* cpt dc el ent ep ept _Entsel i _MCS-to-WCS npt obj p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 sp spt vals vars)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    (defun _MCS-to-WCS (pt mx)
17.       (list
18.          (+
19.             (* (car (car   mx)) (car   pt))
20.             (* (car (cadr  mx)) (cadr  pt))
21.             (* (car (caddr mx)) (caddr pt))
22.             (car (cadddr mx))
23.          )
24.          (+
25.             (* (cadr (car   mx)) (car   pt))
26.             (* (cadr (cadr  mx)) (cadr  pt))
27.             (* (cadr (caddr mx)) (caddr pt))
28.             (cadr (cadddr mx))
29.          )
30.          (+
31.             (* (caddr (car   mx)) (car   pt))
32.             (* (caddr (cadr  mx)) (cadr  pt))
33.             (* (caddr (caddr mx)) (caddr pt))
34.             (caddr (cadddr mx))
35.          )
36.       )
37.    )
38.    
39.    (command "._Undo" "_BEgin")
40.  
41.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
42.          vals  (mapcar 'getvar vars)
43.    )
44.  
45.    (setvar "cmdecho" 0)
46.  
47.    (if (= (tblsearch "ltype" "center") nil)
48.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
49.    )
50.    
51.    (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
52.  
53.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
54.       (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
55.       (cond
56.          ((wcmatch enm "ARC,CIRCLE")
57.             (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
58.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
59.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
60.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
61.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
62.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
63.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
64.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
65.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
66.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
67.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
68.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
69.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
70.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
71.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
72.             )
73.             (command "._line" "_non" p1 "_non" p2 "")
74.             (command "._line" "_non" p3 "_non" p4 "")
75.             (if (> (getvar "dimcen") 0)
76.                (progn
77.                   (command "._line" "_non" p5 "_non" p9 "")
78.                   (command "._line" "_non" p6 "_non" p10 "")
79.                   (command "._line" "_non" p7 "_non" p11 "")
80.                   (command "._line" "_non" p8 "_non" p12 "")
81.                )
82.             )
83.          )
84.          ((= enm "LWPOLYLINE")
85.             (setq obj (vlax-ename->vla-object (car ent))
86.                   npt (vlax-curve-getClosestPointTo obj (cadr ent))
87.                   ep  (fix (vlax-curve-getEndParam obj))
88.             )
89.                 (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
90.                 (setq sp  (1- sp))
91.                 (setq ep  (1+ sp))
92.                 )
93.             (setq spt (vlax-curve-getPointAtParam obj sp)
94.                   ept (vlax-curve-getPointAtParam obj ep)
95.             )
96.             (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 0.0001)))
97.                (setq el (cdr (member (Assoc 10 el) el)))
98.             )
99.             (setq bu  (cdr (assoc 42 el))
100.                   ang (* 2.0 (atan bu))
101.                   rad (/ (distance spt ept) (* 2.0 (sin ang)))
102.                   ;; Not sure whay below is not working to get center point.
103.                   ;; cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
104.                   ;; Hack to get the center point from the selected point on the poyline.
105.                   cpt (osnap npt "cen")
106.                   rad (abs rad)
107.                   dc  (abs (getvar "dimcen"))
108.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
109.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
110.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
111.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
112.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
113.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
114.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
115.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
116.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
117.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
118.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
119.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
120.             )
121.             (command "._line" "_non" p1 "_non" p2 "")
122.             (command "._line" "_non" p3 "_non" p4 "")
123.             (if (> (getvar "dimcen") 0)
124.                (progn
125.                   (command "._line" "_non" p5 "_non" p9 "")
126.                   (command "._line" "_non" p6 "_non" p10 "")
127.                   (command "._line" "_non" p7 "_non" p11 "")
128.                   (command "._line" "_non" p8 "_non" p12 "")
129.                )
130.             )
131.          )
132.          (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
133.       )
134.    )
135.    (mapcar 'setvar vars vals)
136.    (command "._Undo" "_End")
137.    (princ)
138. )
139.  

[masao]

i study it. https://www.afralisp.net/autolisp/tutorials/polyline-bulges-part-2.php (i try this if POLYLINE Segment "block" can't get center point too.)

but i don't know how to fix it with your old code.

i use your new code fix,but POLYLINE Segment "block" can't get center point.

sorry,i change to  chinese.

Code: [Select]

(defun c:CTR (/ *error*  i cpt dc el ent vals vars _Entsel _StartUndo _EndUndo doc _MCS-to-WCS p1 p2 p3 p4 rad cens lttype censc_list cendd cenlt censc npt ep sp ept spt bu)
   
   (defun *error* (msg)
      (mapcar 'setvar vars vals)
      (princ msg)
   )
 
   (defun _Nentsel (pr / ent)
      (setvar "errno" 0)
        (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
                (princ "\n->未選取，請再點選圓或弧:")
        )
        ent
   )
 
   (defun _MCS-to-WCS (pt mx)
      (list
         (+
            (* (car (car   mx)) (car   pt))
            (* (car (cadr  mx)) (cadr  pt))
            (* (car (caddr mx)) (caddr pt))
            (car (cadddr mx))
         )
         (+
            (* (cadr (car   mx)) (car   pt))
            (* (cadr (cadr  mx)) (cadr  pt))
            (* (cadr (caddr mx)) (caddr pt))
            (cadr (cadddr mx))
         )
         (+
            (* (caddr (car   mx)) (car   pt))
            (* (caddr (cadr  mx)) (cadr  pt))
            (* (caddr (caddr mx)) (caddr pt))
            (caddr (cadddr mx))
         )
      )
   )
   
(defun _StartUndo ( doc ) (_EndUndo doc)
  (vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
  (if (= 8 (logand 8 (getvar 'UNDOCTL)))
    (vla-EndUndoMark doc)
  )
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 
   (setq vars '("cmdecho" "CELTSCALE" "cecolor" "celtype" "osmode")
         vals  (mapcar 'getvar vars)
   )

   (_StartUndo doc)
 
   (setvar "cmdecho" 0)

   (setq cens (getvar "CELTSCALE"))
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   )
   (setq lttype (cdr (assoc 49 (tblsearch "ltype" "CENTER"))))

   (if (or (= lttype 31.75) (= lttype 19.05) (= lttype 63.5))

   (setq censc_list 50.8)

   (setq censc_list (/ 50.8 25.4))

   )

   (mapcar 'setvar (cddr vars) '("1" "CENTER" 0))
 
   (while (setq ent (_Nentsel "\n->請點選圓或弧或<退出>:"))
      (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
      (cond
         ((wcmatch enm "ARC,CIRCLE")
          (if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))
            (progn
            (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
            (if (car (car (caddr ent))) (setq rad (* (cdr (assoc 40 el)) (car (car (caddr ent))) ))
            (setq rad (cdr (assoc 40 el))) )
            (setq dc (/ (* rad 2) 20)
                  cendd (+ rad dc)
                  cenlt (getvar "LTSCALE")
                  censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
                  p1  (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
                  p3  (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
            )

            (setvar "CELTSCALE" censc)

            (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
            (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
           
            (setvar "CELTSCALE" cens)

           );progn

          (princ "\n->選取的物件不是圓或弧或聚合線弧。")

          );if

         )

         ((= enm "LWPOLYLINE")
            (setq obj (vlax-ename->vla-object (car ent))
                  npt (vlax-curve-getClosestPointTo obj (cadr ent))
                  ep  (fix (vlax-curve-getEndParam obj))
            )
                (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
                (setq sp  (1- sp))
                (setq ep  (1+ sp))
                )
            (setq spt (vlax-curve-getPointAtParam obj sp)
                  ept (vlax-curve-getPointAtParam obj ep)
            )
            (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 0.0001)))
               (setq el (cdr (member (Assoc 10 el) el)))
            )

            (setq bu  (cdr (assoc 42 el)))

            (if (or (/= bu 0) (> bu 0))

            (progn

            (setq ang (* 2.0 (atan bu))
                  rad (/ (distance spt ept) (* 2.0 (sin ang)))
                  ;; Not sure whay below is not working to get center point.
                  ;; cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
                  ;; Hack to get the center point from the selected point on the poyline.
                  cpt (osnap npt "cen")
                  rad (abs rad)
                  dc  (/ (* rad 2) 20)
                  cendd (+ rad dc)
                  cenlt (getvar "LTSCALE")
                  censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
                  p1  (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
                  p3  (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
            )

            (setvar "CELTSCALE" censc)

            (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
            (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
           
            (setvar "CELTSCALE" cens)

           );progn

          (princ "\n->選取的物件不是圓或弧或聚合線弧。")
         
          );if

         )

         (T (princ "\n->選取的物件不是圓或弧或聚合線弧。"))

   );cond

);while

   (mapcar 'setvar vars vals)
   (_EndUndo doc)
   (princ)
)

[PKENEWELL]

i use your new code fix,but POLYLINE Segment "block" can't get center point.

I figured it out! Although this has become allot of code. I spent way too much time on this. I found out I had 2 mistakes:

1) I should have moved the entity list pointer 1 more time before getting the Bulge, that's why the math didn't work, I was getting the bulge for the segment before the one needed, and

2) In order for it to work in a block, you have to translate the point selected on the object from the UCS to the RCS (reference coordinate system), to find the segment point. For this I included a genius function made by another Swamp member - gile - that does the trick! I also had to translate the center point back to the WCS to properly place the centermark.

See updated code - sorry i did not use your code but used my original, so you will have to translate it again:

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ *error* cpt dc el ent ep ept _Entsel i _TransNested npt obj p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 sp spt vals vars)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    ;|   Description:
17.         TransNested (original code by gile on TheSwamp.org)
18.         Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
19.         reference (xref or block) whatever its nested level-
20.    |;
21.    (defun _TransNested (pt rlst from to / geom mxm mxv RefGeom RevRefGeom trp vxv)
22.  
23.       ;; RefGeom (gile)
24.       ;; Returns: a list which first item is a 3x3 transformation matrix (rotation,
25.       ;;          scales, normal) and second item the object insertion point in its parent
26.       ;;          (xref, bloc or space)
27.       ;; Argument : an ename
28.       (defun RefGeom (ename / elst ang norm mat)
29.          (setq elst (entget ename)
30.               ang  (cdr (assoc 50 elst))
31.               norm (cdr (assoc 210 elst))
32.          )
33.          (list
34.             (setq mat
35.               (mxm
36.                  (mapcar (function (lambda (v) (trans v 0 norm T)))
37.                          '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
38.                  )
39.                  (mxm
40.                     (list (list (cos ang) (- (sin ang)) 0.0)
41.                             (list (sin ang) (cos ang) 0.0)
42.                             '(0.0 0.0 1.0)
43.                     )
44.                     (list (list (cdr (assoc 41 elst)) 0.0 0.0)
45.                                (list 0.0 (cdr (assoc 42 elst)) 0.0)
46.                                (list 0.0 0.0 (cdr (assoc 43 elst)))
47.                     )
48.                  )
49.                )
50.             )
51.             (mapcar
52.                '-
53.                (trans (cdr (assoc 10 elst)) norm 0)
54.                (mxv mat
55.                  (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
56.                )
57.             )
58.          )
59.       )
60.  
61.       ;; RevRefGeom (gile)
62.       ;; RefGeom inverse function
63.       (defun RevRefGeom (ename / entData ang norm mat)
64.          (setq  entData (entget ename)
65.               ang         (- (cdr (assoc 50 entData)))
66.               norm    (cdr (assoc 210 entData))
67.          )
68.          (list
69.             (setq mat
70.               (mxm
71.                  (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
72.                             (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
73.                          (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
74.                  )
75.                  (mxm
76.                     (list (list (cos ang) (- (sin ang)) 0.0)
77.                             (list (sin ang) (cos ang) 0.0)
78.                             '(0.0 0.0 1.0)
79.                     )
80.                     (mapcar (function (lambda (v) (trans v norm 0 T)))
81.                             '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
82.                     )
83.                  )
84.                )
85.             )
86.             (mapcar '-
87.               (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
88.               (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
89.             )
90.          )
91.       )
92.  
93.       ;;; VXV Returns the dot product of 2 vectors
94.       (defun vxv (v1 v2)
95.          (apply '+ (mapcar '* v1 v2))
96.       )
97.  
98.       ;; TRP Transpose a matrix -Doug Wilson-
99.       (defun trp (m)
100.          (apply 'mapcar (cons 'list m))
101.       )
102.  
103.       ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
104.       (defun mxv (m v)
105.          (mapcar '(lambda (r) (vxv r v)) m)
106.       )
107.  
108.       ;; MXM Multiply two matrices -Vladimir Nesterovsky-
109.       (defun mxm (m q)
110.          (mapcar '(lambda (r) (mxv (trp q) r)) m)
111.       )
112.  
113.       ;; Main Function.
114.       (and (= 1 from) (setq pt   (trans pt 1 0)))
115.       (and (= 2 to)   (setq rlst (reverse rlst)))
116.       (and (or (= 2 from) (= 2 to))
117.          (while rlst
118.               (setq geom (if (= 2 to)(RevRefGeom (car rlst))(RefGeom (car rlst)))
119.                     rlst (cdr rlst)
120.                     pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
121.            )
122.          )
123.       )
124.       (if (= 1 to)(trans pt 0 1) pt)
125.    ) ;; End Function (_TransNested)
126.  
127.    
128.    (command "._Undo" "_BEgin")
129.  
130.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
131.          vals  (mapcar 'getvar vars)
132.    )
133.  
134.    (setvar "cmdecho" 0)
135.  
136.    (if (= (tblsearch "ltype" "center") nil)
137.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
138.    )
139.    
140.    (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
141.  
142.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
143.       (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
144.       (cond
145.          ((wcmatch enm "ARC,CIRCLE")
146.             (if (> (length ent) 2)
147.                (setq cpt (_TransNested (cdr (assoc 10 el)) (last ent) 2 1))
148.                (setq cpt (cdr (assoc 10 el)))
149.             )
150.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
151.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
152.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
153.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
154.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
155.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
156.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
157.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
158.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
159.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
160.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
161.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
162.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
163.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
164.             )
165.             (command "._line" "_non" p1 "_non" p2 "")
166.             (command "._line" "_non" p3 "_non" p4 "")
167.             (if (> (getvar "dimcen") 0)
168.                (progn
169.                   (command "._line" "_non" p5 "_non" p9 "")
170.                   (command "._line" "_non" p6 "_non" p10 "")
171.                   (command "._line" "_non" p7 "_non" p11 "")
172.                   (command "._line" "_non" p8 "_non" p12 "")
173.                )
174.             )
175.          )
176.          ((= enm "LWPOLYLINE")
177.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
178.             (setq obj (vlax-ename->vla-object (car ent))
179.                   npt (if (> (length ent) 2)
180.                          (vlax-curve-getClosestPointTo obj (_TransNested (cadr ent) (last ent) 1 2))
181.                          (vlax-curve-getClosestPointTo obj (cadr ent))
182.                       )
183.                   ep  (fix (vlax-curve-getEndParam obj))
184.             )
185.                 (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
186.                 (setq sp  (1- sp))
187.                 (setq ep  (1+ sp))
188.                 )
189.             (setq spt (vlax-curve-getPointAtParam obj sp)
190.                   ept (vlax-curve-getPointAtParam obj ep)
191.             )
192.             (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 1e-6)))
193.                (setq el (cdr (member (Assoc 10 el) el)))
194.             )
195.             (setq el (cdr (member (Assoc 10 el) el)))
196.             (if (not (equal (setq bu (cdr (assoc 42 el))) 0.0 1e-6))
197.                (progn
198.                   (setq ang (* 2.0 (atan bu))
199.                         rad (/ (distance spt ept) (* 2.0 (sin ang)))
200.                         cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
201.                         cpt (if (> (length ent) 2)(_TransNested cpt (last ent) 2 1) cpt)
202.                         rad (abs rad)
203.                         dc  (abs (getvar "dimcen"))
204.                         p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
205.                         p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
206.                         p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
207.                         p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
208.                         p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
209.                         p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
210.                         p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
211.                         p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
212.                         p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
213.                         p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
214.                         p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
215.                         p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
216.                   )
217.                   (command "._line" "_non" p1 "_non" p2 "")
218.                   (command "._line" "_non" p3 "_non" p4 "")
219.                   (if (> (getvar "dimcen") 0)
220.                      (progn
221.                         (command "._line" "_non" p5 "_non" p9 "")
222.                         (command "._line" "_non" p6 "_non" p10 "")
223.                         (command "._line" "_non" p7 "_non" p11 "")
224.                         (command "._line" "_non" p8 "_non" p12 "")
225.                      )
226.                   )
227.                )
228.             )
229.          )
230.          (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
231.       )
232.    )
233.    (mapcar 'setvar vars vals)
234.    (command "._Undo" "_End")
235.    (princ)
236. )
237.  

[masao]

i use your new code fix,but POLYLINE Segment "block" can't get center point.

I figured it out! Although this has become allot of code. I spent way too much time on this. I found out I had 2 mistakes:

1) I should have moved the entity list pointer 1 more time before getting the Bulge, that's why the math didn't work, I was getting the bulge for the segment before the one needed, and

2) In order for it to work in a block, you have to translate the point selected on the object from the UCS to the RCS (reference coordinate system), to find the segment point. For this I included a genius function made by another Swamp member - gile - that does the trick! I also had to translate the center point back to the WCS to properly place the centermark.

See updated code - sorry i did not use your code but used my original, so you will have to translate it again:

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ *error* cpt dc el ent ep ept _Entsel i _MCS-to-WCS _TransNested npt obj p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 sp spt vals vars)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    (defun _MCS-to-WCS (pt mx)
17.       (list
18.          (+
19.             (* (car (car   mx)) (car   pt))
20.             (* (car (cadr  mx)) (cadr  pt))
21.             (* (car (caddr mx)) (caddr pt))
22.             (car (cadddr mx))
23.          )
24.          (+
25.             (* (cadr (car   mx)) (car   pt))
26.             (* (cadr (cadr  mx)) (cadr  pt))
27.             (* (cadr (caddr mx)) (caddr pt))
28.             (cadr (cadddr mx))
29.          )
30.          (+
31.             (* (caddr (car   mx)) (car   pt))
32.             (* (caddr (cadr  mx)) (cadr  pt))
33.             (* (caddr (caddr mx)) (caddr pt))
34.             (caddr (cadddr mx))
35.          )
36.       )
37.    )
38.  
39.    ;|   Description:
40.         TransNested (original code by gile on TheSwamp.org)
41.         Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
42.         reference (xref or block) whatever its nested level-
43.    |;
44.    (defun _TransNested (pt rlst from to / geom mxm mxv RefGeom RevRefGeom trp vxv)
45.  
46.       ;; RefGeom (gile)
47.       ;; Returns: a list which first item is a 3x3 transformation matrix (rotation,
48.       ;;          scales, normal) and second item the object insertion point in its parent
49.       ;;          (xref, bloc or space)
50.       ;; Argument : an ename
51.       (defun RefGeom (ename / elst ang norm mat)
52.          (setq elst (entget ename)
53.               ang  (cdr (assoc 50 elst))
54.               norm (cdr (assoc 210 elst))
55.          )
56.          (list
57.             (setq mat
58.               (mxm
59.                  (mapcar (function (lambda (v) (trans v 0 norm T)))
60.                          '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
61.                  )
62.                  (mxm
63.                     (list (list (cos ang) (- (sin ang)) 0.0)
64.                             (list (sin ang) (cos ang) 0.0)
65.                             '(0.0 0.0 1.0)
66.                     )
67.                     (list (list (cdr (assoc 41 elst)) 0.0 0.0)
68.                                (list 0.0 (cdr (assoc 42 elst)) 0.0)
69.                                (list 0.0 0.0 (cdr (assoc 43 elst)))
70.                     )
71.                  )
72.                )
73.             )
74.             (mapcar
75.                '-
76.                (trans (cdr (assoc 10 elst)) norm 0)
77.                (mxv mat
78.                  (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
79.                )
80.             )
81.          )
82.       )
83.  
84.       ;; RevRefGeom (gile)
85.       ;; RefGeom inverse function
86.       (defun RevRefGeom (ename / entData ang norm mat)
87.          (setq  entData (entget ename)
88.               ang         (- (cdr (assoc 50 entData)))
89.               norm    (cdr (assoc 210 entData))
90.          )
91.          (list
92.             (setq mat
93.               (mxm
94.                  (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
95.                             (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
96.                          (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
97.                  )
98.                  (mxm
99.                     (list (list (cos ang) (- (sin ang)) 0.0)
100.                             (list (sin ang) (cos ang) 0.0)
101.                             '(0.0 0.0 1.0)
102.                     )
103.                     (mapcar (function (lambda (v) (trans v norm 0 T)))
104.                             '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
105.                     )
106.                  )
107.                )
108.             )
109.             (mapcar '-
110.               (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
111.               (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
112.             )
113.          )
114.       )
115.  
116.       ;;; VXV Returns the dot product of 2 vectors
117.       (defun vxv (v1 v2)
118.          (apply '+ (mapcar '* v1 v2))
119.       )
120.  
121.       ;; TRP Transpose a matrix -Doug Wilson-
122.       (defun trp (m)
123.          (apply 'mapcar (cons 'list m))
124.       )
125.  
126.       ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
127.       (defun mxv (m v)
128.          (mapcar '(lambda (r) (vxv r v)) m)
129.       )
130.  
131.       ;; MXM Multiply two matrices -Vladimir Nesterovsky-
132.       (defun mxm (m q)
133.          (mapcar '(lambda (r) (mxv (trp q) r)) m)
134.       )
135.  
136.       ;; Main Function.
137.       (and (= 1 from) (setq pt   (trans pt 1 0)))
138.       (and (= 2 to)   (setq rlst (reverse rlst)))
139.       (and (or (= 2 from) (= 2 to))
140.          (while rlst
141.               (setq geom (if (= 2 to)(RevRefGeom (car rlst))(RefGeom (car rlst)))
142.                     rlst (cdr rlst)
143.                     pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
144.            )
145.          )
146.       )
147.       (if (= 1 to)(trans pt 0 1) pt)
148.    ) ;; End Function (_TransNested)
149.  
150.    
151.    (command "._Undo" "_BEgin")
152.  
153.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
154.          vals  (mapcar 'getvar vars)
155.    )
156.  
157.    (setvar "cmdecho" 0)
158.  
159.    (if (= (tblsearch "ltype" "center") nil)
160.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
161.    )
162.    
163.    (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
164.  
165.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
166.       (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
167.       (cond
168.          ((wcmatch enm "ARC,CIRCLE")
169.             (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
170.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
171.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
172.                   p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
173.                   p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
174.                   p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
175.                   p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
176.                   p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
177.                   p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
178.                   p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
179.                   p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
180.                   p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
181.                   p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
182.                   p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
183.                   p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
184.             )
185.             (command "._line" "_non" p1 "_non" p2 "")
186.             (command "._line" "_non" p3 "_non" p4 "")
187.             (if (> (getvar "dimcen") 0)
188.                (progn
189.                   (command "._line" "_non" p5 "_non" p9 "")
190.                   (command "._line" "_non" p6 "_non" p10 "")
191.                   (command "._line" "_non" p7 "_non" p11 "")
192.                   (command "._line" "_non" p8 "_non" p12 "")
193.                )
194.             )
195.          )
196.          ((= enm "LWPOLYLINE")
197.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
198.             (setq obj (vlax-ename->vla-object (car ent))
199.                   npt (if (> (length ent) 2)
200.                          (vlax-curve-getClosestPointTo obj (_TransNested (cadr ent) (last ent) 1 2))
201.                          (vlax-curve-getClosestPointTo obj (cadr ent))
202.                        )
203.                   ep  (fix (vlax-curve-getEndParam obj))
204.             )
205.                 (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
206.                 (setq sp  (1- sp))
207.                 (setq ep  (1+ sp))
208.                 )
209.             (setq spt (vlax-curve-getPointAtParam obj sp)
210.                   ept (vlax-curve-getPointAtParam obj ep)
211.             )
212.             (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 1e-6)))
213.                (setq el (cdr (member (Assoc 10 el) el)))
214.             )
215.             (setq el (cdr (member (Assoc 10 el) el)))
216.             (if (not (equal (setq bu (cdr (assoc 42 el))) 0.0 1e-6))
217.                (progn
218.                   (setq ang (* 2.0 (atan bu))
219.                         rad (/ (distance spt ept) (* 2.0 (sin ang)))
220.                         cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
221.                         cpt (if (> (length ent) 2)(_MCS-to-WCS cpt (caddr ent)) cpt)
222.                         rad (abs rad)
223.                         dc  (abs (getvar "dimcen"))
224.                         p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
225.                         p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
226.                         p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
227.                         p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
228.                         p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
229.                         p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
230.                         p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
231.                         p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
232.                         p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
233.                         p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
234.                         p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
235.                         p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
236.                   )
237.                   (command "._line" "_non" p1 "_non" p2 "")
238.                   (command "._line" "_non" p3 "_non" p4 "")
239.                   (if (> (getvar "dimcen") 0)
240.                      (progn
241.                         (command "._line" "_non" p5 "_non" p9 "")
242.                         (command "._line" "_non" p6 "_non" p10 "")
243.                         (command "._line" "_non" p7 "_non" p11 "")
244.                         (command "._line" "_non" p8 "_non" p12 "")
245.                      )
246.                   )
247.                )
248.             )
249.          )
250.          (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
251.       )
252.    )
253.    (mapcar 'setvar vars vals)
254.    (command "._Undo" "_End")
255.    (princ)
256. )
257.  

It's ok. thanks you so much.

[It's Alive!]

That’s like a lot of work, just sayin

Code - Python: [Select]

1. def PyRxCmd_doit():
2.     try:
3.         es = Ed.Editor.entSel("\nSelect: ", Db.Polyline.desc())
4.         if es[0] != Ed.PromptStatus.eOk:
5.             raise Exception("oof", es)
6.         pline = Db.Polyline(es[1])
7.         compositeCurve = pline.getAcGeCurve()
8.         for curve in compositeCurve.getCurveList():
9.             if curve.type() != Ge.EntityId.kCircArc3d:
10.                 continue
11.             circArc = Ge.CircArc3d.cast(curve)
12.             Ed.Core.grDrawCircle(circArc.center(), 1, 24,1)
13.     except Exception as err:
14.         traceback.print_exception(err)
15.  

[PKENEWELL]

That’s like a lot of work, just sayin

Code - Python: [Select]

1. def PyRxCmd_doit():
2.     try:
3.         es = Ed.Editor.entSel("\nSelect: ", Db.Polyline.desc())
4.         if es[0] != Ed.PromptStatus.eOk:
5.             raise Exception("oof", es)
6.         pline = Db.Polyline(es[1])
7.         compositeCurve = pline.getAcGeCurve()
8.         for curve in compositeCurve.getCurveList():
9.             if curve.type() != Ge.EntityId.kCircArc3d:
10.                 continue
11.             circArc = Ge.CircArc3d.cast(curve)
12.             Ed.Core.grDrawCircle(circArc.center(), 1, 24,1)
13.     except Exception as err:
14.         traceback.print_exception(err)
15.  

I appreciate the efficiency of the Python code. It is much easier to address Polylines. However, your code doesn't address items nested in blocks that the OP additionally asked for. That why the code is so extensive; to translate from the UCS to the Block RCS and back again.

[PKENEWELL]

It's ok. thanks you so much.

Your welcome. I hope you can learn from it. I am still trying to learn from it myself. Gile's code and matrix transformation is an area i'm weak in and still learning myself after many years of doing this.   

[PKENEWELL]

FYI - I realized I also had a redundant function since gile's code can translate coordinates both ways, so I eliminated the secondary function I had to translate the RCS back to the UCS. I updated my previous post. I doesn't shorten the code much, but removes and extra defined function. 

[masao]

hi~i found some bug.

if block rotate has error.

circle and LWPOLYLINE has same bug.

CIRCLE i fix easier than LWPOLYLINE,is not angle question.

but LWPOLYLINE i dont know how to fix.

Code: [Select]

(defun c:CTR (/ *error*  i cpt dc el ent vals vars _Entsel _StartUndo _EndUndo doc _MCS-to-WCS p1 p2 p3 p4 rad cens lttype censc_list cendd cenlt censc npt ep sp ept spt bu)
   
   (defun *error* (msg)
      (_EndUndo doc)
      (mapcar 'setvar vars vals)
      (princ msg)
   )
 
   (defun _Nentsel (pr / ent)
      (setvar "errno" 0)
        (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
                (princ "\n->select circle:")
        )
        ent
   )
 
   (defun _MCS-to-WCS (pt mx)
      (list
         (+
            (* (car (car   mx)) (car   pt))
            (* (car (cadr  mx)) (cadr  pt))
            (* (car (caddr mx)) (caddr pt))
            (car (cadddr mx))
         )
         (+
            (* (cadr (car   mx)) (car   pt))
            (* (cadr (cadr  mx)) (cadr  pt))
            (* (cadr (caddr mx)) (caddr pt))
            (cadr (cadddr mx))
         )
         (+
            (* (caddr (car   mx)) (car   pt))
            (* (caddr (cadr  mx)) (cadr  pt))
            (* (caddr (caddr mx)) (caddr pt))
            (caddr (cadddr mx))
         )
      )
   )
 
   ;|   Description:
        TransNested (original code by gile on TheSwamp.org)
        Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
        reference (xref or block) whatever its nested level-
   |;
   (defun _TransNested (pt rlst from to / geom mxm mxv RefGeom RevRefGeom trp vxv)
 
      ;; RefGeom (gile)
      ;; Returns: a list which first item is a 3x3 transformation matrix (rotation,
      ;;          scales, normal) and second item the object insertion point in its parent
      ;;          (xref, bloc or space)
      ;; Argument : an ename
      (defun RefGeom (ename / elst ang norm mat)
         (setq elst (entget ename)
              ang  (cdr (assoc 50 elst))
              norm (cdr (assoc 210 elst))
         )
         (list
            (setq mat
              (mxm
                 (mapcar (function (lambda (v) (trans v 0 norm T)))
                         '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
                 )
                 (mxm
                    (list (list (cos ang) (- (sin ang)) 0.0)
                            (list (sin ang) (cos ang) 0.0)
                            '(0.0 0.0 1.0)
                    )
                    (list (list (cdr (assoc 41 elst)) 0.0 0.0)
                               (list 0.0 (cdr (assoc 42 elst)) 0.0)
                               (list 0.0 0.0 (cdr (assoc 43 elst)))
                    )
                 )
               )
            )
            (mapcar
               '-
               (trans (cdr (assoc 10 elst)) norm 0)
               (mxv mat
                 (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
               )
            )
         )
      )
 
      ;; RevRefGeom (gile)
      ;; RefGeom inverse function
      (defun RevRefGeom (ename / entData ang norm mat)
         (setq  entData (entget ename)
              ang         (- (cdr (assoc 50 entData)))
              norm    (cdr (assoc 210 entData))
         )
         (list
            (setq mat
              (mxm
                 (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
                            (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
                         (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
                 )
                 (mxm
                    (list (list (cos ang) (- (sin ang)) 0.0)
                            (list (sin ang) (cos ang) 0.0)
                            '(0.0 0.0 1.0)
                    )
                    (mapcar (function (lambda (v) (trans v norm 0 T)))
                            '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
                    )
                 )
               )
            )
            (mapcar '-
              (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
              (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
            )
         )
      )
 
      ;;; VXV Returns the dot product of 2 vectors
      (defun vxv (v1 v2)
         (apply '+ (mapcar '* v1 v2))
      )
 
      ;; TRP Transpose a matrix -Doug Wilson-
      (defun trp (m)
         (apply 'mapcar (cons 'list m))
      )
 
      ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
      (defun mxv (m v)
         (mapcar '(lambda (r) (vxv r v)) m)
      )
 
      ;; MXM Multiply two matrices -Vladimir Nesterovsky-
      (defun mxm (m q)
         (mapcar '(lambda (r) (mxv (trp q) r)) m)
      )
 
      ;; Main Function.
      (and (= 1 from) (setq pt   (trans pt 1 0)))
      (and (= 2 to)   (setq rlst (reverse rlst)))
      (and (or (= 2 from) (= 2 to))
         (while rlst
              (setq geom (if (= 2 to)(RevRefGeom (car rlst))(RefGeom (car rlst)))
                    rlst (cdr rlst)
                    pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
           )
         )
      )
      (if (= 1 to)(trans pt 0 1) pt)
   ) ;; End Function (_TransNested)
 
   
(defun _StartUndo ( doc ) (_EndUndo doc)
  (vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
  (if (= 8 (logand 8 (getvar 'UNDOCTL)))
    (vla-EndUndoMark doc)
  )
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 
   (setq vars '("cmdecho" "CELTSCALE" "cecolor" "celtype" "osmode")
         vals  (mapcar 'getvar vars)
   )

   (setq cens (getvar "CELTSCALE"))

   (setvar "cmdecho" 0)

   (_StartUndo doc)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   )
   (setq lttype (cdr (assoc 49 (tblsearch "ltype" "CENTER"))))

   (if (or (= lttype 31.75) (= lttype 19.05) (= lttype 63.5))

   (setq censc_list 50.8)

   (setq censc_list (/ 50.8 25.4))

   )

   (mapcar 'setvar (cddr vars) '("1" "CENTER" 0))
 
   (while (setq ent (_Nentsel "\n->select circle:"))
      (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))

      (cond

         ((wcmatch enm "ARC,CIRCLE")

          [color=red](if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))

            (progn
            (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (cons (cons 0.0 (cons 0.0 (list 1.0))) (cons (cons 0.0 (cons (cdr (assoc 42 (entget (car (cadddr ent))))) (list 0.0))) (cons (cons (cdr (assoc 41 (entget (car (cadddr ent))))) (list 0.0 0.0)) (list (cadddr (caddr ent))) ))) ))(setq cpt (cdr (assoc 10 el))))
            (if (and (car (car (caddr ent))) (and (= (cdr (assoc 41 (entget (car (cadddr ent))))) (cdr (assoc 42 (entget (car (cadddr ent))))) ) (= (cdr (assoc 41 (entget (car (reverse (cadddr ent)))))) (cdr (assoc 42 (entget (car (reverse (cadddr ent)))))) ) ));and
            (progn
            (if (> (length (cadddr ent)) 1)
            (setq rad (* (cdr (assoc 40 el)) (cdr (assoc 41 (entget (car (cadddr ent))))) (cdr (assoc 41 (entget (car (reverse (cadddr ent)))))) ))
            (setq rad (* (cdr (assoc 40 el)) (cdr (assoc 41 (entget (car (cadddr ent))))) ))
            );if
            );progn[/color]
            (setq rad (cdr (assoc 40 el)))
            );if
            (setq dc (/ (* rad 2) 20)
                  cendd (+ rad dc)
                  cenlt (getvar "LTSCALE")
                  censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
                  p1  (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
                  p3  (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
            )

            (setvar "CELTSCALE" censc)

            (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
            (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
           
            (setvar "CELTSCALE" cens)

           );progn

          (princ "\n->not circle。")

          );if

         )

         ((= enm "LWPOLYLINE")

          (if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))

           (progn

            (setq obj (vlax-ename->vla-object (car ent))
                  npt (if (> (length ent) 2)
                         (vlax-curve-getClosestPointTo obj (_TransNested (cadr ent) (last ent) 1 2))
                         (vlax-curve-getClosestPointTo obj (cadr ent))
                       )
                  ep  (fix (vlax-curve-getEndParam obj))
            )
                (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
                (setq sp  (1- sp))
                (setq ep  (1+ sp))
                )
            (setq spt (vlax-curve-getPointAtParam obj sp)
                  ept (vlax-curve-getPointAtParam obj ep)
            )
            (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 1e-6)))
               (setq el (cdr (member (Assoc 10 el) el)))
            )
            (setq el (cdr (member (Assoc 10 el) el)))
            (if (not (equal (setq bu (cdr (assoc 42 el))) 0.0 1e-6))
               (progn
                  (setq ang (* 2.0 (atan bu))
                        rad (/ (distance spt ept) (* 2.0 (sin ang)))
                        cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
                        cpt (if (> (length ent) 2)(_MCS-to-WCS cpt (caddr ent)) cpt)
                  )

                  (if (car (car (caddr ent))) (setq rad (* (abs rad) (car (car (caddr ent))) ))
                        (setq rad (abs rad)) );if

                  (setq dc  (/ (* rad 2) 20)
                        cendd (+ rad dc)
                        cenlt (getvar "LTSCALE")
                        censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
                        p1  (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
                        p2  (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
                        p3  (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
                        p4  (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
            )

            (setvar "CELTSCALE" censc)

            (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
            (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
           
            (setvar "CELTSCALE" cens)

               );progn

               (princ "\n->not circle。")

            );if

               );progn

               (princ "\n->not circle。")

            );if

         )

         (T (princ "\n->not circle。"))

      );cond

   );while

   (mapcar 'setvar vars vals)
   (_EndUndo doc)
   (princ)
)
or has code can fix XY scacle?

[PKENEWELL]

OK - This will work for scaled and rotated blocks. However - I cannot say entirely whether it will work with nested blocks within blocks in all cases. I tested it with 1 nest level and it worked, but I wouldn't push it further with multiple scales, etc.

EDIT: I tried to add some code for nested blocks with different scales and it seems to work. However, the rotation will always be taken from the top level block. I am not sure yet how to handle multiple rotations.

Code - Auto/Visual Lisp: [Select]

1. (defun c:DCEN (/ *error* cpt dc el ent ep ept _Entsel i _TransNested npt obj p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 sp spt vals vars)
2.    
3.    (defun *error* (msg)
4.       (mapcar 'setvar vars vals)
5.       (princ msg)
6.    )
7.  
8.    (defun _Nentsel (pr / ent)
9.       (setvar "errno" 0)
10.         (while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
11.                 (princ "\nNo Object Selected. Try Again...\n")
12.         )
13.         ent
14.    )
15.  
16.    ;|   Description:
17.         TransNested (original code by gile on TheSwamp.org)
18.         Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
19.         reference (xref or block) whatever its nested level-
20.    |;
21.    (defun _TransNested (pt rlst from to / geom mxm mxv RefGeom RevRefGeom trp vxv)
22.  
23.       ;; RefGeom (gile)
24.       ;; Returns: a list which first item is a 3x3 transformation matrix (rotation,
25.       ;;          scales, normal) and second item the object insertion point in its parent
26.       ;;          (xref, bloc or space)
27.       ;; Argument : an ename
28.       (defun RefGeom (ename / elst ang norm mat)
29.          (setq elst (entget ename)
30.               ang  (cdr (assoc 50 elst))
31.               norm (cdr (assoc 210 elst))
32.          )
33.          (list
34.             (setq mat
35.               (mxm
36.                  (mapcar (function (lambda (v) (trans v 0 norm T)))
37.                          '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
38.                  )
39.                  (mxm
40.                     (list (list (cos ang) (- (sin ang)) 0.0)
41.                             (list (sin ang) (cos ang) 0.0)
42.                             '(0.0 0.0 1.0)
43.                     )
44.                     (list (list (cdr (assoc 41 elst)) 0.0 0.0)
45.                                (list 0.0 (cdr (assoc 42 elst)) 0.0)
46.                                (list 0.0 0.0 (cdr (assoc 43 elst)))
47.                     )
48.                  )
49.                )
50.             )
51.             (mapcar
52.                '-
53.                (trans (cdr (assoc 10 elst)) norm 0)
54.                (mxv mat
55.                  (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
56.                )
57.             )
58.          )
59.       )
60.  
61.       ;; RevRefGeom (gile)
62.       ;; RefGeom inverse function
63.       (defun RevRefGeom (ename / entData ang norm mat)
64.          (setq  entData (entget ename)
65.               ang         (- (cdr (assoc 50 entData)))
66.               norm    (cdr (assoc 210 entData))
67.          )
68.          (list
69.             (setq mat
70.               (mxm
71.                  (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
72.                             (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
73.                          (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
74.                  )
75.                  (mxm
76.                     (list (list (cos ang) (- (sin ang)) 0.0)
77.                             (list (sin ang) (cos ang) 0.0)
78.                             '(0.0 0.0 1.0)
79.                     )
80.                     (mapcar (function (lambda (v) (trans v norm 0 T)))
81.                             '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
82.                     )
83.                  )
84.                )
85.             )
86.             (mapcar '-
87.               (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
88.               (mxv mat (trans (cdr (assoc 10 entData)) norm 0))
89.             )
90.          )
91.       )
92.  
93.       ;;; VXV Returns the dot product of 2 vectors
94.       (defun vxv (v1 v2)
95.          (apply '+ (mapcar '* v1 v2))
96.       )
97.  
98.       ;; TRP Transpose a matrix -Doug Wilson-
99.       (defun trp (m)
100.          (apply 'mapcar (cons 'list m))
101.       )
102.  
103.       ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
104.       (defun mxv (m v)
105.          (mapcar '(lambda (r) (vxv r v)) m)
106.       )
107.  
108.       ;; MXM Multiply two matrices -Vladimir Nesterovsky-
109.       (defun mxm (m q)
110.          (mapcar '(lambda (r) (mxv (trp q) r)) m)
111.       )
112.  
113.       ;; Main Function.
114.       (and (= 1 from) (setq pt   (trans pt 1 0)))
115.       (and (= 2 to)   (setq rlst (reverse rlst)))
116.       (and (or (= 2 from) (= 2 to))
117.          (while rlst
118.               (setq geom (if (= 2 to)(RevRefGeom (car rlst))(RefGeom (car rlst)))
119.                     rlst (cdr rlst)
120.                     pt   (mapcar '+ (mxv (car geom) pt) (cadr geom))
121.            )
122.          )
123.       )
124.       (if (= 1 to)(trans pt 0 1) pt)
125.    ) ;; End Function (_TransNested)
126.  
127.    
128.    (command "._Undo" "_BEgin")
129.  
130.    (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
131.          vals  (mapcar 'getvar vars)
132.    )
133.  
134.    (setvar "cmdecho" 0)
135.  
136.    (if (= (tblsearch "ltype" "center") nil)
137.      (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
138.    )
139.    
140.    (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
141.  
142.    (while (setq ent (_Nentsel "\nSelect Circles or Arcs / PolyArcs: "))
143.       (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
144.       (if (> (length ent) 2)
145.          (if (= (type (last ent)) 'LIST)
146.             (setq xscl (apply '* (mapcar '(lambda (x)(cdr (assoc 41 (entget x)))) (last ent)))
147.                   yscl (apply '* (mapcar '(lambda (x)(cdr (assoc 42 (entget x)))) (last ent)))
148.                   brot (cdr (assoc 50 (entget (last (last ent)))))
149.             )
150.             (setq xscl (cdr (assoc 41 (entget (last ent))))
151.                   yscl (cdr (assoc 42 (entget (last ent))))
152.                   brot (cdr (assoc 50 (entget (last ent))))
153.            
154.             )
155.          )
156.          (setq xscl 1.0 yscl 1.0 brot 0.0)
157.       )
158.       (cond
159.          ((wcmatch enm "ARC,CIRCLE")
160.             (if (> (length ent) 2)
161.                (setq cpt (_TransNested (cdr (assoc 10 el)) (last ent) 2 1))
162.                (setq cpt (cdr (assoc 10 el)))
163.             )
164.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
165.             (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
166.                   p1  (polar cpt (+ brot (/ pi 2)) dc)
167.                   p2  (polar cpt (+ brot (* pi 1.5)) dc)
168.                   p3  (polar cpt brot dc)
169.                   p4  (polar cpt (+ brot pi) dc)
170.                   p5  (polar cpt (+ brot (/ pi 2)) (+ (* rad yscl) dc))
171.                   p6  (polar cpt (+ brot (* pi 1.5)) (+ (* rad yscl) dc))
172.                   p7  (polar cpt brot (+ (* rad xscl) dc))
173.                   p8  (polar cpt (+ brot pi) (+ (* rad xscl) dc))
174.                   p9  (polar cpt (+ brot (/ pi 2)) (* 2 dc))
175.                   p10 (polar cpt (+ brot (* pi 1.5)) (* 2 dc))
176.                   p11 (polar cpt brot (* 2 dc))
177.                   p12 (polar cpt (+ brot pi) (* 2 dc))
178.             )
179.             (command "._line" "_non" p1 "_non" p2 "")
180.             (command "._line" "_non" p3 "_non" p4 "")
181.             (if (> (getvar "dimcen") 0)
182.                (progn
183.                   (command "._line" "_non" p5 "_non" p9 "")
184.                   (command "._line" "_non" p6 "_non" p10 "")
185.                   (command "._line" "_non" p7 "_non" p11 "")
186.                   (command "._line" "_non" p8 "_non" p12 "")
187.                )
188.             )
189.          )
190.          ((= enm "LWPOLYLINE")
191.             (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
192.             (setq obj (vlax-ename->vla-object (car ent))
193.                   npt (if (> (length ent) 2)
194.                          (vlax-curve-getClosestPointTo obj (_TransNested (cadr ent) (last ent) 1 2))
195.                          (vlax-curve-getClosestPointTo obj (cadr ent))
196.                       )
197.                   ep  (fix (vlax-curve-getEndParam obj))
198.             )
199.                 (if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
200.                 (setq sp  (1- sp))
201.                 (setq ep  (1+ sp))
202.                 )
203.             (setq spt (vlax-curve-getPointAtParam obj sp)
204.                   ept (vlax-curve-getPointAtParam obj ep)
205.             )
206.             (while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 1e-6)))
207.                (setq el (cdr (member (Assoc 10 el) el)))
208.             )
209.             (setq el (cdr (member (Assoc 10 el) el)))
210.             (if (not (equal (setq bu (cdr (assoc 42 el))) 0.0 1e-6))
211.                (progn
212.                   (setq ang (* 2.0 (atan bu))
213.                         rad (/ (distance spt ept) (* 2.0 (sin ang)))
214.                         cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
215.                         cpt (if (> (length ent) 2)(_TransNested cpt (last ent) 2 1) cpt)
216.                         rad (abs rad)
217.                         dc  (abs (getvar "dimcen"))
218.                         p1  (polar cpt (+ brot (/ pi 2)) dc)
219.                         p2  (polar cpt (+ brot (* pi 1.5)) dc)
220.                         p3  (polar cpt brot dc)
221.                         p4  (polar cpt (+ brot pi) dc)
222.                         p5  (polar cpt (+ brot (/ pi 2)) (+ (* rad yscl) dc))
223.                         p6  (polar cpt (+ brot (* pi 1.5)) (+ (* rad yscl) dc))
224.                         p7  (polar cpt brot (+ (* rad xscl) dc))
225.                         p8  (polar cpt (+ brot pi) (+ (* rad xscl) dc))
226.                         p9  (polar cpt (+ brot (/ pi 2)) (* 2 dc))
227.                         p10 (polar cpt (+ brot (* pi 1.5)) (* 2 dc))
228.                         p11 (polar cpt brot (* 2 dc))
229.                         p12 (polar cpt (+ brot pi) (* 2 dc))
230.                   )
231.                   (command "._line" "_non" p1 "_non" p2 "")
232.                   (command "._line" "_non" p3 "_non" p4 "")
233.                   (if (> (getvar "dimcen") 0)
234.                      (progn
235.                         (command "._line" "_non" p5 "_non" p9 "")
236.                         (command "._line" "_non" p6 "_non" p10 "")
237.                         (command "._line" "_non" p7 "_non" p11 "")
238.                         (command "._line" "_non" p8 "_non" p12 "")
239.                      )
240.                   )
241.                )
242.             )
243.          )
244.          (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
245.       )
246.    )
247.    (mapcar 'setvar vars vals)
248.    (command "._Undo" "_End")
249.    (princ)
250. )
251.  

[masao]

thanks you so much.

i test it,but { "dimcen" >0 or <0 } and { "dimcen" set different } is same result (i don't know why "dimcen" <0 enter to "if" too).
 
this code get scale circle center point is ok.

if draw line point + ang get different result with cad's dce.


if use that can let code to easier?

1). get "circle" "circle in block" "circle in rotate block" center point (use ang)

2). get scacle

3). use center point and scale get draw line point.(not use ang)

[PKENEWELL]

@masao

That is because the code sets the values for color, linetype, and dimcen. See these lines:

Code - Auto/Visual Lisp: [Select]

1. (setq vars '("cmdecho" "cecolor" "celtype" "dimcen") ;; These are system variables to be set.
2.  
3. AND...
4.  
5. (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06)) ;; here is setting the last 3 of 4 system variables from the list "var" to the values in the 2nd list.
6.  

If you don't want DIMCEN to be changed by the code, then remove the "dimcen" from the 1st line, and the "0.06" from the 2nd line.

I'm sorry, but I don't understand what you asking in the rest of your post. Are you asking to eliminate the centermark rotation despite the block being rotated?
If so look for the "brot" variable:

Code - Auto/Visual Lisp: [Select]

1.    ;; brot (cdr (assoc 50 (entget (last (last ent))))) ;; Here
2.        brot 0.0
3.    ;; AND here
4.   ;; brot (cdr (assoc 50 (entget (last ent))))
5.      brot 0.0
6.  
7. ;; comment them out and set them to 0 in both places.
8.