[编程交流] 垂直lin的交点

; j = 1 to 3 ...
i[j] = (mapcar '+ '(0 100) [j] ))

(defun c:Test (/ _Ang s e sad ss i sn ent)
 (defun _Ang (e) (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))))
 (if (and (setq ss (ssget "_X" '((0 . "LINE"))))
          (setq sad (ssadd)
                s   (car (entsel "\n Select polyline :"))
          )
          (eq (cdr (assoc 0 (setq e (entget s)))) "LWPOLYLINE")
     )
   (repeat (setq i (sslength ss))
     (setq ent (entget (setq sn (ssname ss (setq i (1- i))))))
     (if (and (vlax-invoke (vlax-ename->vla-object s) 'IntersectWith (vlax-ename->vla-object sn) acExtendNone)
              (or (equal (_Ang ent) (* pi 0.5) 1e-4) (equal (_Ang ent) (* pi 1.5) 1e-4))
         )
       (ssadd sn sad)
     )
   )
 )
 (sssetfirst nil sad)
 (princ)
)

(defun c:WhereYouAt (/ e int pts mn mx dist tmpht i HtList p1 p2 p3p4)
(setq os (getvar 'osmode ))
(setvar 'osmode  0)
 (cond ((and (setq HtList nil
                   e      (car (entsel "\nSelect Polyline:"))
             )
             (setq int (getdist "\nEnter Interval:"))
             (Setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (ent) (= (car ent) 10)) (entget e))))
             (progn (vla-GetBoundingBox (vlax-ename->vla-object e) 'mn 'mx)
                    (setq mn    (vlax-safearray->list mn)
                          mx    (vlax-safearray->list mx)
                          dist  (- (car mx) (car mn))
                          tmpht (- (cadr mx) (cadr mn))
                          i     int
                    )
             )
             (while (< i dist)
               (setq p1 (polar mn 0 i)
                     p2 (polar p1 (/ pi 2.0) tmpht)
               )
               (setq p3p4 (vl-some '(lambda (x y)
                                      (if (<= (car x) (car p1) (car y))
                                        (list x y)
                                      )
                                    )
                                   pts
                                   (cdr pts)
                          )
               )
               (setq HtList (append HtList (list (inters p1 p2 (car p3p4) (cadr p3p4))))
                     i      (+ i int)
               )
               (setq pts (member (car p3p4) pts))
             )
             (foreach p HtList (command "_point"  p))
        )
       )
 )(setvar 'osmode os)
 (princ)
)

(setq length-polylinelist  (length polylinelist ) i 0)
(while (< i length-polylinelist )
(setq p1 (nth i polylinelist)  i (1+ i)   p2 (nth i polylinelist) )
(foreach p listpoints123...
 (if [color=red](setq pc (inters p1 p2 p (mapcar '+ '(0 100) p ))[/color]
...
)
)
)

pc = (vlax-invoke (vlax-ename->vla-object poly) 'IntersectWith (vlax-ename->vla-object line) 
   acExtendOtherEntity)
(195.558 111.199 0.0)

; polylinie = polyline object
; lisXYLin = list with coordinates of points 1, 2, 3, ...
(foreach p lisXYLin
(setq linie (vla-AddLine MSpace (vlax-3d-point p) (vlax-3d-point (mapcar '+ (list 0 100) p))) )
; vertical line
(if [color=red](setq pc (vlax-invoke polylinie 'IntersectWith linie acExtendBoth))[/color] ;_ end of setq
  (progn
    (setq dad (distance p pc)) ;_ end of set
    ; ....... (entmake (list '(0 . "TEXT") ... )) ; write a text
    )) ;_ end of if pc
    (if (and linie (not (vlax-erased-p linie)) ) (vla-Delete linie) ) ;_ end of if and
) ; f

 
(defun c:profL(/ *error* adoc en en2 ent ent2 ept ni obj pts)
(vl-load-com)
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object))
)
(cond ((or (not msg)
(member msg '("console break" "Function cancelled" "quit / exit abort"))
)
)
((princ (strcat "\nError: " msg)))
)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)) )
(vla-startundomark adoc )
(if (and (setq ent (entsel "\nSelect top curve : "))
(setq ent2 (entsel "\nSelect bottom curve >>")))
(progn
(setq en (car ent)
pts (vl-remove-if 'not (mapcar '(lambda (x)(if (= 10 (car x))(trans (cdr x) 1 0)))(entget en))) 
en2 (car ent2)
obj (vlax-ename->vla-object en2)
)
(foreach pt pts
(setq ept (vlax-curve-getclosestpointto obj pt))
(command "_line" "_non" pt "_non" ept "")
)
)
)
(*error* nil)
(princ)
)

[color=black](setq pc (vlax-invoke polylinie 'IntersectWith linie acExtendBoth))[/color]