[编程交流] 制作连续的pline

 
(defun c:testcode (/ pt1 pt2 e1)
 (setq pt1 (getpoint "\nFirst point: ")) 
 (while pt1
   (setq pt2 (getpoint pt1 "\nNext point: ")) 
   (if pt2
     (progn
       (command "_pline" pt1 pt2 "")
(setq e1(entlast))
       (setq pt1 pt2)
     );progn
     (setq pt1 nil) 
   );if
   
   );while
);defun

 
(defun WR:GetPoints (/ FirstPoint NextPoint xaaa xbbb yaaa ybbb xdist ydist)
 (setvar "osmode" 161)
 (setvar "orthomode" 0)
 (setq sspolyline nil CalculatedDistance nil)
 (setq FirstPoint (getpoint "\nPick first point of polyline: "))(terpri)
 (setq NextPoint (getpoint FirstPoint "\nPick next point of polyline: "))(terpri)
 (setq LastPoint FirstPoint)
 (setq xaaa (car LastPoint))
 (setq yaaa (cadr LastPoint))
 (setq xbbb (car NextPoint))
 (setq ybbb (cadr NextPoint))
 (if (< xaaa xbbb)
   (setq xdist (- xbbb xaaa))
   (setq xdist (- xaaa xbbb))
 )
 (if (< yaaa ybbb)
   (setq ydist (- ybbb yaaa))
   (setq ydist (- yaaa ybbb))
 )
 (setq CalculatedDistance (sqrt (+ (* xdist xdist) (* ydist ydist))))
 (command "layer" "M" "E-Temp1" "c" "30" "E-Temp1" "P" "N" "E-Temp1" "S" "E-Temp1" "")
 (command "pline" LastPoint "w" "1" "1" NextPoint "")
 (setq poly1 (entlast))
 (setq ssPolyline (ssadd))
 (ssadd poly1 ssPolyline)
 (setq polylinePointList (cons LastPoint polylinePointList))
 (setq LastPoint NextPoint)
 (while 
   (setq NextPoint (getpoint LastPoint "\nPick next point of polyline or press <Enter> to end command:"))
   (terpri)
   (setq xaaa (car LastPoint))
   (setq yaaa (cadr LastPoint))
   (setq xbbb (car NextPoint))
   (setq ybbb (cadr NextPoint))
   (if (< xaaa xbbb)
     (setq xdist (- xbbb xaaa))
     (setq xdist (- xaaa xbbb))
   )
   (if (< yaaa ybbb)
     (setq ydist (- ybbb yaaa))
     (setq ydist (- yaaa ybbb))
   )
   (setq AddToCalculatedDistance (sqrt (+ (* xdist xdist) (* ydist ydist))))
   (setq CalculatedDistance (+ CalculatedDistance AddToCalculatedDistance))
   (command "pline" LastPoint NextPoint "")
   (setq polynew (entlast))
   (command "pedit" "l" "j" polynew ssPolyline "" "")
   (setq poly1 (entlast))
   (ssadd poly1 ssPolyline)
   (setq polylinePointList (cons LastPoint polylinePointList))
   (setq LastPoint NextPoint)
 );end while
 (princ)
);end WR:GetPoints 

;
; By lpseifert on CADTutor 
; http://www.cadtutor.net/forum/showthread.php?t=41420
;
; Changed FUZZ to 0.00 and a coupla minor comment modifications
;
; WHAT IS DOES -------------------------------------------|
;                                                         |
;                                                        \|/
;                                                         V
(defun c:pj (/ ssj)                              ;defines the function and declares local variables
 (setq pa (getvar "peditaccept"))               ;stores the existing peditaccept variable setting
 (setvar "peditaccept" 1)                       ;sets the peditaccept variable to 1, which suppresses the prompts for
                                                ;non-plines, and automatically converts them to plines
   (setq ssj (ssget ))                          ;gets and stores your selection
   (command "PEDIT" "M" ssj ""  "J" "0.00" "")  ;does PEDIT stuff to what you selected (JOIN with fuzz = 0.00)
;(command "PEDIT" "m" ssj "" "j" "0.00" "s" "")  ;<-(use this line if you want to turn it into a spline after joining)
 (setvar "peditaccept" pa)                      ;restores peditaccept to what it was
(princ)                                          ;clean exit
)                                                ;the end

