[编程交流] 创建施工线

;;  LineBetween.lsp [command name: LB]
;;  To draw a Line whose endpoints are halfway Between those of two
;;    User-selected Lines or Polyline [of any variety] line segments.
;;  Draws Line on current Layer.
;;  Accounts for Lines or Polyline line segments running generally in
;;    same or opposite directions, and for 3rd dimension if applicable.
;;  May draw Line between "wrong" halfway-between points if objects
;;    cross, or if one crosses their apparent intersection, because routine
;;    has no way to judge which possibility is expected -- try reversing
;;    one object to get "right" result.
;;  Result will not necessarily lie along angle bisector between selected
;;    objects; will do so only if objects' relationship is symmetrical.
;;  Kent Cooper, 5 March 2013
(defun C:LB ; = Line Between
 (/ *error* noZ svnames svvals esel ent edata etype pick s1 e1 s2 e2 int)
 (defun *error* (errmsg)
   (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
     (princ (strcat "\nError: " errmsg))
   ); if
   (command "_.undo" "_end")
   (mapcar 'setvar svnames svvals)
   (princ)
 ); defun - *error*
 (defun noZ (pt) (list (car pt) (cadr pt)))
 (setq
   svnames '(cmdecho aperture); = System Variable NAMES
   svvals (mapcar 'getvar svnames); = System Variable VALueS
 ); setq
 (mapcar 'setvar svnames (list 0 (getvar 'pickbox)))
   ; aperture = pickbox to prevent Osnap Center seeing wrong object
 (command "_.undo" "_begin")
 (foreach num '("1" "2")
   (while
     (not
       (and
         (setq esel (entsel (strcat "\nSelect Line/Polyline line segment #" num ": ")))
         (setq
           ent (car esel)
           edata (entget ent)
           etype (cdr (assoc 0 edata))
           pick (osnap (cadr esel) "nea"); for (vlax-curve-...) later
         ); setq
         (wcmatch etype "LINE,*POLYLINE")
         (not (osnap pick "_cen")); if Polyline, not fit-curved or on arc segment
         (if (= etype "POLYLINE") (= (boole 1 4 (cdr (assoc 70 edata))) 0) T)
           ; not spline-curved 2D "heavy" or 3D Polyline [T for Line]
       ); and
     ); not
     (prompt "\nNothing, or Polyline curve, or invalid object type, selected --")
   ); while
   (set (read (strcat "s" num)); s1 or s2 [start]
     (if (= etype "LINE")
       (cdr (assoc 10 edata)); then
       (vlax-curve-getPointAtParam ent (fix (vlax-curve-getParamAtPoint ent pick))); else
     ); if
   ); set
   (set (read (strcat "e" num)); e1 or e2 [end]
     (if (= etype "LINE")
       (cdr (assoc 11 edata)); then
       (vlax-curve-getPointAtParam ent (1+ (fix (vlax-curve-getParamAtPoint ent pick)))); else
     ); if
   ); set
 ); foreach
 (setq int (inters (noZ s1) (noZ s2) (noZ e1) (noZ e2))); T or nil -- opposite directions
 (entmake
   (list
     '(0 . "LINE")
     (cons 10 (mapcar '/ (mapcar '+ s1 (if int e2 s2)) '(2 2 2)))
     (cons 11 (mapcar '/ (mapcar '+ e1 (if int s2 e2)) '(2 2 2)))
   ); list
 ); entmake
 (command "_.undo" "_end")
 (mapcar 'setvar svnames svvals)
 (princ)
); defun
(prompt "\nType LB to draw a Line halfway Between two Lines/Polyline line segments.")

;; XLine Bisector  -  Lee Mac
;; Constructs an XLine bisector between two selected XLines
(defun c:xlb ( / int pt1 pt2 vc1 vc2 xl1 xl2 )
   (if (and (setq xl1 (LM:selectifobject "\nSelect 1st xline: " "XLINE"))
            (setq xl2 (LM:selectifobject "\nSelect 2nd xline: " "XLINE"))
       )
       (entmake
           (vl-list*
              '(000 . "XLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbXline")
               (if (setq xl1 (entget xl1)
                         xl2 (entget xl2)
                         pt1 (cdr (assoc 10 xl1))
                         pt2 (cdr (assoc 10 xl2))
                         vc1 (cdr (assoc 11 xl1))
                         vc2 (cdr (assoc 11 xl2))
                         int (inters (trans pt1 0 1) (trans (mapcar '+ pt1 vc1) 0 1) (trans pt2 0 1) (trans (mapcar '+ pt2 vc2) 0 1) nil)
                   )
                   (list
                       (cons 10 (trans int 1 0))
                       (cons 11 (mapcar (if (< (distance vc1 vc2) (distance vc1 (mapcar '- vc2))) '+ '-) vc1 vc2))
                   )
                   (list
                       (cons 10 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2))
                       (cons 11 vc1)
                   )
               )
           )
       )
   )
   (princ) 
)
;; Select if Object  -  Lee Mac
;; Continuously prompts the user for a selection of a specific object type
(defun LM:selectifobject ( msg typ / ent )
   (while
       (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null ent) nil)
               (   (not (wcmatch (cdr (assoc 0 (entget ent))) typ))
                   (princ "\nInvalid object selected.")
               )
           )
       )
   )
   ent
)
(princ)