[编程交流] 透镜型nil

(vl-load-com)
(defun ssvla (selection-set / index vla-list)
 (setq index (if selection-set
 (1- (sslength selection-set))
 -1
      )
 )
 (while (>= index 0)
   (setq vla-list (cons (vlax-ename->vla-object
     (ssname selection-set index)
   )
   vla-list
    )
  index    (1- index)
   )
 )
 vla-list
);; ssvla
(defun HORIZ (/ ss)
 (if (setq ss (ssget "_L" '((0 . "INSERT")(66 . 1))))
   (foreach obj (ssvla ss)
     (foreach att (vlax-safearray->list
      (vlax-variant-value (vla-getattributes obj))
    )
(vla-put-rotation att 0.0)
     )
   )
 )
 (princ)
);horiz defun
(defun c:PIPpsvs (/ Dcl_Id% Folder$ Slides@ Slide1$ Slide2$ Slide3$ Slide4$ Slide5$ Slide6$ Slide7$ Slide8$ Slide9$ Slide10$ Slide11$ Slide12$ Slide13# Return$ X# Y# ss a1 a2 a3 p2 p3 osm insertpt1 *error*)
 (command "_.undo" "_begin")
(defun *error* ( msg )
     (if osm (setvar 'OSMODE osm))
     (if snpm (setvar 'SNAPMODE snpm))
     (if snp (command "snap" snp))
     (if echo (setvar 'CMDECHO echo))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
       (princ (strcat "\nError: " msg))
   )
   (princ)
   (command "_.undo" "_end")
   )
       (princ "\n*************PSV's Dialog*************")(princ)
(princ "\n")
   ; Set Default Variables
  (setq Slides@ (list nil "SA001" "SA002" "SA003" "SA004" "SA005" "SA006" "SA007" "SA008" "SA009" "SA010" "SA011" "SA012" "SA013")
        Slide1$ (nth 1 Slides@)
        Slide2$ (nth 2 Slides@)
        Slide3$ (nth 3 Slides@)
        Slide4$ (nth 4 Slides@)
        Slide5$ (nth 5 Slides@)
        Slide6$ (nth 6 Slides@)
        Slide7$ (nth 7 Slides@)
        Slide8$ (nth 8 Slides@)
        Slide9$ (nth 9 Slides@)
        Slide10$ (nth 10 Slides@)
        Slide11$ (nth 11 Slides@)
        Slide12$ (nth 12 Slides@)
        Slide13$ (nth 13 Slides@)
        Folder$ ""
        Return$ ""
  );setq
   ; Load Dialog
  (setq Dcl_Id% (load_dialog "PIPpsvs.dcl"))
  (new_dialog "PIPpsvs" Dcl_Id%)
   ; Set Dialog Initial Settings
  (set_tile "Title" "PRESSURE RELIEF VALVES")
  (set_tile "SA001" Slide1$)
  (set_tile "SA002" Slide2$)
  (set_tile "SA003" Slide3$)
  (set_tile "SA004" Slide4$)
  (set_tile "SA005" Slide5$)
  (set_tile "SA006" Slide6$)
  (set_tile "SA007" Slide7$)
  (set_tile "SA008" Slide8$)
  (set_tile "SA009" Slide9$)
  (set_tile "SA0010" Slide10$)
  (set_tile "SA0011" Slide11$)
  (set_tile "SA0012" Slide12$)
  (set_tile "SA0013" Slide13$)
   ; Adjust X# and Y# per image_buttom outline to fit slide_image
  (start_image "Slide1")
  (setq X# (- (dimx_tile "Slide1") 2))
  (setq Y# (- (dimy_tile "Slide1") 2))
  (end_image)
  (start_image "Slide1")(slide_image 1 1 X# Y# (strcat Folder$ Slide1$))(end_image)
  (start_image "Slide2")(slide_image 1 1 X# Y# (strcat Folder$ Slide2$))(end_image)
  (start_image "Slide3")(slide_image 1 1 X# Y# (strcat Folder$ Slide3$))(end_image)
  (start_image "Slide4")(slide_image 1 1 X# Y# (strcat Folder$ Slide4$))(end_image)
  (start_image "Slide5")(slide_image 1 1 X# Y# (strcat Folder$ Slide5$))(end_image)
  (start_image "Slide6")(slide_image 1 1 X# Y# (strcat Folder$ Slide6$))(end_image)
  (start_image "Slide7")(slide_image 1 1 X# Y# (strcat Folder$ Slide7$))(end_image)
  (start_image "Slide8")(slide_image 1 1 X# Y# (strcat Folder$ Slide8$))(end_image)
  (start_image "Slide9")(slide_image 1 1 X# Y# (strcat Folder$ Slide9$))(end_image)
  (start_image "Slide10")(slide_image 1 1 X# Y# (strcat Folder$ Slide10$))(end_image)
  (start_image "Slide11")(slide_image 1 1 X# Y# (strcat Folder$ Slide11$))(end_image)
  (start_image "Slide12")(slide_image 1 1 X# Y# (strcat Folder$ Slide12$))(end_image)
  (start_image "Slide13")(slide_image 1 1 X# Y# (strcat Folder$ Slide13$))(end_image)
    ; Dialog Actions
(action_tile "Slide1" "(done_dialog 11)")
(action_tile "Slide2" "(done_dialog 12)")
(action_tile "Slide3" "(done_dialog 13)")
(action_tile "Slide4" "(done_dialog 14)")
(action_tile "Slide5" "(done_dialog 15)")
(action_tile "Slide6" "(done_dialog 16)")
(action_tile "Slide7" "(done_dialog 17)")
(action_tile "Slide8" "(done_dialog 18)")
(action_tile "Slide9" "(done_dialog 19)")
(action_tile "Slide10" "(done_dialog 20)")
(action_tile "Slide11" "(done_dialog 21)")
(action_tile "Slide12" "(done_dialog 22)")
(action_tile "Slide13" "(done_dialog 23)")
(action_tile "cancel" "(done_dialog 0)")
(setq a1 (start_dialog))
(setq osm (getvar "osmode")
     echo (getvar "cmdecho")
     snp (rtos (car (getvar 'snapunit)))
     snpm (getvar 'SNAPMODE))
(setvar "cmdecho" 0)
(command "attreq" "0")
(command "snap" "0.0625")
(if (and a1 (> a1 1))
(progn
                       (if (not (tblsearch "layer" "PID"))
                           (entmake
                              (list
                                 (cons 0 "Layer")
                                 (cons 100 "AcDbSymbolTableRecord")
                                 (cons 100 "AcDbLayerTableRecord") 
                                 (cons 2 "PID")
                                 (cons 70 0)
                                 (cons 62 2)
                                 (cons 6 "Continuous")
                               );list
                              );entmake
                         );if
(setvar "clayer" "PID") 
(if (setq insertpt1 (getpoint "\nPick Insertion Point on line, or In Space (Check Snap Settings): "))
(progn
 (if (and (setq name (car (nentselp insertpt1)))
   (wcmatch (cdr (assoc 0 (entget name)))"LINE,LWPOLYLINE")
   );; and
   (setq objx 1)
   );; if
     (cond 
((= a1 11)(MySub "SA001" 0.1500 -0.1500 insertpt1))    ;a1 11
((= a1 12)(MySub "SA002" 0.1500 -0.1500 insertpt1))    ;a1 12
((= a1 13)(MySub "SA003" 0.1500 -0.00001 insertpt1))   ;a1 13
((= a1 14)(MySub "SA004" 0.00001 -0.1500 insertpt1))   ;a1 14
((= a1 15)(MySub "SA005" 0.150 -0.150 insertpt1))    ;a1 15
((= a1 16)(MySub "SA006" 0.150 -0.00001 insertpt1))    ;a1 15
((= a1 17)(MySub "SA007" 0.150 -0.00001 insertpt1))    ;a1 15
((= a1 18)(MySub "SA008" 0.1500 -0.1500 insertpt1))    ;a1 15
((= a1 19)(MySub "SA009" 0.1500 -0.1500 insertpt1))    ;a1 15
((= a1 20)(MySub "SA010" 0.1500 -0.1500 insertpt1))    ;a1 15
((= a1 21)(MySub "SA011" 0.1500 -0.1500 insertpt1))    ;a1 15
((= a1 22)(MySub "SA012" 0.1500 -0.1500 insertpt1))    ;a1 15
((= a1 23)(MySub "SA013" 0.1500 -0.1500 insertpt1))    ;a1 15
       )          ;cond 
      )          ;progn
)          ;a1 1 if
))          ;if progn test    
(command "snap" snp)
(setvar "snapmode" snpm)
(setvar "osmode" osm) 
(setvar "cmdecho" echo) 
 (command "_.undo" "_end")      
(princ)         
)          
(defun MySub (a1 a2 a3 insertpt1 / OBJ P2 P3 doc)      ;subfunction
(vl-load-com)          ;load vlisp functions
;(setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (if (= objx 1)         ;if objx is 1, ent=line or pline
   (progn          ;preform these actions
(setvar "osmode" 0)         ;first turn off osnap
 (princ)
(if (> a2 0.0)          ;if trim dist is greater than 0.0 preform
(progn           ;these actions
(setq obj (vlax-ename->vla-object name))      ;get entity object
(if (eq (vla-get-ObjectName obj) "AcDbPolyline")     ;if it is a LwPolyline
    (setq p3 insertpt1         ;get first break point
   p2 (angle insertpt1  (vlax-curve-getpointatparam obj  
 (fix (vlax-curve-getparamatpoint obj 
 (vlax-curve-getClosestPointTo obj insertpt1 T))))))      
(setq p3 insertpt1         ;and second break point
     p2 (angle (vlax-curve-getStartpoint obj) (vlax-curve-getEndPoint obj)))
)           ;if
(command "break" name (polar p3 p2 a2) (polar p3 p2 a3))
(command "_insert" a1 insertpt1 "" "" pause)      ;insert into space
;(vla-sendcommand doc (strcat "horiz" " " "L" " " " "))     ;break line
(HORIZ)
)           ;progn
(princ "\n......Selected....\n......Breaking Lines....")    ;status
)           ;if
) 
(progn  
 (command "_insert" a1 insertpt1 "" "" pause)      ;insert onto line
;(vla-sendcommand doc (strcat "horiz" " " "L" " " " "))
 (HORIZ)
(princ)
)
)           ;if
(princ "\n......Insertion Completed!")       ;princ
(princ)
;(ARXUNLOAD "AT_CUSTDB" "DBX")           ;print clear
(setq name nil)
)           ;MySub
;|«Visual LISP© Format Options»
(78 2 40 2 nil "end of " 75 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;