Author Topic: how can i keep settings (Read 3957 times)

masao · « **on:** December 04, 2023, 09:44:27 AM »

my cad is 2012 and i use dimcenter must set layer and color.

i have a question,if i missed circle select setting would back(i have *error*code so i missed select would enter *error*code)

if must make a code by yourself, i cant get "circle or arc on block" center point.

Code: [Select]

(defun C:CTR (/ e_lst ocolor oltype odimcen)

(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cecolor" "celtype" "dimcen")) )

(defun *error* (msg)

  (mapcar 'eval e_lst)

  (princ "")

)

(setvar "cmdecho" 0)

 (if (= (tblsearch "ltype" "center") nil)

 (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")

 )

 (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")

(while

(setq	ocolor (getvar "cecolor")
	oltype (getvar "celtype")
	odimcen (getvar "dimcen")
  )

(setvar "cecolor" "1")

(setvar "celtype" "CENTER")

(setvar "dimcen" -2)

(command "dimcenter" pause)

  (setvar "cecolor" ocolor)
  (setvar "celtype" oltype)
  (setvar "dimcen" odimcen)

);while

(princ)
)
(princ)

mhupp · « **Reply #1 on:** December 05, 2023, 08:04:19 AM »

Here is a simple trick to store, set, and recall a list of system variables. (probably found on here)

Code - Auto/Visual Lisp: [Select]

(defun C:CTR (/ vars vals)
  (setq vars '("cecolor" "celtype" "dimcen")   ;list of variables
        vals (mapcar 'getvar vars)             ;store old values in a list called vals
  ) 
  (mapcar 'setvar vars '(1 "CENTER" -2))       ;set new values
  (setvar "cmdecho" 0)
  (if (= (tblsearch "ltype" "center") nil)
    (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
  )
  (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
  (command "dimcenter")
  (while (> (getvar 'cmdactive) 0) (vl-cmdf "\\")) ;waits for dimcenter command to finish
  (mapcar 'setvar vars vals) ;sets all values back to before
  (princ)
)

masao · « **Reply #2 on:** December 05, 2023, 09:10:59 AM »

Quote from: mhupp on December 05, 2023, 08:04:19 AM

Here is a simple trick to store, set, and recall a list of system variables. (probably found on here)

Code - Auto/Visual Lisp: [Select]
(defun C:CTR (/ vars vals)
(setq vars '("cecolor" "celtype" "dimcen") ;list of variables
vals (mapcar 'getvar vars) ;store old values in a list called vals
)
(mapcar 'setvar vars '(1 "CENTER" -2)) ;set new values
(setvar "cmdecho" 0)
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
(command "dimcenter")
(while (> (getvar 'cmdactive) 0) (vl-cmdf "\\")) ;waits for dimcenter command to finish
(mapcar 'setvar vars vals) ;sets all values back to before
(princ)
)

thank you ,but can not use while loop.

if use while can not end loop.

JohnK · « **Reply #3 on:** December 05, 2023, 09:37:42 AM »

Your error handler will restore the variables so all you have to do is invoke the error handler (which you can do with `QUIT`).

I have highlighted the lines that I changed.

Code - Auto/Visual Lisp: [Select]

(defun C:CTR (/ e_lst ocolor oltype odimcen 
                *error*)
  (defun *error* (msg)
    (mapcar 'eval e_lst)
    (princ "")
    )
  (setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cecolor" "celtype" "dimcen")) )
 
  (setvar "cmdecho" 0)
  (if (= (tblsearch "ltype" "center") nil)
    (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
    )
 
  (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
  (while
    (setq ocolor (getvar "cecolor")
          oltype (getvar "celtype")
          odimcen (getvar "dimcen"))
    (setvar "cecolor" "1")
    (setvar "celtype" "CENTER")
    (setvar "dimcen" -2)
 
    (command "dimcenter" pause)
 
    (setvar "cecolor" ocolor)
    (setvar "celtype" oltype)
    (setvar "dimcen" odimcen)
 
    );while
  (quit)
  (princ)
  )
(princ)

masao · « **Reply #4 on:** December 05, 2023, 09:53:58 AM »

Quote from: JohnK on December 05, 2023, 09:37:42 AM

Your error handler will restore the variables so all you have to do is invoke the error handler (which you can do with `QUIT`).

I have highlighted the lines that I changed.
Code - Auto/Visual Lisp: [Select]
(defun C:CTR (/ e_lst ocolor oltype odimcen
*error*)
(defun *error* (msg)
(mapcar 'eval e_lst)
(princ "")
)
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cecolor" "celtype" "dimcen")) )

(setvar "cmdecho" 0)
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)

(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
(while
(setq ocolor (getvar "cecolor")
oltype (getvar "celtype")
odimcen (getvar "dimcen"))
(setvar "cecolor" "1")
(setvar "celtype" "CENTER")
(setvar "dimcen" -2)

(command "dimcenter" pause)

(setvar "cecolor" ocolor)
(setvar "celtype" oltype)
(setvar "dimcen" odimcen)

);while
(quit)
(princ)
)
(princ)

sorry ,this code has same result.

if i use CTR and missed click ,color and linetype has change old setting.

mhupp post code can prevent it,but can not use while to loop.

like cad code "*^C^C_dimcenter" can loop and missed click has not change old setting.

PKENEWELL · « **Reply #5 on:** December 05, 2023, 10:58:31 AM »

I was thinking this perhaps?

Let me know if this works on your version of AutoCAD. I am having trouble getting it to work on my system however and I don't know why; it has something to do with the "DIMCENTER" command itself:

Code - Auto/Visual Lisp: [Select]

(defun c:DCEN (/ i ss vals vars *error*)
   
   (defun *error* (msg)
      (mapcar 'setvar vars vals)
      (princ msg)
   )
   
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (princ "\nSelect Arcs or Circles: ")
   (if (setq ss (ssget '((0 . "ARC,CIRCLE"))))
      (progn
         (mapcar 'setvar (cdr vars) '("1" "CENTER" -2))
         (repeat (setq i (sslength ss))
            (command "._dimcenter" (ssname ss (setq i (1- i))))
         )
         (mapcar 'setvar vars vals)
      )
   )
   (princ)
)
 

JohnK · « **Reply #6 on:** December 05, 2023, 11:19:33 AM »

Quote from: masao on December 05, 2023, 09:53:58 AM

sorry ,this code has same result.

if i use CTR and missed click ,color and linetype has change old setting.

--->%

Not sure what you mean, if you mis-pick the error hander should restore the variable values to their original settings. You do not want the variables to be restored to their original state?

I did take another quick run though of the code and I cleaned out a few redundant areas. For example: there is not a need to set and reset variables in a while loop, you can just loop for the selection.

Code - Auto/Visual Lisp: [Select]

(defun C:CTR (/ e_lst ocolor oltype odimcen 
                *error*)
  (defun *error* (msg)
    (mapcar 'eval e_lst)
    (princ "")
    )
 
  (setq e_lst 
        (mapcar 
          (function 
            (lambda (n) 
              (list 'setvar n (getvar n)))) 
          '("cmdecho" 
            "cecolor" 
            "celtype" 
            "dimcen")) )
 
  (if (= (tblsearch "ltype" "center") nil)
    (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
    )
 
  (setvar "cmdecho" 0)
  (setvar "cecolor" "1")
  (setvar "celtype" "CENTER")
  (setvar "dimcen" -2)
 
  (while (setq ent (entsel))
         (command "dimcenter" ent)
         )
  (quit)
  (princ)
)

PKENEWELL · « **Reply #7 on:** December 05, 2023, 11:57:10 AM »

OK - It seems the DIMCENTER command doesn't like the (ssname ss n) input, so I altered this version to work like John's:

P.S. this version prevents missed picks from exiting the command.

Code - Auto/Visual Lisp: [Select]

(defun c:DCEN (/ i ent vals vars _Entsel *error*)
   
   (defun *error* (msg)
      (mapcar 'setvar vars vals)
      (princ msg)
   )
 
   (defun _Entsel (pr / ent)
      (setvar "errno" 0)
        (while (and (not (setq ent (entsel pr)))(= (getvar "errno") 7))
                (princ "\nNo Object Selected. Try Again...\n")
        )
        ent
   )
   
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (mapcar 'setvar (cdr vars) '("1" "CENTER" -2))
 
   (while (setq ent (_Entsel "\nSelect Circles or Arcs: "))(command "._dimcenter" ent))
 
   (mapcar 'setvar vars vals)
   (princ)
)
 

ribarm · « **Reply #8 on:** December 05, 2023, 12:38:49 PM »

These 2 lines at the end :

(mapcar 'setvar vars vals)
(princ)

should just be :

(*error* nil)

masao · « **Reply #9 on:** December 06, 2023, 06:38:47 AM »

Quote from: PKENEWELL on December 05, 2023, 11:57:10 AM

OK - It seems the DIMCENTER command doesn't like the (ssname ss n) input, so I altered this version to work like John's:

P.S. this version prevents missed picks from exiting the command.
Code - Auto/Visual Lisp: [Select]
(defun c:DCEN (/ i ent vals vars _Entsel *error*)

(defun *error* (msg)
(mapcar 'setvar vars vals)
(princ msg)
)

(defun _Entsel (pr / ent)
(setvar "errno" 0)
(while (and (not (setq ent (entsel pr)))(= (getvar "errno") 7))
(princ "\nNo Object Selected. Try Again...\n")
)
ent
)

(setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
vals (mapcar 'getvar vars)
)

(setvar "cmdecho" 0)

(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)

(mapcar 'setvar (cdr vars) '("1" "CENTER" -2))

(while (setq ent (_Entsel "\nSelect Circles or Arcs: "))(command "._dimcenter" ent))

(mapcar 'setvar vars vals)
(princ)
)

thank you,i know can use entsel but if circle on block can not get info.

so i use pause,but click missed has go to error code.

cad "*^C^C_dimcenter " ← how to doing loop like this?

PKENEWELL · « **Reply #10 on:** December 06, 2023, 10:29:32 AM »

Quote from: masao on December 06, 2023, 06:38:47 AM

thank you,i know can use entsel but if circle on block can not get info.

so i use pause,but click missed has go to error code.

cad "*^C^C_dimcenter " ← how to doing loop like this?

Sorry - what your asking for cannot be done with the dimcenter command in a LISP as far as I can tell. I've tested it using (nentsel) to see the circle entity in the block, but it doesn't work. The "*^C^C_dimcenter " is a menu/toolbar macro and only works within that context - I recommend you stick with that. Better yet - switch to a custom centerline program such as:
http://www.lee-mac.com/centreline.html

P.S. if you upgrade your AutoCAD, it now has a built-in command called CENTERMARK that works better then dimcenter.

masao · « **Reply #11 on:** December 06, 2023, 10:46:16 AM »

Quote from: PKENEWELL on December 06, 2023, 10:29:32 AM

Quote from: masao on December 06, 2023, 06:38:47 AM

thank you,i know can use entsel but if circle on block can not get info.

so i use pause,but click missed has go to error code.

cad "*^C^C_dimcenter " ← how to doing loop like this?

Sorry - what your asking for cannot be done with the dimcenter command in a LISP as far as I can tell. I've tested it using (nentsel) to see the circle entity in the block, but it doesn't work. The "*^C^C_dimcenter " is a menu/toolbar macro and only works within that context - I recommend you stick with that. Better yet - switch to a custom centerline program such as:
http://www.lee-mac.com/centreline.html

P.S. if you upgrade your AutoCAD, it now has a built-in command called CENTERMARK that works better then dimcenter.

thank you ,but i use cad2012.

i just want to know how to like this loop "*^C^C_dimcenter " by autolisp.

but can not do it by autolisp.

JohnK · « **Reply #12 on:** December 06, 2023, 04:42:17 PM »

Sorry, just passing through but what is the goal?

Concept code below (nentsel finding circle in block):

Code - Auto/Visual Lisp: [Select]

(defun getentsel ( )
  ;; Prompts for an entity selection.
  ;; If there is already object selected, then returns the first
  ;; item in the selection set.
  ;;
  ;; EX: (getentsel)
  ;; RETURNS: ent
  (cond
    ((cadr (ssgetfirst)) (ssname (cadr (ssgetfirst)) 0))
    ((car (nentsel)))) )
(command "._point" (cdr (assoc 10 (entget (getentsel)))))

masao · « **Reply #13 on:** December 06, 2023, 06:25:29 PM »

Quote from: JohnK on December 06, 2023, 04:42:17 PM

Sorry, just passing through but what is the goal?

Concept code below (nentsel finding circle in block):
Code - Auto/Visual Lisp: [Select]
(defun getentsel ( )
;; Prompts for an entity selection.
;; If there is already object selected, then returns the first
;; item in the selection set.
;;
;; EX: (getentsel)
;; RETURNS: ent
(cond
((cadr (ssgetfirst)) (ssname (cadr (ssgetfirst)) 0))
((car (nentsel)))) )
(command "._point" (cdr (assoc 10 (entget (getentsel)))))

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.

masao · « **Reply #14 on:** December 10, 2023, 12:43:18 AM »

Quote from: mhupp on December 05, 2023, 08:04:19 AM

Here is a simple trick to store, set, and recall a list of system variables. (probably found on here)

Code - Auto/Visual Lisp: [Select]
(defun C:CTR (/ vars vals)
(setq vars '("cecolor" "celtype" "dimcen") ;list of variables
vals (mapcar 'getvar vars) ;store old values in a list called vals
)
(mapcar 'setvar vars '(1 "CENTER" -2)) ;set new values
(setvar "cmdecho" 0)
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
(command "dimcenter")
(while (> (getvar 'cmdactive) 0) (vl-cmdf "\\")) ;waits for dimcenter command to finish
(mapcar 'setvar vars vals) ;sets all values back to before
(princ)
)

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

PKENEWELL · « **Reply #15 on:** December 11, 2023, 02:15:07 PM »

Quote from: masao on December 10, 2023, 12:43:18 AM

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 · « **Reply #16 on:** December 11, 2023, 03:42:58 PM »

Quote from: masao on December 06, 2023, 06:25:29 PM

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]

(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)
   
   (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 "\nNo Object Selected. Try Again...\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))
         )
      )
   )
   
   (command "._Undo" "_BEgin")
 
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (mapcar 'setvar (cdr vars) '("1" "CENTER" -2))
 
   (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
      (if (wcmatch (cdr (assoc 0 (setq el (entget (car ent))))) "ARC,CIRCLE")
         (progn
            (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
                  p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
                  p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
                  p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
                  p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
                  p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
                  p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
                  p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                  p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
            )
            (command "._line" "_non" p1 "_non" p2 "")
            (command "._line" "_non" p3 "_non" p4 "")
            (if (> (getvar "dimcen") 0)
               (progn
                  (command "._line" "_non" p5 "_non" p9 "")
                  (command "._line" "_non" p6 "_non" p10 "")
                  (command "._line" "_non" p7 "_non" p11 "")
                  (command "._line" "_non" p8 "_non" p12 "")
               )
            )
         )
         (princ (strcat "\nInvalid object " (cdr (assoc 0 el)) " Selected. Select an ARC or CIRCLE."))
      )
   )
 
   (mapcar 'setvar vars vals)
   (command "._Undo" "_End")
   (princ)
)
 

masao · « **Reply #17 on:** April 05, 2024, 10:14:10 AM »

Quote from: PKENEWELL on December 11, 2023, 03:42:58 PM

Quote from: masao on December 06, 2023, 06:25:29 PM
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]
(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)

(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 "\nNo Object Selected. Try Again...\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))
)
)
)

(command "._Undo" "_BEgin")

(setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
vals (mapcar 'getvar vars)
)

(setvar "cmdecho" 0)

(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)

(mapcar 'setvar (cdr vars) '("1" "CENTER" -2))

(while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
(if (wcmatch (cdr (assoc 0 (setq el (entget (car ent))))) "ARC,CIRCLE")
(progn
(if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
(Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
(setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
p1 (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
p3 (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
p5 (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
p6 (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
p7 (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
p8 (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
p9 (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
)
(command "._line" "_non" p1 "_non" p2 "")
(command "._line" "_non" p3 "_non" p4 "")
(if (> (getvar "dimcen") 0)
(progn
(command "._line" "_non" p5 "_non" p9 "")
(command "._line" "_non" p6 "_non" p10 "")
(command "._line" "_non" p7 "_non" p11 "")
(command "._line" "_non" p8 "_non" p12 "")
)
)
)
(princ (strcat "\nInvalid object " (cdr (assoc 0 el)) " Selected. Select an ARC or CIRCLE."))
)
)

(mapcar 'setvar vars vals)
(command "._Undo" "_End")
(princ)
)

Hi,i have some question.

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

PKENEWELL · « **Reply #18 on:** April 05, 2024, 03:49:30 PM »

Quote

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]

(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)
   
   (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 "\nNo Object Selected. Try Again...\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))
         )
      )
   )
   
   (command "._Undo" "_BEgin")
 
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
 
   (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
      (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
      (cond
         ((wcmatch enm "ARC,CIRCLE")
            (if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
                  p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
                  p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
                  p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
                  p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
                  p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
                  p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
                  p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                  p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
            )
            (command "._line" "_non" p1 "_non" p2 "")
            (command "._line" "_non" p3 "_non" p4 "")
            (if (> (getvar "dimcen") 0)
               (progn
                  (command "._line" "_non" p5 "_non" p9 "")
                  (command "._line" "_non" p6 "_non" p10 "")
                  (command "._line" "_non" p7 "_non" p11 "")
                  (command "._line" "_non" p8 "_non" p12 "")
               )
            )
         )
         ((= 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))
                  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  (abs (getvar "dimcen"))
                  p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
                  p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
                  p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
                  p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
                  p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
                  p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
                  p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                  p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
            )
            (command "._line" "_non" p1 "_non" p2 "")
            (command "._line" "_non" p3 "_non" p4 "")
            (if (> (getvar "dimcen") 0)
               (progn
                  (command "._line" "_non" p5 "_non" p9 "")
                  (command "._line" "_non" p6 "_non" p10 "")
                  (command "._line" "_non" p7 "_non" p11 "")
                  (command "._line" "_non" p8 "_non" p12 "")
               )
            )
         )
         (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
      )
   )
   (mapcar 'setvar vars vals)
   (command "._Undo" "_End")
   (princ)
)
 

masao · « **Reply #19 on:** April 06, 2024, 09:09:43 AM »

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 · « **Reply #20 on:** April 06, 2024, 07:16:14 PM »

Quote

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]

(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)
   
   (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 "\nNo Object Selected. Try Again...\n")
        )
        ent
   )
 
   ;|   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)
 
   
   (command "._Undo" "_BEgin")
 
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
 
   (while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
      (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
      (cond
         ((wcmatch enm "ARC,CIRCLE")
            (if (> (length ent) 2)
               (setq cpt (_TransNested (cdr (assoc 10 el)) (last ent) 2 1)) 
               (setq cpt (cdr (assoc 10 el)))
            )
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
                  p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
                  p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
                  p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
                  p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
                  p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
                  p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
                  p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
                  p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
                  p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
                  p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                  p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
            )
            (command "._line" "_non" p1 "_non" p2 "")
            (command "._line" "_non" p3 "_non" p4 "")
            (if (> (getvar "dimcen") 0)
               (progn
                  (command "._line" "_non" p5 "_non" p9 "")
                  (command "._line" "_non" p6 "_non" p10 "")
                  (command "._line" "_non" p7 "_non" p11 "")
                  (command "._line" "_non" p8 "_non" p12 "")
               )
            )
         )
         ((= enm "LWPOLYLINE")
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (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)(_TransNested cpt (last ent) 2 1) cpt)
                        rad (abs rad)
                        dc  (abs (getvar "dimcen"))
                        p1  (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
                        p2  (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
                        p3  (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
                        p4  (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
                        p5  (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
                        p6  (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
                        p7  (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
                        p8  (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
                        p9  (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
                        p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
                        p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                        p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
                  )
                  (command "._line" "_non" p1 "_non" p2 "")
                  (command "._line" "_non" p3 "_non" p4 "")
                  (if (> (getvar "dimcen") 0)
                     (progn
                        (command "._line" "_non" p5 "_non" p9 "")
                        (command "._line" "_non" p6 "_non" p10 "")
                        (command "._line" "_non" p7 "_non" p11 "")
                        (command "._line" "_non" p8 "_non" p12 "")
                     )
                  )
               )
            )
         )
         (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
      )
   )
   (mapcar 'setvar vars vals)
   (command "._Undo" "_End")
   (princ)
)
 

masao · « **Reply #21 on:** April 07, 2024, 12:13:21 AM »

Quote from: PKENEWELL on April 06, 2024, 07:16:14 PM

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

(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 "\nNo Object Selected. Try Again...\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))
)
)
)

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

(command "._Undo" "_BEgin")

(setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
vals (mapcar 'getvar vars)
)

(setvar "cmdecho" 0)

(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)

(mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))

(while (setq ent (_Nentsel "\nSelect Circles or Arcs: "))
(setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
(cond
((wcmatch enm "ARC,CIRCLE")
(if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
(Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
(setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
p1 (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
p3 (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
p5 (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
p6 (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
p7 (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
p8 (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
p9 (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
)
(command "._line" "_non" p1 "_non" p2 "")
(command "._line" "_non" p3 "_non" p4 "")
(if (> (getvar "dimcen") 0)
(progn
(command "._line" "_non" p5 "_non" p9 "")
(command "._line" "_non" p6 "_non" p10 "")
(command "._line" "_non" p7 "_non" p11 "")
(command "._line" "_non" p8 "_non" p12 "")
)
)
)
((= enm "LWPOLYLINE")
(Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
(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)
rad (abs rad)
dc (abs (getvar "dimcen"))
p1 (list (car cpt) (+ (cadr cpt) dc) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) dc) (caddr cpt))
p3 (list (+ (car cpt) dc) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) dc) (cadr cpt) (caddr cpt))
p5 (list (car cpt) (+ (cadr cpt) rad dc) (caddr cpt))
p6 (list (car cpt) (- (cadr cpt) rad dc) (caddr cpt))
p7 (list (+ (car cpt) rad dc) (cadr cpt) (caddr cpt))
p8 (list (- (car cpt) rad dc) (cadr cpt) (caddr cpt))
p9 (list (car cpt) (+ (cadr cpt) (* 2 dc)) (caddr cpt))
p10 (list (car cpt) (- (cadr cpt) (* 2 dc)) (caddr cpt))
p11 (list (+ (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
p12 (list (- (car cpt) (* 2 dc)) (cadr cpt) (caddr cpt))
)
(command "._line" "_non" p1 "_non" p2 "")
(command "._line" "_non" p3 "_non" p4 "")
(if (> (getvar "dimcen") 0)
(progn
(command "._line" "_non" p5 "_non" p9 "")
(command "._line" "_non" p6 "_non" p10 "")
(command "._line" "_non" p7 "_non" p11 "")
(command "._line" "_non" p8 "_non" p12 "")
)
)
)
)
)
(T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
)
)
(mapcar 'setvar vars vals)
(command "._Undo" "_End")
(princ)
)

It's ok. thanks you so much.

It's Alive! · « **Reply #22 on:** April 07, 2024, 04:30:37 AM »

That’s like a lot of work, just sayin

Code - Python: [Select]

def PyRxCmd_doit():
    try:
        es = Ed.Editor.entSel("\nSelect: ", Db.Polyline.desc())
        if es[0] != Ed.PromptStatus.eOk:
            raise Exception("oof", es)
        pline = Db.Polyline(es[1])
        compositeCurve = pline.getAcGeCurve()
        for curve in compositeCurve.getCurveList():
            if curve.type() != Ge.EntityId.kCircArc3d:
                continue
            circArc = Ge.CircArc3d.cast(curve)
            Ed.Core.grDrawCircle(circArc.center(), 1, 24,1)
    except Exception as err:
        traceback.print_exception(err)
 

PKENEWELL · « **Reply #23 on:** April 07, 2024, 04:18:49 PM »

Quote from: It's Alive! on April 07, 2024, 04:30:37 AM

That’s like a lot of work, just sayin

Code - Python: [Select]
def PyRxCmd_doit():
try:
es = Ed.Editor.entSel("\nSelect: ", Db.Polyline.desc())
if es[0] != Ed.PromptStatus.eOk:
raise Exception("oof", es)
pline = Db.Polyline(es[1])
compositeCurve = pline.getAcGeCurve()
for curve in compositeCurve.getCurveList():
if curve.type() != Ge.EntityId.kCircArc3d:
continue
circArc = Ge.CircArc3d.cast(curve)
Ed.Core.grDrawCircle(circArc.center(), 1, 24,1)
except Exception as err:
traceback.print_exception(err)

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 · « **Reply #24 on:** April 07, 2024, 04:23:46 PM »

Quote

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 · « **Reply #25 on:** April 07, 2024, 05:32:43 PM »

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 · « **Reply #26 on:** April 11, 2024, 11:54:02 AM »

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 · « **Reply #27 on:** April 12, 2024, 11:45:22 AM »

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]

(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)
   
   (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 "\nNo Object Selected. Try Again...\n")
        )
        ent
   )
 
   ;|   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)
 
   
   (command "._Undo" "_BEgin")
 
   (setq vars '("cmdecho" "cecolor" "celtype" "dimcen")
         vals  (mapcar 'getvar vars)
   )
 
   (setvar "cmdecho" 0)
 
   (if (= (tblsearch "ltype" "center") nil)
     (vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
   ) 
   
   (mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))
 
   (while (setq ent (_Nentsel "\nSelect Circles or Arcs / PolyArcs: "))
      (setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
      (if (> (length ent) 2)
         (if (= (type (last ent)) 'LIST)
            (setq xscl (apply '* (mapcar '(lambda (x)(cdr (assoc 41 (entget x)))) (last ent)))
                  yscl (apply '* (mapcar '(lambda (x)(cdr (assoc 42 (entget x)))) (last ent)))
                  brot (cdr (assoc 50 (entget (last (last ent)))))
            )
            (setq xscl (cdr (assoc 41 (entget (last ent))))
                  yscl (cdr (assoc 42 (entget (last ent))))
                  brot (cdr (assoc 50 (entget (last ent))))
            
            )
         )
         (setq xscl 1.0 yscl 1.0 brot 0.0)
      )
      (cond
         ((wcmatch enm "ARC,CIRCLE")
            (if (> (length ent) 2)
               (setq cpt (_TransNested (cdr (assoc 10 el)) (last ent) 2 1)) 
               (setq cpt (cdr (assoc 10 el)))
            )
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (setq rad (cdr (assoc 40 el)) dc (abs (getvar "dimcen"))
                  p1  (polar cpt (+ brot (/ pi 2)) dc)
                  p2  (polar cpt (+ brot (* pi 1.5)) dc)
                  p3  (polar cpt brot dc)
                  p4  (polar cpt (+ brot pi) dc)
                  p5  (polar cpt (+ brot (/ pi 2)) (+ (* rad yscl) dc))
                  p6  (polar cpt (+ brot (* pi 1.5)) (+ (* rad yscl) dc))
                  p7  (polar cpt brot (+ (* rad xscl) dc))
                  p8  (polar cpt (+ brot pi) (+ (* rad xscl) dc))
                  p9  (polar cpt (+ brot (/ pi 2)) (* 2 dc))
                  p10 (polar cpt (+ brot (* pi 1.5)) (* 2 dc))
                  p11 (polar cpt brot (* 2 dc))
                  p12 (polar cpt (+ brot pi) (* 2 dc))
            )
            (command "._line" "_non" p1 "_non" p2 "")
            (command "._line" "_non" p3 "_non" p4 "")
            (if (> (getvar "dimcen") 0)
               (progn
                  (command "._line" "_non" p5 "_non" p9 "")
                  (command "._line" "_non" p6 "_non" p10 "")
                  (command "._line" "_non" p7 "_non" p11 "")
                  (command "._line" "_non" p8 "_non" p12 "")
               )
            )
         )
         ((= enm "LWPOLYLINE")
            (Princ (strcat "\nEntity Name " (cdr (assoc 0 el)) " Selected."))
            (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)(_TransNested cpt (last ent) 2 1) cpt)
                        rad (abs rad)
                        dc  (abs (getvar "dimcen"))
                        p1  (polar cpt (+ brot (/ pi 2)) dc)
                        p2  (polar cpt (+ brot (* pi 1.5)) dc)
                        p3  (polar cpt brot dc)
                        p4  (polar cpt (+ brot pi) dc)
                        p5  (polar cpt (+ brot (/ pi 2)) (+ (* rad yscl) dc))
                        p6  (polar cpt (+ brot (* pi 1.5)) (+ (* rad yscl) dc))
                        p7  (polar cpt brot (+ (* rad xscl) dc))
                        p8  (polar cpt (+ brot pi) (+ (* rad xscl) dc))
                        p9  (polar cpt (+ brot (/ pi 2)) (* 2 dc))
                        p10 (polar cpt (+ brot (* pi 1.5)) (* 2 dc))
                        p11 (polar cpt brot (* 2 dc))
                        p12 (polar cpt (+ brot pi) (* 2 dc))
                  )
                  (command "._line" "_non" p1 "_non" p2 "")
                  (command "._line" "_non" p3 "_non" p4 "")
                  (if (> (getvar "dimcen") 0)
                     (progn
                        (command "._line" "_non" p5 "_non" p9 "")
                        (command "._line" "_non" p6 "_non" p10 "")
                        (command "._line" "_non" p7 "_non" p11 "")
                        (command "._line" "_non" p8 "_non" p12 "")
                     )
                  )
               )
            )
         )
         (T (princ (strcat "\nInvalid object " enm " Selected. Select an ARC,CIRCLE or POLYLINE Segment.")))
      )
   )
   (mapcar 'setvar vars vals)
   (command "._Undo" "_End")
   (princ)
)
 

masao · « **Reply #28 on:** April 13, 2024, 12:25:45 PM »

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 · « **Reply #29 on:** April 15, 2024, 09:39:14 AM »

@masao

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

Code - Auto/Visual Lisp: [Select]

(setq vars '("cmdecho" "cecolor" "celtype" "dimcen") ;; These are system variables to be set.
 
AND...
 
(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.

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]

   ;; brot (cdr (assoc 50 (entget (last (last ent))))) ;; Here
       brot 0.0
   ;; AND here
  ;; brot (cdr (assoc 50 (entget (last ent))))
     brot 0.0
 
;; comment them out and set them to 0 in both places.
 

masao · « **Reply #30 on:** April 22, 2024, 09:03:13 AM »

(mapcar 'setvar (cdr vars) '("1" "CENTER" 0.06))

add "(vl-cmdf "_.ucs" "_world")"

(while (setq ent (_Nentsel "\nSelect Circles or Arcs / PolyArcs: "))

i found must be add "(vl-cmdf "_.ucs" "_world")".

if not add and UCS not world "polyline object" get wrong center line points,but "polyline on block object" is ok.

add "(vl-cmdf "_.ucs" "_world")" is much easier.(other function is too much , i can't fix it.)

News:

Author Topic: how can i keep settings (Read 3957 times)