(command "_.pline")
(while (= 1 (logand 1 (getvar 'CMDACTIVE)))
 (command pause)
)

(defun c:Test (/ pt)
 (if (setq pt (getpoint "\nSpecify first point: "))
   (progn
     (command "_.pline" "_non" pt)
     (while (> (getvar 'cmdactive) 0)
       (princ "\nSpecify next point: ")
       (command PAUSE)
     )
   )
 )
 (princ)
)

 
(defun c:bl2(/ pt1 pt2  pt3 pt4 pt5 pt6 pt7 pt8   x1    x2     ss
       lk flag  sca   size    ds     os ptbrk ang
       e1 e2 e3 e4 SB_pickpoint   SB_next  SB_ent   SB_proceed
       SB_next SB_distance SB_entlist SB_closest_point SB_closest_ent SB_newent
)
 (setq sel1 nil)      
(setq pt1 (getpoint "\nSpecify first point for breakline: ")
      pt2 (getpoint pt1 "\nSpecify second point for breakline: ")
      BrkScale 1.0;temp scale to 1
);setq
(command "Pline" pt1 pt2 "")
(setq SB_ent (entlast)
      e2 (entlast)
      SB_pickpoint T
      SB_next nil
      SB_entlist (list SB_ent)
 );setq
 (while
 (setvar "osmode" 512)
 (setq SB_pickpoint (getpoint (if SB_next
         "\nSpecify next breakpoint: "
         "\nSpecify breakpoint: "
         );if
 ))
 (setq SB_proceed T
       SB_next T
       SB_distance 1.0e+012
 );setq
 ;;; Find the closest element of all the sub-elements ;
 (foreach SB_nth SB_entlist
 (setq SB_obj (vlax-ename->vla-object SB_nth)
       SB_foundpoint (vlax-curve-getClosestPointTo SB_obj
       SB_pickpoint nil)
 );setq
 (if (< (setq SB_temp (distance SB_pickpoint SB_foundpoint)) SB_distance)
     (setq SB_distance SB_temp
           SB_closest_ent SB_nth
           SB_closest_point SB_foundpoint
 );setq
 );if
 );foreach
 (command "_break" SB_closest_ent SB_closest_point SB_closest_point)
 ;;; add the newly created element to the sub-elements ;
 (setq SB_newent (entlast))
 ;;;  (setq sel1 (ssadd SB_newent e2))
  (if (not (member SB_newent SB_entlist))
 (setq SB_entlist (cons SB_newent SB_entlist))
 );if
 (command ".INSERT"
   "BRKLINE2"
   SB_closest_point
   BrkScale;scale
   ""
   pt1 
   pt2 ;angle
   )
 (command ".EXPLODE" "LAST");explode block to pline
 (setq e3(entlast))
;;; (setq sel2 (ssadd sel1 e3))
(setq  
       pt4  (polar SB_closest_point   (angle pt1 pt2) (* 1.5 BrkScale))
       pt4a (polar pt4 (*(angle pt1 pt2)(* 0.5 pi))(* 1.5 BrkScale))
       pt4b (polar pt4 (*(angle pt1 pt2)0.5 pi)(* 1.5 BrkScale))
       pt5 (polar SB_closest_point (-(angle Pt1 Pt2)(* 1.25 pi))(* 1.5 BrkScale))
       pt6 (polar SB_closest_point (+(angle Pt1 Pt2)(* 1.25 pi))(* 1.5 BrkScale))
       pt7 (polar SB_closest_point (-(angle Pt2 Pt1)(* 1.25 pi))(* 1.5 BrkScale))
       pt8 (polar SB_closest_point (+(angle Pt2 Pt1)(* 1.25 pi))(* 1.5 BrkScale))
 );setq
 (setvar "OSMODE" 0) 
 (command "trim" e3 "" "fence" pt6  pt5 "" "")
 (command "trim" e3 "" "fence" pt7  pt8 "" "")
;;; (command "_.PEDIT" e3 "JOIN"  e1 "" "")
 );while
 (princ)
 );defun

(defun c:Test (/ p1 p2 e1 mp ss)
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify next point: "))
     )
   (progn
     (command "_.line" "_non" p1 "_non" p2 "")
     (setq e1 (entlast)
           mp (mapcar '(lambda (a b) (/ (+ a b) 2.)) p1 p2)
     )
     (command "_.break" e1 "_non" mp "_non" mp)
     (setq ss (ssadd e1 (ssadd (entlast))))
     (if (eq (getvar 'peditaccept) 1)
       (command "_.pedit" "_m" ss "" "_j" "" "")
       (command "_.pedit" "_m" ss "" "_y" "_j" "" "")
     )
   )
 )
 (princ)
)