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

0 Members and 1 Guest are viewing this topic.

PKENEWELL

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« Reply #15 on: December 11, 2023, 02:15:07 PM »
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.
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

PKENEWELL

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« Reply #16 on: December 11, 2023, 03:42:58 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]
  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.  
« Last Edit: December 11, 2023, 03:56:24 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

masao

  • Newt
  • Posts: 94
Re: how can i keep settings
« Reply #17 on: April 05, 2024, 10:14:10 AM »
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

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« 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]
  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.  
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

masao

  • Newt
  • Posts: 94
Re: how can i keep settings
« 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

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« 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]
  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.  
« Last Edit: April 07, 2024, 05:28:41 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

masao

  • Newt
  • Posts: 94
Re: how can i keep settings
« Reply #21 on: April 07, 2024, 12:13:21 AM »
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]
  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!

  • Retired
  • Needs a day job
  • Posts: 8690
  • AKA Daniel
Re: how can i keep settings
« Reply #22 on: April 07, 2024, 04:30:37 AM »
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

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« Reply #23 on: April 07, 2024, 04:18:49 PM »
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.
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

PKENEWELL

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« 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.   ;-)
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

PKENEWELL

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« 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.  :uglystupid2:
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

masao

  • Newt
  • Posts: 94
Re: how can i keep settings
« 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

  • Bull Frog
  • Posts: 316
Re: how can i keep settings
« Reply #27 on: Today at 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]
  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.  
« Last Edit: Today at 12:06:55 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt