[编程交流] 投影曲线墙的例程

(defun c:crv ( / entarc entline)
   (while (and (setq entarc (car (entsel "\nPick An Arc: ")))
        (not (eq "ARC" (cdr (assoc 0 (entget entarc)))))
   )
   (princ "\nPlease Select an Arc...")
   )
 
   (while
     (and
(setq entline (car (entsel "\nPick a line to project on:")))
(not (eq "LINE" (cdr (assoc 0 (entget entline)))))
     );and
     (princ "\nPlease select a line....")
   );While
 
 (setq Segments (cond ((getint "\nNumber of Segments:")) (10)))
 (setq Height (getdist "\nCut-off Height:"))
 (projectlines entarc entline)
 (princ)
);Function
;;;****************************************************
;;;This is the function which draws the projected lines
;;;****************************************************
(defun projectlines (ArcObj LineObj
             / ArcCenter ArcStartAngle ArcEndAngle
             ArcRadius ArcStartPoint ArcEndPoint)
 (setq ArcCenter (cdr ( assoc 10 (entget ArcObj))))
 (setq ArcStartAngle (cdr ( assoc 50 (entget ArcObj))))
 (setq ArcEndAngle (cdr ( assoc 51 (entget ArcObj))))
 (setq ArcRadius  (cdr ( assoc 40 (entget ArcObj))))
 (setq ArcStartPoint (polar ArcCenter ArcStartAngle ArcRadius))
 (setq ArcEndPoint (polar ArcCenter ArcEndAngle ArcRadius))
 (setq ArcAngle (abs (- ArcStartAngle ArcEndAngle)))
 (setq LineStartPoint (cdr (assoc 10 (entget LineObj))))
 (setq LineEndtPoint (cdr (assoc 11 (entget LineObj))))
 (setq LineAngle (angle LineStartPoint LineEndtPoint))
 (setq LinePerpendicular (+ LineAngle (dtor 90)))
 (setq i 1)
 (setq p2 ArcStartPoint)
 (setq AngleDivision (/ ArcAngle Segments))
 (setq OSM (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (repeat (1+ Segments)
   (command "_LINE" ArcCenter p2 "")
   (setq p2 (polar ArcCenter (+ ArcStartAngle (* AngleDivision i)) ArcRadius))
   (setq i (1+ i))
 )
 (setvar "OSMODE" OSM)
);Function
(defun dtor(d)
 (* d 0.01745329)
)

(vl-load-com)
(defun c:ProjectCurve (/ crv l1 l2 div pt1 pt2 pt3 n l1s l1e ang l2s l2e)
 (if (and (setq crv (entsel "\nPick curve: "))
          (setq crv (car crv))
          (setq l1 (entsel "\nPick furthest projection line: "))
          (setq l1 (entget (car l1)))
          (setq l1s (cdr (assoc 10 l1)))
          (setq l1e (cdr (assoc 11 l1)))
          (setq ang (+ (angle l1s l1e) (/ pi 2.0)))
          (setq l2 (entsel "\nPick nearest projection line: "))
          (setq l2 (entget (car l2)))
          (setq l2s (cdr (assoc 10 l2)))
          (setq l2e (cdr (assoc 11 l2)))
          (setq div (getdist "\nSelect maximum curvature arc length per projection line: "))
     )
   (progn
     (setq n   (vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv))
           div (/ n (1+ (fix (/ n div))))
     )
     (while (> n 0.0)
       (setq pt1 (vlax-curve-getPointAtDist crv n)
             pt2 (inters l1s l1e pt1 (polar pt1 ang 1000.0) nil)
             pt3 (inters l2s l2e pt1 (polar pt1 ang 1000.0) nil)
       )
       (entmake (list '(0 . "LINE")
                      (cons 8 (getvar 'CLayer))
                      (cons 410 (getvar 'CTab))
                      (cons 10 pt2)
                      (cons 11 pt3)
                )
       )
       (setq n (- n div))
     )
   )
 )
 (princ)
)

(eq (cdr (assoc 0 (entget crv))) "ARC")
(eq (cdr (assoc 0 l1)) "LINE")
(eq (cdr (assoc 0 l2)) "LINE")