Author Topic: How to include ARC into selection..  (Read 1107 times)

0 Members and 1 Guest are viewing this topic.

ScottMC

  • Newt
  • Posts: 194
How to include ARC into selection..
« on: November 15, 2023, 04:56:15 PM »
here's what's needing ARC selection:
works when I replace LINE on "setq DT" with ARC, but then only arc..
want to include both arc and line.
really appreciate help understanding.. Thanks

Code: [Select]

(defun c:TEST (/ OB DT) ;; https://www.theswamp.org/index.php?topic=39512.msg447762#msg447762
  (while
    (progn
      (initget "Exit  ")
      (if (setq OB (entsel "\nSelect <Exit>: "))
        (cond
          ( (or (= OB "Exit") (= OB ""))
            (princ "\n>> Exit TEST routine. <<")
            nil
          )
          ( (/= (setq DT (cdr (assoc 0 (entget (car OB))))) "LINE")  ;;;
            (princ "\n** Wrong object selected **")                            ;;;
            T                                                                                      ;;;
          )                                                                                         ;;;
          ( (= DT "LINE")
            (princ "\n>> You select a line. <<")
            nil
          )
        )
        (progn
          (princ "\n** Nothing selected **")
           T
        )
      )
    )
  )
  (princ)
)

« Last Edit: November 15, 2023, 05:21:14 PM by ScottMC »

Lee Mac

  • Seagull
  • Posts: 12927
  • London, England
Re: How to include ARC into selection..
« Reply #1 on: November 15, 2023, 06:03:13 PM »
Change /= to (not (wcmatch and "LINE" to "LINE,ARC"
« Last Edit: November 16, 2023, 06:07:46 AM by Lee Mac »

ScottMC

  • Newt
  • Posts: 194
Re: How to include ARC into selection..
« Reply #2 on: November 15, 2023, 06:06:15 PM »
ONLY BY CHANCE..
 So far seems to work....... slow learner
here's the pgm: 'tests desired'

Code: [Select]

(defun getlength (curveobj / len)
    (setq len 0.0)
    (vl-catch-all-apply '(lambda ()
                             (setq len
                                      (vlax-curve-getdistatparam curveobj
                                                                 (vlax-curve-getendparam curveobj)
                                      )
                             )
                         )
    )
    len
)

;; https://www.theswamp.org/index.php?topic=39512.msg447762#msg447762
(defun TEST (/ ) ;; line only select
  (while
    (progn
      (initget "Exit  ")
      (if (setq OB (entsel "\n Select Line Arc for Midpoint..<exit>: "))
        (cond
          ( (or (= OB "Exit") (= OB ""))
            (princ "\n>> Exit TEST routine. <<")
            nil
          )
           ( (or (/= (setq DT (cdr (assoc 0 (entget (car OB))))) "LINE"
                   (setq DT (cdr (assoc 0 (entget (car OB))))) "ARC"))
              (princ "\n** Wrong object selected **")
            T
          )
           ( (= DT "ARC")
            (setq DT OB)
            ;;(princ "\n>> You select a line. <<") ;; was
            nil
          )
           ( (= DT "LINE")
            (setq DT OB)
            ;;(princ "\n>> You select a line. <<")
            nil
          )        )
        (progn
          (princ "\n** Nothing selected **")
           T
        )
      )
    )
  )
  (princ)
)
(defun c:gmp ( / *error* ss arc-length arc-obj arcmidxyz w77) ;; getarcmidpoint

  (defun *error* ( msg )
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (if msg (prompt msg))
       (setvar 'cmdecho 1)   
    (princ)
  )
 
(princ "\n Mid.Point and Coords of Line.. < last.picked.coords: 'cds': >")
(while
 (setvar 'cmdecho 0)
 (command "UCS" "Save" "w77") ;; save current ucs..
    (command "UCS" "W")

 (test) ;; line arc only select
(setq arc-obj    (vlax-ename->vla-object (car DT)) ;; use line from 'test' filter
         arc-length (getLength arc-obj)
         arcmidxyz  (vlax-curve-getPointAtDist arc-obj (* arc-length 0.5))
    )

    (setq cds (strcat             ;; cmd/copy usable coords
                        (rtos (car arcmidxyz) 2 5)","
                         (rtos (cadr arcmidxyz) 2 5)","
                         (rtos (caddr arcmidxyz) 2 5)
        )
    )
(princ (strcat "\n" cds)) ;;
 
 (command "point" arcmidxyz) ;; to place point..
      (command "UCS" "Restore" "w77" "UCS" "Del" "W77") ;; restored/deletes ucs..
)     
(setvar 'cmdecho 1)
  (*error* nil)
(princ)
)