CADsite forum

Tijden het surfen op het www kamik deze site vol lsp tegen maar..
maar helaas is mijn Japans is niet zo best zeg maar rond uit slecht maar gelukkig hebben we google/bing en dat doet wonderen...
Hier een link naar een schat aan lsp.
http://www.offshorecad.com.ph/autolisp-customising.html

Kijk hier ..

http://www.theswamp.org/index.php?topic=7097.0;all

We hebben al jaren (zeker 15-20 Jr) een standaard lettertype (burotext.shx) maar vroeg me af wat er er zoal gebruikt wordt.Isocpeur is een optie om in de toekomst te gaan gebruiken omdat eerder gemeld font beperkt is.

Zo maar uit nieuwsgierigheid.
Welke lettertype gebruiken julie voor teksten en maatvoeringen op jullie tekenwerk.?

Hatch.

Ik ben eruit en hier is de complete code.


printview : dialog {label = "Print Views 2006";                                                     
: spacer { height = 1;}
: row {                                                                                           
    : boxed_column { label = "< Selecteer Views> ";                                                     
      : list_box { key = "viewbox";  width = 25; height = 20; multiple_select = true; }             
                                                                                                 
   
: spacer { height = 1;}


: row
           { : button { key = "selall"; label = "&Select All";}
             : button { key = "clrall"; label = "&Clear All";}
           } }


    : column {                                                                                     
      : radio_column { label = "< Selecteer Papier Formaat > "; key = "papierformaat";                           
        : radio_button { label = "A4 210x297 mm"; key = "ISO A4 (210.00 x 297.00 MM)";}             
        : radio_button { label = "A3 297x420 mm"; key = "ISO A3 (297.00 x 420.00 MM)"; value = "1";}
      }                                                                                             


: spacer { height = 1;}
      : boxed_row { label = "< Selecteer Printer >";                                                         
        : popup_list { key = "printers"; width = 30;}                                             
      }

      : boxed_column { label = "< Selecteer schaal >";                                                         
        : popup_list { key = "printschaallijst"; width = 30;}
//        : toggle { key = "FIT";  label = "Fit to Paper";}
      }

      : boxed_row { label = "< Selecteer Print Stijl >";                                                         
        : popup_list { key = "printstijlctb"; width = 30;}                                             
      }
    }
  }
  ok_cancel_help ;                                                                                       
}




(defun getnames (tablename / data result)
  (while (setq data (tblnext tablename (null data)))
    (setq result (cons (list (cdr (assoc 2 data))
                             (cdr (assoc 40 data))
                             (cdr (assoc 41 data))
                       ) ;_ end of LIST
                       result
                 ) ;_ end of CONS
    ) ;_ end of SETQ
  ) ;_ end of WHILE
) ;_ end of DEFUN

  ;;--------------------------------------------------------------------
  ;help message for dialog box.
  (defun txtbox_infohelp ()
    (alert
      (strcat
        "Deze routine print de geselecteerde views naar de standaard Printer.       \n\n"
        "Deze views worden geprint op de geselecteerde schaal en peninstellingen.\n"
        "Orientatie word automatisch geregeld.\n"
        "Klik op OK om dit venster te sluiten.\n\n"
        "Please report any problems you may have.\n\n"
       )
    )
  )
  ;;--------------------------------------------------------------------



