[编程交流] 创建闭合多段线

(defun c:pol (/ pt pt2 ptlist tmp myobj a)
;;;some random stuff I probably gotta put everytime
 (setq thisdrawing 
       (vla-get-activedocument 
             (vlax-get-acad-object)))
 (setq mspace (vla-get-modelspace thisdrawing))
;;;select 1st point, assigned to variable pt
 (setq pt (getpoint "\nSpecify start point: "))
 ;;;;assign the first point to a list, in this case ptlist
 (setq ptlist (cons pt ptlist))
;;;select the following points, but these are cycled in variable pt2
 (while (setq pt2 (getpoint "\nSpecify next point: " pt2))
   (setq ptlist (cons pt2 ptlist))
 )
  ;;;repeat initial point so that the polyline is closed
 (setq ptlist (cons pt ptlist))
 ;; "dissolve" the points into atoms with append:
 (setq ptlist (apply 'append ptlist))
 (prin1 ptlist)
 
)

(defun c:pol (/ pt pt2 ptlist tmp myobj a i)
;;;some random stuff I probably gotta put everytime
 (setq thisdrawing 
       (vla-get-activedocument 
             (vlax-get-acad-object)))
 (setq mspace (vla-get-modelspace thisdrawing))
;;;select 1st point, assigned to variable pt
 (setq pt (getpoint "\nSpecify start point: "))
 ;;;;assign the first point to a list, in this case ptlist
 (setq ptlist (cons pt ptlist))
  (setq i 0)
;;;select the following points, this time they stay in pt2 or i will get a error
 (while (setq pt (getpoint "\nSpecify next point: " pt))
   (setq i (+ i 1))
   (setq ptlist (cons pt ptlist))
 )
  ;;;repeat initial point so that the polyline is closed (by going to the end of the list and adding the point again)
 (setq ptlist (cons (nth i ptlist) ptlist))
 ;; "dissolve" the points into atoms with append:
 (setq ptlist (apply 'append ptlist))
 (prin1 ptlist)
 (prin1 i)
     (setq
       tmp (vlax-make-safearray 
              vlax-vbDouble
              (cons 0 (- (length ptlist) 1))
           )
     )
     (vlax-safearray-fill tmp ptlist)
     (setq myobj (vla-addPolyline mspace tmp))
)

(command "._hatch" "_S" myobj "" "")

(vla-appendouterloop ;means it will associate the boundaries with the hatch
               (setq hat ;hat is the hatch variable
                   (vla-addhatch ;add hatch command
                       (setq spc ;drawing space
                           (vlax-get-property (vla-get-activedocument (vlax-get-acad-object));;; stuff i'm supposed to do everytime, probably change the hatch properties below
                               (if (= 1 (getvar 'cvport))
                                   'paperspace
                                   'modelspace
                               )
                           )
                       )
                       achatchpatterntypepredefined
                       "SOLID"
                       :vlax-true
                       achatchobject
                   )
               )
               (vlax-make-variant   ;;;draws the hatch boundaries (i'll try to replace with the polyline)
                   (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0))
                       (list
                           (vla-addellipse spc
                               (vlax-3D-point (trans cen 1 0))
                               (vlax-3D-point (trans (mapcar '- maj cen) 1 0))
                               rat
                           )
                       )
                   )
               )
           )
           (vla-evaluate hat)

(vl-load-com)
(defun c:outerloop1(/ acadObj doc patternName patternType bAssociativity modelSpace hatchObj center radius startAngle endAngle arc line outerLoop pt pt2 ptlist tmp myobj a i)
   ;; This example creates an associative hatch in model space, and
   ;; then creates an outer loop for the hatch.
   (setq acadObj (vlax-get-acad-object))
   (setq doc (vla-get-ActiveDocument acadObj))
 
   ;; Define the hatch
   (setq patternName "ANSI31"
         patternType 0
         bAssociativity :vlax-true)
   
   ;; Create the associative Hatch object
   (setq modelSpace (vla-get-ModelSpace doc))  
   (setq hatchObj (vla-AddHatch modelSpace patternType patternName bAssociativity acHatchObject))
   ;;;select 1st point, assigned to variable pt
 (setq pt (getpoint "\nSpecify start point: "))
   ;;;;assign the first point to a list, in this case ptlist
 (setq ptlist (cons pt ptlist))
  (setq i 0)
   ;;;select the following points, but these are cycled in variable pt2
 (while (setq pt (getpoint "\nSpecify next point: " pt))
   (setq i (+ i 1))
   (setq ptlist (cons pt ptlist))
 )
  ;;;repeat initial point so that the polyline is closed
 (setq ptlist (cons (nth i ptlist) ptlist))
  ;; "dissolve" the points into atoms with append:
 (setq ptlist (apply 'append ptlist))
 (prin1 ptlist)
 (prin1 i)
   
   ;; Create the outer loop for the hatch.
   ;; An arc and a line are used to create a closed loop.
     (setq
       tmp (vlax-make-safearray 
              vlax-vbDouble
              (cons 0 (- (length ptlist) 1))
           )
     )
  (vlax-safearray-fill tmp ptlist)
  
   (setq poly(vla-AddPolyline modelSpace tmp))
 
   (setq outerLoop (vlax-make-safearray vlax-vbObject '(0 . 0)))
   (vlax-safearray-put-element outerLoop 0 poly)
       
   ;; Append the outer loop to the hatch object, and display the hatch
   (vla-AppendOuterLoop hatchObj outerLoop)
   (vla-Evaluate hatchObj)
)

(while (setq ptn
     (getpoint
       ptn
       "\nSpecify next point: "
     )
     )