[编程交流] 从中提取长度和角度

 
(defun c:test (/ CreateList _grAngle adoc Plines obj cnt ent ObjectPointList
                PtAngleList Xpoint gr NewLine
                )
;;; pBe April 2011  ;;;
 (vl-load-com)
 (defun CreateList (p)
   (setq ObjectPointList (cons (cdr p) ObjectPointList))
   )
;;;  Alanjt  ;;;
 (defun _grAngle (a b)
   (grdraw (trans a 0 1) (cadr gr) 1 -1)
   (angle a b)
   )
;;;      ;;;
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (if (setq Plines (ssget ":L" '((0 . "LWPOLYLINE"))))
    (progn
      (repeat (setq cnt (sslength Plines))
        (setq obj (ssname Plines (setq cnt (1- cnt)))
          ent (entget obj)
          )
        (mapcar 'CreateList
          (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
          )
        (ssdel obj Plines)
        )
(if ObjectPointList
       (progn
       (setq PtAngleList (open (strcat (getvar 'Dwgprefix)(vl-filename-base (getvar 'Dwgname)) ".csv") "A"))
;;;  Alanjt  ;;;
          (while (eq 5 (car (setq gr (grread T 15 0))))
            (setq Xpoint (trans (cadr gr) 1 0))
            (redraw)
            (foreach pts ObjectPointList (_grAngle pts Xpoint))
               )
;;;                    ;;;
          (redraw)
          (foreach
             itm ObjectPointList
            (setq NewLine
               (vla-addline
                 (vlax-get (vla-get-activelayout adoc) 'Block)
                 (vlax-3d-point Xpoint)
                 (vlax-3d-point itm)
                 )
              )
                   (write-line (strcat (rtos (vla-get-length NewLine) 2 2) ","
                       (rtos (vla-get-Angle NewLine) 2 2)) PtAngleList)
            )
        (close PtAngleList)
          )
        )
      )
   )
 (princ)
 )

(defun c:test ( / e fl gr i pt pu pw ss )  
 (if
   (and
     (setq ss (ssget '((0 . "LWPOLYLINE"))))
     (setq fl (getfiled "Output File" "" "csv" 1))
   )
   (progn      
     (repeat (setq i (sslength ss))
       (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
         (if (= 10 (car x))
           (setq pw (cons (trans (cdr x) e 0) pw)
                 pu (cons (trans (cdr x) e 1) pu)
           )
         )
       )
     )      
     (while (= 5 (car (setq gr (grread t 13 0)))) (redraw)
       (setq pt (cadr gr))        
       (foreach x pu (grdraw x pt 1 -1))
     )      
     (setq pt (trans pt 1 0))
     (if (setq fl (open fl "w"))
       (progn
         (foreach x pw
           (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
           (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
         )
         (close fl)
       )
     )
   )
 )
 (redraw) (princ)
)

 
(defun c:test ( / e fl gr i pt pu pw ss Op accept )  
 (if
   (and
     (setq ss (ssget '((0 . "LWPOLYLINE"))))
     (setq fl (getfiled "Output File" "" "csv" 1))
   )
   (progn      
     (repeat (setq i (sslength ss))
       (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
         (if (= 10 (car x))
           (setq pw (cons (trans (cdr x) e 0) pw)
                 pu (cons (trans (cdr x) e 1) pu)
           )
         )
       )
     )
    [color=blue](while (not accept) [/color]
[color=darkolivegreen] (setq pt (getpoint "\nSelect Point: ") op nil) [/color]
[color=blue]  (foreach x pu (grdraw x pt 1 -1))[/color]
[color=blue]  (while (not (member Op '(97 32))) [/color]
[color=blue]    (princ "\n<A>ccept Spacebar for other point")(princ)[/color]
[color=blue]  (setq Op (cadr (grread))))[/color]
[color=blue]     (if ( = Op 97)(setq accept T))[/color]
[color=blue]    (redraw))[/color]
[color=darkolivegreen](setq pt (trans pt 1 0))[/color]
    (if (setq fl (open fl "w"))
       (progn
         (foreach x pw
           (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
           (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
         )
         (close fl)
       )
     )
   )
 )
 (redraw) (princ)
) 

(defun c:test ( / e fl gr go i pt pu pw ss )  
 (if
   (and
     (setq ss (ssget '((0 . "LWPOLYLINE"))))
     (setq fl (getfiled "Output File" "" "csv" 1))
   )
   (progn      
     (repeat (setq i (sslength ss))
       (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
         (if (= 10 (car x))
           (setq pw (cons (trans (cdr x) e 0) pw)
                 pu (cons (trans (cdr x) e 1) pu)
           )
         )
       )
     )
     (while (and (not go) (setq pt (getpoint "\nSpecify Point: ")))
       (redraw)
       (foreach x pu (grdraw x pt 1 -1))
       (initget "Yes No")
       (setq go (/= "No" (getkword "\nAccept Point? [Yes/No] <Yes>: ")))
     )
         
     (if (and pt (setq fl (open fl "w")))
       (progn
         (setq pt (trans pt 1 0))
         (foreach x pw
           (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
           (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
         )
         (close fl)
       )
     )
   )
 )
 (redraw) (princ)
)