;Start routine
(defun c:printview (/           ocmd        ocmddia     oexpert
                    oosmode     viewlijst   dianummer   viewselect
                    papierformaat           teller      item
                    orientatie  viewnaam    hoogte      breedte
                   ) ;Save values of variables to change

(setvar "cmdecho" 0)


  (init_vars1)
  (make_device_list)
  (init_vars2)
  (make_plotstyle_list)

  (setq viewlijst ;Get list of views and sort it
         (vl-sort (getnames "view")
                  (function (lambda (a b) (< (nth 0 a) (nth 0 b))))
         ) ;_ end of VL-SORT
  ) ;_ end of SETQ
 
  (setq dianummer (load_dialog "printview.DCL")) ;Start dialog to select views
  (new_dialog "printview" dianummer)
  (setq teller 0)
  (start_list "viewbox")
  (repeat (length viewlijst)
    (add_list (car (nth teller viewlijst)))
    (setq teller (+ 1 teller))
  ) ;_ end of REPEAT
  (end_list)


;;;--- Sort the plotstylelist
  (setq printstijl (acad_strlsort plotstyle-list))
  ;;;--- Add the list to the dialog box
  (start_list "printstijlctb" )
  (mapcar 'add_list plotstyle-list)
  (end_list)

;;;--- Sort the plotterlist
  (setq printer (acad_strlsort device-list))
  ;;;--- Add the list to the dialog box
  (start_list "printers" )
  (mapcar 'add_list device-list)
  (end_list)

(setq printschaallijst(list "Fit" "1=1" "1=2" "1=5" "1=10" "1=20" "1=50" "1=100" "1=200" "1=500" "1=1000"))
(start_list "printschaallijst")
(mapcar 'add_list printschaallijst)
(end_list)

  (action_tile
    "accept"
    "(progn
     (setq viewselect (get_tile \"viewbox\"))
     (setq papierformaat (get_tile \"papierformaat\"))
     (setq printschaal (get_tile \"printschaallijst\"))
     (setq printers (get_tile \"printers\"))
     (setq printctb (get_tile \"printstijlctb\"))
    (done_dialog)
    )"
  )

 
;;  ) ;_ end of ACTION_TILE


  ;;  CAB start
  (set_tile "viewbox" (if viewselect viewselect "")) ; default to none selected
  (action_tile "selall" "(select_all)")
  (action_tile "clrall" "(set_tile \"viewbox\" \"\")")
(defun select_all (/ sel cnt)
    (setq cnt 0
  sel ""
    )
    (repeat (length viewlijst)
      (setq sel (strcat sel (itoa cnt) " "))
      (setq cnt (1+ cnt))
    )
    (set_tile "viewbox" sel)
  )
  ;;  CAB end vl-list


 
(set_tile "printers" "6")
(set_tile "printstijlctb" "11")
(set_tile "printschaallijst" "3")
   
(action_tile "fit" "(mode_tile \"printschaallijst\" (- 1 (atoi $value))))")

  (action_tile "cancel" "(setq viewselect \"\")(done_dialog)")
  (action_tile "help" "(txtbox_infohelp)")
(start_dialog)
  (unload_dialog dianummer) ;If a view is selected, then print it
  (if (/= viewselect "")
    (progn (setq viewselect (read (strcat "(" viewselect ")"))) ;Convert string to list
           (setq teller 0)
           (repeat (length viewselect) ;Loop to process all selected views
             (setq item     (nth teller viewselect)
                   viewnaam (car (nth item viewlijst)) ; Name of view
                   hoogte   (cadr (nth item viewlijst)) ; Height of view
                   breedte  (car (cddr (nth item viewlijst))) ; Width of view
             ) ;_ end of SETQ
             (if (< breedte hoogte) ;Set paperorientation according to height/width
               (setq orientatie "Portrait")
               (setq orientatie "Landscape")
             ) ;_ end of IF
             (command "-plot" ; Print view
                      "yes" ;Detailed plot configuration? [Yes/No] <No>
                      "model" ;Enter a layout name or [?] <Model>
(nth (atoi printers) device-list) ;Enter an output device name
papierformaat ;Enter paper size:
                      "M" ;Inches/milimeters
                      orientatie ;Enter drawing orientation:
                      "n" ;Plot upside down:
                      "view" ;Enter plot area:
                      viewnaam ;Enter view name:
(nth (atoi printschaal) printschaallijst);Enter plot scale
                      "Center" ;Enter plot offset
                      "y" ;Plot with plot styles:
(nth (atoi printctb) plotstyle-list) ;Enter plot style table name
                      "y" ;Plot with lineweights:
                      "n" ;Remove hidden lines
                      "n" ;Write the plot to a file [Yes/No] <N>:
                      "n" ;Save changes to model tab [Yes/No]? <N>
                      "y" ;Proceed with plot [Yes/No] <Y>:
             ) ;_ end of COMMAND

             (setq teller (+ 1 teller))
           ) ;_ end of REPEAT
    ) ;_ end of PROGN
  (princ "\nJe hebt geen views geselecteerd en er is dus ook niets geprint.....!") ; Display text if no view or cancel is selected
  ) ;_ end of IF

  (princ)
) ;_ end of DEFUN
;|«Visual LISP© Format Options»
(72 2 1 2 T "end of " 60 9 1 1 0 T nil T T)
;*** DO NOT add text below the comment! ***|;
;;;; end routine;;;;;;;;

;;===============================================
(defun make_device_list (/ curdwg pslayout)
  (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
    pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
  )
  (vla-RefreshPlotDeviceInfo pslayout)
  (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames pslayout)))
) ; End make_device_list


(defun make_plotstyle_list (/ curdwg pslayout)
  (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
    pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
  )
  (vla-RefreshPlotDeviceInfo pslayout)
  (vlax-safearray->list (vlax-variant-value (vla-GetPlotStyleTableNames pslayout)))
) ; End make_plotstyle_list

;;===============================================
  (defun init_vars1 ()
    (if (not PLOTALL-DEVICE) (setq PLOTALL-DEVICE "None"))
         (setq  device-list (make_device_list))
          (if (and PLOTALL-DEVICE (member PLOTALL-DEVICE device-list))
      (setq device# (- (length device-list) (length (member PLOTALL-DEVICE device-list)))
      )
      (setq device# 0)
    )
  ) ; End init_vars1

  (defun init_vars2 ()
    (if (not PLOTSTYLE-DEVICE)(setq PLOTSTYLE-DEVICE "None"))
         (setq  plotstyle-list (make_plotstyle_list))
          (if (and PLOTSTYLE-DEVICE (member PLOTSTYLE-DEVICE plotstyle-list))
      (setq plotctb# (- (length plotstyle-list) (length (member PLOTSTYLE-DEVICE plotstyle-list)))
      )
      (setq plotctb# 0)
    )
  ) ; End init_vars2

;;===============================================




Hier nog eentje....


(defun c:AreaReact (/ Sel EntData PolyObj TextObj ReactList Pos TextSel)

;|  Adds a presistant reactor to a polyline object that
    updates a selected text object to the polylines area
    in square feet.  You will have to have the subs loaded
    in everydrawing for it to work, so that it know what
    to do with the reactor, because it is saved with the
    drawing.  Saves the association between the text
    and the polyline in the extension dictionary of the
    polyline.  If the text object is deleted, then the
    program will remove the reactor related to the polyline.
    Thanks to Luis Esquivel for his help and guidance.
    v1.0 2/2006 Tim Willey
    v1.1 5/2006 Added the ability to select an attribute.
|;

(if
(and
  (setq Sel (entsel "\n Select polyline to get area of: "))
  (setq EntData (entget (car Sel)))
  (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
  (setq PolyObj (vlax-ename->vla-object (car Sel)))
  (setq Sel (nentsel "\n Select text of hold area value: "))
  (setq EntData (entget (car Sel)))
  (or
   (if (vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT"))
    (setq TextSel T)
   )
   (= (cdr (assoc 0 EntData))  "ATTRIB")
  )
  (if TextSel
   (if (equal (length Sel) 2)
    T
    (prompt "\n Cannot select nested text.")
   )
   T
  )
  (setq TextObj (vlax-ename->vla-object (car Sel)))
)
(progn
  (PutArea PolyObj TextObj)
  (if
   (and
    (setq ReactList (AssociatedReactors PolyObj))
    (setq Pos (vl-position "MyAreaReactorModified" (mapcar 'vlr-data ReactList)))
   )
   (vlr-remove (nth Pos ReactList))
  )
  (vlr-pers
   (vlr-object-reactor
    (list PolyObj)
    "MyAreaReactorModified"
    '(
     (:vlr-modified . MakeCmdEndReactor)
     (:vlr-erased . ObjectEraseReactor)
;     (:vlr-unerased . ObjectUnErasedReactor)
    )
   )
  )
)
)
(princ)
)
;---------------------------------------------------------------------------------------------------------------
(defun PutArea (PolyObj TextObj / Dict xRec SqFt)

(setq Dict (vla-GetExtensionDictionary PolyObj))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor"))))
(setq xRec (vla-AddXRecord Dict "MyAreaReactor"))
)
(MySetXrec xRec '(40 1) (list (vlax-get PolyObj 'Area) (vlax-get TextObj 'Handle)))
(setq SqFt (/ (vla-get-Area PolyObj) 100000.0))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) " m2."))
xRec
)
;----------------------------------------------------------------------------------------------------------------
(defun MakeCmdEndReactor (Obj React NotSure)

(if (not (wcmatch (getvar "cmdnames") "U,UNDO,REDO,OOPS"))
(progn
  (if GlbVarAreaObject
   (setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
   (setq GlbVarAreaObject (list Obj))
  )
  (if (not GlbReactorCommandEnd)
   (setq GlbReactorCommandEnd (vlr-command-reactor "tempAreaCommandReactor" '((:vlr-commandEnded . AdjustTextObj))))
  )
)
)
(princ)
)
;------------------------------------------------------------------------------------------------------------------
(defun ObjectEraseReactor (Obj React NotSure)

(vlr-pers-release React)
(vlr-remove React)
)
;-----------------------------------------------------------------------------------------------------------------
(defun ObjectUnErasedReactor (Obj React NotSure)

(vlr-pers
(vlr-object-reactor
  (list Obj)
  "MyAreaReactorModified"
  '(
   (:vlr-modified . MakeCmdEndReactor)
   (:vlr-erased . ObjectEraseReactor)
   (:vlr-unerased . ObjectUnErasedReactor)
  )
)
)
)
;-----------------------------------------------------------------------------------------------------------------
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
(if (not (vlax-erased-p Obj))
  (progn
   (setq Dict (vla-GetExtensionDictionary Obj))
   (if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor")))))
    (progn
     (setq xRecList (MyGetXRec xRec))
     (if
      (and
       (setq tmpEnt (handent (cdr (assoc 1 xRecList))))
       (setq TextObj (vlax-ename->vla-object tmpEnt))
       (not (vlax-erased-p TextObj))
      )
      (PutArea Obj TextObj)
      (progn
       (foreach i (AssociatedReactors Obj)
        (if (= (vlr-data i) "MyAreaReactorModified")
         (progn
          (vlr-pers-release i)
          (vlr-remove i)
         )
        )
       )
       (prompt "\n Reactor has be removed because the text object has been erased.")
      )
     )
    )
   )
  )
)
)
(setq GlbVarAreaObject nil)
(vlr-remove GlbReactorCommandEnd)
(setq GlbReactorCommandEnd nil)
)
;---------------------------------------------------------------------------
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
(vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
)
(vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
)
)
)
;-----------------------------------------------------------------------------
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
Obj
'CodeType
'DataType
)
(if (and CodeType DataType)
(mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
)
)
)
;-------------------------------------------------------------------------------------
(defun AssociatedReactors (Obj / ReactList)
; Return a list of reactors (object type) associated with an object.
; Use like (AssociatedReactors (vlax-ename->vla-object (car (entsel))))

(foreach i (cdar (vlr-reactors :vlr-object-reactor))
(if (vl-position Obj (vlr-owners i))
  (setq ReactList (cons i ReactList))
)
)
ReactList
)
;---------------------------------------------------------------------------
(defun RemovePersReact ()
; Remove persistant reactors that don't have an owner.

(foreach i (vlr-pers-list)
(if (not (vlr-owners i))
  (progn
   (vlr-pers-release i)
   (vlr-remove i)
  )
)
)
)


Uitleg heb ik niet voor je , maar ervaar wel het zelfde "probleem" wat eigenlijk niet mag.

IK heb op het internet een routine gevonden die geselecteerde  views automatsich plot(Orientatie word geregeld).Ik heb hier wat aan gesleuteld maar ik kom er niet helemaal uit.Ik heb in mijn DCl twee button's toegevoegd waarmee ik alle aanwezige views in mijn list -box wil (de-) selecteren.Hoe doe ik dat.?


printview : dialog {label = "Print Views 2006";                                                     
: spacer { height = 1;}
: row {                                                                                           
    : boxed_column { label = "< Selecteer Views> ";                                                     
      : list_box { key = "viewbox";  width = 25; height = 20; multiple_select = true; }             
                                                                                                 
   
: spacer { height = 1;}


: row
           { : button { key = "selall"; label = "Select All";}
             : button { key = "clrall"; label = "Clear All";}
           } }


    : column {                                                                                     
      : radio_column { label = "< Selecteer Papier Formaat > "; key = "papierformaat";                           
        : radio_button { label = "A4 210x297 mm"; key = "ISO A4 (210.00 x 297.00 MM)";}             
        : radio_button { label = "A3 297x420 mm"; key = "ISO A3 (297.00 x 420.00 MM)"; value = "1";}
      }                                                                                             


: spacer { height = 1;}
      : boxed_row { label = "< Selecteer Printer >";                                                         
        : popup_list { key = "printers"; width = 30;}                                             
      }

      : boxed_column { label = "< Selecteer schaal >";                                                         
        : popup_list { key = "printschaallijst"; width = 30;}
        : toggle { key = "FIT";  label = "Fit to Paper";}
      }

      : boxed_row { label = "< Selecteer Print Stijl >";                                                         
        : popup_list { key = "printstijlctb"; width = 30;}                                             
      }
    }
  }
  ok_cancel_help ;                                                                                       
}



(defun getnames (tablename / data result)
  (while (setq data (tblnext tablename (null data)))
    (setq result (cons (list (cdr (assoc 2 data))
                             (cdr (assoc 40 data))
                             (cdr (assoc 41 data))
                       ) ;_ end of LIST
                       result
                 ) ;_ end of CONS
    ) ;_ end of SETQ
  ) ;_ end of WHILE
) ;_ end of DEFUN

  ;;--------------------------------------------------------------------
  ;help message for dialog box.
  (defun txtbox_infohelp ()
    (alert
      (strcat
        "Deze routine print de geselecteerde views naar de standaard Printer.       \n\n"
        "Deze views worden geprint op de geselecteerde schaal en peninstellingen.\n"
        "Orientatie word automatisch geregeld.\n"
        "Klik op OK om dit venster te sluiten.\n\n"
       )
    )
  )
  ;;--------------------------------------------------------------------



;Start routine
(defun c:printview2 (/           ocmd        ocmddia     oexpert
                    oosmode     viewlijst   dianummer   viewselect
                    papierformaat           teller      item
                    orientatie  viewnaam    hoogte      breedte
                   ) ;Save values of variables to change
;;  (setq ocmd    (getvar "cmdecho")
;;        ocmddia (getvar "cmddia")
;;        oexpert (getvar "expert")
;;        oosmode (getvar "osmode")
;;  ) ;_ end of SETQ
(setvar "cmdecho" 1)


  (init_vars1)
  (make_device_list)
  (init_vars2)
  (make_plotstyle_list)

  (setq viewlijst ;Get list of views and sort it
         (vl-sort (getnames "view")
                  (function (lambda (a b) (< (nth 0 a) (nth 0 b))))
         ) ;_ end of VL-SORT
  ) ;_ end of SETQ
 
  (setq dianummer (load_dialog "printview2.DCL")) ;Start dialog to select views
  (new_dialog "printview" dianummer)
  (setq teller 0)
  (start_list "viewbox")
  (repeat (length viewlijst)
    (add_list (car (nth teller viewlijst)))
    (setq teller (+ 1 teller))
  ) ;_ end of REPEAT
  (end_list)


;;;--- Sort the plotstylelist
  (setq printstijl (acad_strlsort plotstyle-list))
  ;;;--- Add the list to the dialog box
  (start_list "printstijlctb" )
  (mapcar 'add_list plotstyle-list)
  (end_list)

;;;--- Sort the plotterlist
  (setq printer (acad_strlsort device-list))
  ;;;--- Add the list to the dialog box
  (start_list "printers" )
  (mapcar 'add_list device-list)
  (end_list)

(setq printschaallijst(list "1=1" "1=2" "1=5" "1=10" "1=20" "1=50" "1=100" "1=200" "1=500" "1=1000"))
(start_list "printschaallijst")
(mapcar 'add_list printschaallijst)
(end_list)



  (action_tile
    "accept"
    "(progn
     (setq viewselect (get_tile \"viewbox\"))
     (setq papierformaat (get_tile \"papierformaat\"))
;;     (setq printschaal (get_tile \"printschaal\"))
      (setq printschaal (get_tile \"printschaallijst\"))
     (setq printers (get_tile \"printers\"))
     (setq printctb (get_tile \"printstijlctb\"))
    (done_dialog)
    )"
  )

 
;;  ) ;_ end of ACTION_TILE
(set_tile "printers" "6")
(set_tile "printstijlctb" "11")
(set_tile "printschaallijst" "2")

;;(action_tile "fit" (do_stempel)(mode_tile \"printschaallijst\" (- 1 (atoi $value))))

  (action_tile "cancel" "(setq viewselect \"\")(done_dialog)")
  (action_tile "help" "(txtbox_infohelp)")
(start_dialog)
  (unload_dialog dianummer) ;If a view is selected, then print it
  (if (/= viewselect "")
    (progn (setq viewselect (read (strcat "(" viewselect ")"))) ;Convert string to list
           (setq teller 0)
           (repeat (length viewselect) ;Loop to process all selected views
             (setq item     (nth teller viewselect)
                   viewnaam (car (nth item viewlijst)) ; Name of view
                   hoogte   (cadr (nth item viewlijst)) ; Height of view
                   breedte  (car (cddr (nth item viewlijst))) ; Width of view
             ) ;_ end of SETQ
             (if (< breedte hoogte) ;Set paperorientation according to height/width
               (setq orientatie "Portrait")
               (setq orientatie "Landscape")
             ) ;_ end of IF
             (command "-plot" ; Print view
                      "yes" ;Detailed plot configuration? [Yes/No] <No>
                      "model" ;Enter a layout name or [?] <Model>
(nth (atoi printers) device-list) ;Enter an output device name
papierformaat ;Enter paper size:
                      "M" ;Inches/milimeters
                      orientatie ;Enter drawing orientation:
                      "n" ;Plot upside down:
                      "view" ;Enter plot area:
                      viewnaam ;Enter view name:
;; printschaal ;Enter plot scale
(nth (atoi printschaal) printschaallijst)
                      "Center" ;Enter plot offset
                      "y" ;Plot with plot styles:
(nth (atoi printctb) plotstyle-list) ;Enter plot style table name
                      "y" ;Plot with lineweights:
                      "n" ;Remove hidden lines
                      "n" ;Write the plot to a file [Yes/No] <N>:
                      "n" ;Save changes to model tab [Yes/No]? <N>
                      "y" ;Proceed with plot [Yes/No] <Y>:
             ) ;_ end of COMMAND

             (setq teller (+ 1 teller))
           ) ;_ end of REPEAT
    ) ;_ end of PROGN
  (princ "\nJe hebt geen views geselecteerd en er is dus ook niets geprint.....!") ; Display text if no view or cancel is selected
  ) ;_ end of IF

  (princ)
) ;_ end of DEFUN
;|«Visual LISP© Format Options»
(72 2 1 2 T "end of " 60 9 1 1 0 T nil T T)
;*** DO NOT add text below the comment! ***|;
;;;; end routine;;;;;;;;

;;===============================================
(defun make_device_list (/ curdwg pslayout)
  (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
    pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
  )
  (vla-RefreshPlotDeviceInfo pslayout)
  (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames pslayout)))
) ; End make_device_list


(defun make_plotstyle_list (/ curdwg pslayout)
  (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object))
    pslayout (vla-get-Layout (vla-get-PaperSpace curdwg))
  )
  (vla-RefreshPlotDeviceInfo pslayout)
  (vlax-safearray->list (vlax-variant-value (vla-GetPlotStyleTableNames pslayout)))
) ; End make_plotstyle_list

;;===============================================
  (defun init_vars1 ()
    (if (not PLOTALL-DEVICE) (setq PLOTALL-DEVICE "None"))
         (setq  device-list (make_device_list))
          (if (and PLOTALL-DEVICE (member PLOTALL-DEVICE device-list))
      (setq device# (- (length device-list) (length (member PLOTALL-DEVICE device-list)))
      )
      (setq device# 0)
    )
  ) ; End init_vars1

  (defun init_vars2 ()
    (if (not PLOTSTYLE-DEVICE)(setq PLOTSTYLE-DEVICE "None"))
         (setq  plotstyle-list (make_plotstyle_list))
          (if (and PLOTSTYLE-DEVICE (member PLOTSTYLE-DEVICE plotstyle-list))
      (setq plotctb# (- (length plotstyle-list) (length (member PLOTSTYLE-DEVICE plotstyle-list)))
      )
      (setq plotctb# 0)
    )
  ) ; End init_vars2

;;===============================================



En weer een ook jammer genoeg 3D...


;TIP1344.LSP:    SP.LSP    3D Spiral stairs    (c)1997, Xu-Hong Yang

(defun dtr (r)
 (* r (/ pi 180.0)))
(defun rtd (r)
 (* r (/ 180.0 pi)))

(defun spinfo ()                                        ; staircase parameter
 (setq cp    (getpoint "\nCenter of Spiral Staircase: ")
       lp    (getpoint cp "\nLocation of first tread at inner radius: ")
       riser (getdist lp "\nRiser height: ")
       step  (getdist lp "\nMinimum tread depth at inner radius: ")
       wide  (getdist lp "\nStair width: ")
       hrl   (getdist lp "\nHeight of Handrail: ")
       thi   (getdist lp "\nThickness of Slab: ")
       case  (getint "\nNo. of treads: ")
       ls (sqrt (+ (expt riser 2) (expt step 2)))
       a (/ riser ls)    ; sin A
       b (/ step ls)     ; cos A
       c lp
 )        
)           ; end SPINFO

(defun spcalc ()
 (initget "L R B N")
 (setq ans (getkword "\n(L)eft/(R)ight/(B)oth-side/(N)one for Handrail: "))
 (setq blksp (open "blksp.lst" "r"))
 (if (not (equal blksp nil))
     (setq blk (read-line blksp))
 )
 (if (equal blk nil)
     (setq blk "sp1")
     (setq blk (strcat "sp"
                       (itoa (1+ (atoi (substr blk 3)))))
     )
 )
 (setq r (distance cp lp))
 (setq ang (/ step r))         ; determines the angle of the step
 (setq ac (angle cp lp))
 (setq rp (polar lp ac wide)
       lp1 (list (car lp) (cadr lp) riser)
       lp4 (list (car rp) (cadr rp) riser)
       count 0
       el riser
       al ang
 )        
 (setq diag (+ ac ang))
 (setq lp2 (list (car (polar cp diag r))
                 (cadr (polar cp diag r))
                  riser)
       lp3 (list (car (polar cp diag (+ r wide)))
                 (cadr (polar cp diag (+ r wide)))
                  riser)
       lh (polar cp (+ ac (/ ang 2)) (+ r (/ wide 15)))       ; left bottom hrl
       lh1 (list (car lh) (cadr lh) (+ (caddr lh) riser))      
       lh2 (list (car lh1) (cadr lh1) (+ (caddr lh1) hrl))    ; left top hrl
       sht (polar cp diag (+ r (/ wide 15)))
       shb (polar cp ac (+ r (/ wide 15)))
       sh1 (list (car shb) (cadr shb) (+ (caddr shb) (+ hrl (/ riser 2))))
       sh2 (list (car sht) (cadr sht) (+ (caddr sht) hrl (* riser 1.5)))
 )
 (setq tlp (list (car lp) (cadr lp) (- (caddr lp) (/ thi b)))
       tl1 (list (car lp2) (cadr lp2) (- (caddr lp2) (/ thi b)))
       trp (list (car rp) (cadr rp) (- (caddr rp) (/ thi b)))
       tr1 (list (car lp3) (cadr lp3) (- (caddr lp3) (/ thi b))))
 (command "layer" "m" "spiral" ""                 ; set spiral layer and color
          "layer" "c" "blue" "" "")
 (command "3dface" lp1 "i" lp2 lp3 lp4 ""         ; draw the step
          "3dface" lp lp1 lp4 rp ""               ; draw the riser
          "3dface" lp3 lp4 "i" rp "" ""           ; draw the right side face
          "3dface" lp2 lp1 "i" lp "" ""           ; draw the left side face
          "3dface" "i" trp "i" rp "i" lp3 tr1 ""  ; draw the thickness
          "3dface" "i" tlp "i" lp "i" lp2 tl1 ""
          "3dface" "i" trp tlp "i" tl1 tr1 "")    ; draw the bottom face
 (command "layer" "m" "scolumn" ""               ; set handrail column layer
          "layer" "c" "cyan" "" ""               ; and color
          "layer" "m" "shandrail" ""             ; set handrail layer and
          "layer" "c" "red" "" "")               ; and color
 (if (or (= ans "L") (= ans "B"))
   (progn  
     (command "layer" "s" "scolumn" "")
     (command "circle" lh1 (/ step 18))          ; draw the handrail column
     (setq cir (entlast))
     (command "line" lh1 lh2 "")
     (setq lc (entlast))
     (command "tabsurf" (list cir lh1) (list lc lh1))
     (setq tcl (entlast))
     (command "layer" "s" "shandrail" "")
     (command "circle" sh1 (/ step 15)           ; draw the handrail
              "ucs" "y" 90)
     (setq c1 (entlast)) (setq sh1r (trans sh1 0 1))
     (command "rotate" c1 "" sh1r (rtd (- b))
              "ucs" "")
     (command "line" sh1 sh2 "")
     (setq l1 (entlast))
     (command "tabsurf" (list c1 sh1) (list l1 sh1))
     (setq thl (entlast))
   )
 )        
 (if (or (= ans "R")(= ans "B"))
   (progn                                        ; draw the right handrail
     (setq dis (- wide (* 2 (/ wide 15)))        
           sr1 (polar sh1 ac dis)
           sr2 (polar sh2 diag dis)
           rh1 (polar lh1 (+ ac (/ ang 2)) dis)      
           rh2 (polar lh2 (+ ac (/ ang 2)) dis )    
     )
     (command "layer" "s" "scolumn" "")
     (command "circle" rh1 (/ step 18))              
     (setq cir1 (entlast))
     (command "line" rh1 rh2 "")
     (setq rc (entlast))
     (command "tabsurf" (list cir1 rh1) (list rc rh1))
     (setq tcr (entlast))
     (command "layer" "s" "shandrail" "")
     (command "circle" sr1 (/ step 15)
              "ucs" "y" 90)
     (setq c2 (entlast)) (setq sr1r (trans sr1 0 1))
     (command "rotate" c2 "" sr1r (rtd (- b)) "ucs" ""
              "circle" sr2 (/ step 15)
              "ucs" "y" 90)
     (setq c3 (entlast)) (setq sr2r (trans sr2 0 1))
     (command "rotate" c3 "" sr2r (rtd (- b))
              "ucs" "")
     (command "line" sr1 rh2 "") (setq l2 (entlast))
     (command "line" rh2 sr2 "") (setq l3 (entlast))
     (command "tabsurf" (list c2 sr1) (list l2 sr1)
              "tabsurf" (list c3 sr2) (list l3 sr2))
     (setq thr (entlast))))
 (if (= ans "L")
   (command "block" blk lp "c" tlp lp4 tr1 tcl thl "" "oops"))        
 (if (= ans "R")
   (command "block" blk lp "c" tlp lp4 tr1 tcr thr "" "oops"))
 (if (= ans "B")
   (command "block" blk lp "c" tlp lp4 tr1 tcl tcr thl thr "" "oops"))
 (if (= ans "N")
   (command "block" blk lp "c" tlp lp4 tr1 "" "oops"))
 (setvar "clayer" cla)
 (setq count (1+ count)                       ; initialize counters for loop
       lp (list (car (polar cp diag r))
                (cadr (polar cp diag r))
                riser
          )
       riser (+ riser el)
       diag (+ ang ang ac)
 )      
)          ; end SPCALC

(defun sbuild ()                                    
 (command "INSERT" blk lp "" "" (rtd ang))
 (setq  lp (list (car (polar cp diag r))
                 (cadr (polar cp diag r))
                 riser)
        count (1+ count)                       ; increment all counters
        ang (+ ang al)
        diag (+ diag al)
        riser (+ riser el)
 )        
 (if (< count case)                            ; get last set of coordinates
   (progn                                      ; to form ending face
     (setq lp2 (list (car (polar cp diag r))
                     (cadr (polar cp diag r))
                     riser)
           lp3 (list (car (polar cp diag (+ r wide)))
                     (cadr (polar cp diag (+ r wide)))
                     riser)
           tl1 (list (car lp2) (cadr lp2)
                     (- (caddr lp2) (/ thi b)))
           tr1 (list (car lp3) (cadr lp3) (- (caddr lp3) (/ thi b)))
     )
   )
 )
)          ; end SBUILD

(defun C:Sp (/ bli cmd cla blksp cp lp riser step wide count hrl blk thi
              lp1 lp2 lp3 lp4 case el rp diag al ang a tr1 tl1)
 (setq bli (getvar "blipmode")
       cmd (getvar "cmdecho")
       cla (getvar "clayer")
 )
 (setvar "blipmode" 0)
 (setvar "cmdecho" 0)
 (spinfo)
 (spcalc)
 (while (< count case)
        (sbuild)
 )
 (command "layer" "s" "spiral" ""                      ; draw ending face
          "3dface" "i" lp3 tr1 "i" tl1 "i" lp2 "")
 (setvar "cecolor" "bylayer")
 (setvar "blipmode" bli)
 (setvar "cmdecho" cmd)
 (setvar "clayer" cla)
 (if (not (equal blksp nil))
     (close blksp)
 )
 (setq blksp
       (open "blksp.lst" "w")
 )
 (write-line blk blksp)
 (close blksp)
 (princ)
)            ; end SP.LSP


Weet niet voor emoticons vandaan komen!!!!!!!!!!


maar er moet staan 18

Het is voor bedoelt om te gebruiken in een 1:100 of 1:20 tekening.Materiaal is niet echt belangrijk maar het gaat er meer om of de trap klopt volgens bouwbesluit.

En het handmatig tekenen van een spiltrap is tijdrovend,dus vandaar mijn vraag.

Groeten Marcel


Ik vond dit op het net (maar kan het nu niet uitproberen daar ik nu niet over AutoCAD beschik)en dit is in 3D.!!!

;SPST.LSP
;Draw spiral stair
;--------------------------------------------------------------------
;Main function
;--------------------------------------------------------------------
(defun c:spst ( / zcmd zblp zosm cn ag0 r1 r2 ag ht rase
                 dag dht ag1 tyn ty rw rn rt p1 p2 p3 p4
                 pa pb b1 b2 b31 b41 b5 b6 b32 b42
                 plist lista listb nr
             )
  (setq zcmd (getvar "cmdecho")
        zblp (getvar "blipmode")
        zosm (getvar "osmode")
  )
  (setvar "cmdecho" 0)
  (initget 1)
  (setq cn  (getpoint "\nCenter:"))
  (initget 1)
  (setq ag0 (getangle cn "\nRotation angle of first step:"))
  (initget 7)
  (setq r1  (getdist cn "\nInner radius:"))
  (initget 7)
  (setq r2  (getdist cn "\nOuter radius:"))
  (initget 3)
  (setq ag  (getreal "\nAngle between first and last steps:"))
  (initget 3)
  (setq ht  (getreal "\nStair height [+ up][- down]:"))
  (initget 7)
  (setq nr  (getint "\nNumber of steps:")
        ag (* pi (/ ag 180.0))
        rase (/ ht nr)
        dag  (/ ag nr)
        dht  (/ ht (1+ nr))
        ag1  (- ag0 dag)
        tyn 8
  )
  (setvar "osmode" 0)
  (setvar "blipmode" 0)
  (initget 1 "A B")
  (setq ty (getkword "\nSpiral stair type <A>:"))
  (initget 5)
  (setq rw (getreal "\nRailing width:"))
  (initget 5)
  (setq rh (getreal "\nRailing height:"))
  (initget 1)
  (if (= ty "A")
      (setq rt (* -1 (getreal "\nRailing thickness:")) tyn 4)
  )
  (repeat (+ nr 1)
    (setq ag1 (+ ag1 dag)
          p1 (polar cn ag1 r1)
          p2 (polar cn ag1 r2)
          p3 (sp p1 dht)
          p4 (sp p2 dht)
    )
    (if (minusp ht)
        (setq pa (sp p1 (* 2 dht))        
              pb (sp p2 (* 2 dht))
        )
        (setq pa (sp p1 (* -1 dht))
              pb (sp p2 (* -1 dht))
        )
    )
    (if (and (equal ag1 ag0 0.001)(null (minusp ht)))
        (setq pa p1 pb p2)
    )
    (if (and (equal ag1 (+ ag0 ag) 0.001)(minusp ht))
        (setq pa (sp p1 dht)
              pb (sp p2 dht)
    ))
    (setq b1 (sp p1 rh)
          b2 (polar b1 ag1 rw)
          b31 (polar p1 ag1 rw)
          b41 (polar cn ag1 (- r2 rw))
          b5 (sp b41 rh)
          b6 (polar b5 ag1 rw)
          b32 (sp b31 dht)
          b42 (sp b41 dht)
    )
    (if (= ty "A")
        (setq plist (append plist (list pa p1 p2 pb pa p3 p4 pb))
              lista (append lista (list b1 b2 (sp b2 rt)(sp b1 rt)))
              listb (append listb (list b5 b6 (sp b6 rt)(sp b5 rt)))
        )
    )
    (if (= ty "B")
        (setq plist (append plist (list pa b1 b2 b31 b41 b5 b6 pb
                                        pa b1 b2 b32 b42 b5 b6 pb))
        )
    )
    (setq cn (list (car cn)(cadr cn)(+ (caddr cn) dht)))
  )
  (setq nr (length plist))
  (command "3dmesh" (/ nr tyn) tyn)
  (repeat nr
     (command (car plist))
     (setq plist (cdr plist))
  )
  (command "")
  (spstnc)
  (if lista
      (progn (setq nr (length lista))
             (command "3dmesh" (/ nr 4) "4")
             (repeat nr (command (car lista))
                        (setq lista (cdr lista))
             )
             (command "")
             (spstnc)
             (command "3dmesh" (/ nr 4) "4")
             (repeat nr (command (car listb))
                        (setq listb (cdr listb))
             )
             (command "")
             (spstnc)
      )
  )
  (setvar "osmode" zosm)
  (setvar "blipmode" zblp)
  (setvar "cmdecho" zcmd)
  (princ)
)
;
;--------------------------------------------------------------------
;Get the point with increment h in Z direction
;--------------------------------------------------------------------
(defun sp ( pt h)
  (list (car pt)(cadr pt)(+ (caddr pt) h))
)
;
;--------------------------------------------------------------------
;Enclose the 3D mesh as the last entity in N direction
;--------------------------------------------------------------------
(defun spstnc ( / en ed )
  (setq en (entlast)
        ed (entget en)
        ed (subst (cons 70 48)(assoc 70 ed) ed)
  )
  (entmod ed)
)
;
;--------------------------------------------------------------------
;Print message
;--------------------------------------------------------------------
;
(princ "\nSPST.LSP loaded. Type SPST to draw spiral stair.")
(princ)