CADsite forum

Hey webracer,

Inderdaad. Wat stom van ons. We hadden inderdaad het het support file search path niet aangegeven.
Stom, stom, stom.

Hartstikke bedankt in elk geval voor de moeite. Nu doet die het wel.


Groeten,

PTonthemove.

Hallo Webracer,

Ik ben een collega van Nikolai en hieronder de lisp. Hopelijk kun je ons snel helpen, want we zitten er enorm om verlegen.


Groetjes,

PTonthemove.



DDPROF.lsp:

;;; DDPROF.LSP
;;; Profielprogramma, tekent een dwarsprofiel op een
;;; vooraf aangegeven plaats in de tekening.
;;; Gebruikt DDPROF.DCL.
;;; Peter Poeliejoe, 26-04-99
;;; 05-06-2002 Object snap tijdelijk uitgezet
;;; 09-07-2002 text voor lengte vervangen door block met attribuut
;;;            t.b.v. updaten met lu.lsp. Maten aangepast aan texthoogte
;;;            van 2,5 mm. Texthoogte vastgezet op 2,5 mm.
;;; 
;;;
;;;
(defun myerror (e)
   (if (/= e "Function cancelled") (princ (strcat "\nError:" e)))
   (setvar "CMDECHO" 1)
   (command "-LAYER" "S" oldlay "")
   (setvar "CELTYPE" "BYLAYER")
   (setvar "DIMZIN" dimtmp)
   (setvar "OSMODE" om)
   (setvar "ATTDIA" 1)
   (setq *error* olderr)
   (princ)
)


(defun do_settings ()
   (setq olderr *error* *error* myerror)
   (setvar "CMDECHO" 0)
   (setq dimtmp (getvar "DIMZIN"))
   (setvar "DIMZIN" 0)
   (setq bm (getvar "BLIPMODE"))
   (setvar "BLIPMODE" 0)
   (setq om (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   (setq an (angle '(0 0) '(10 0)))
   (setvar "ATTDIA" 0)
   (setq oldlay (getvar "CLAYER"))
   (command "STYLE" "STANDARD" "isocp.shx" "0" "1" "0" "N" "N")
   (if (null (tblsearch "LTYPE" "CENTER"))
         (command "-LINETYPE" "L" "CENTER" "ACAD" ""))
   (setq schlist (list "50.0" "100.0" "200.0" "250.0" "500.0" "1000.0"))
   (setq hschlist (list "1.0" "2.0" "2.5" "4.0" "5.0"))
   (if (null eenheid) (setq eenheid 1000.0))
   (if (null onderhgt) (setq onderhgt 0.0))
   (if (null txthgt) (setq txthgt 2.50))
   (if (null sch) (setq sch 500.0))
   (if (null schnr) (setq schnr 4))
   (if (null hsch) (setq hsch 1.0))
   (if (null schaal) (setq schaal (/ sch eenheid)))
   (if (null txthoogte) (setq txthoogte (* txthgt schaal)))
   (setq factor 1.0)
   (setq laagnaam "0")
   (setq beginafstand 0.00)
   (if (null afsttxt) (setq afsttxt "Afstand in meters"))
   (if (null hgttxt) (setq hgttxt "Hoogte in meters t.o.v. NAP"))
   (if (null hoektxt) (setq hoektxt "Knikpunt in graden"))
)


(defun maaklayerlist ()
   (setq laagnaam (cdr (assoc 2 (tblnext "LAYER" T))))
   (setq laaglist (list laagnaam))
   (setq laag (tblnext "LAYER"))
   (while laag
      (setq laagnaam (cdr (assoc 2 laag)))
      (setq laaglist (append (list laagnaam) laaglist))
      (setq laag (tblnext "LAYER"))
   )
   (setq laaglist (acad_strlsort laaglist))
)

;; Zet de dialoogbox op
;;
(defun prof_dialog ()
   (setq dcl_id (load_dialog "ddprof.dcl"))
   (if (not (new_dialog "ddprof" dcl_id))(exit))
   (start_list "sch_list")
   (mapcar 'add_list schlist)
   (end_list)
   (start_list "hsch_list")
   (mapcar 'add_list hschlist)
   (end_list)
   (start_list "layer_list")
   (mapcar 'add_list laaglist)
   (end_list)
   (set_tile "begin_afstand" (rtos beginafstand 2 2))
   (set_tile "txt_afstand" afsttxt)
   (set_tile "txt_hoogte" hgttxt)
   (set_tile "txt_hoek" hoektxt)
   (if txthoogte (set_tile "hgt_text2" (rtos txthoogte 2 2)))
   (set_tile "hgt_onder" (rtos onderhgt 2 2))
   (set_tile "sch_list" (itoa schnr))
   (set_tile "hgt_text2" (rtos txthoogte 2 2))
   (set_tile "hsch_list" "0")
   (if (= eenheid 1000.0)
      (set_tile "unit_m" "1")
      (set_tile "unit_mm" "1")
   )
   (action_tile "layer_list"    "(set_layer (atoi $value))")
   (action_tile "sch_list"      "(setq schnr (atoi $value))(ber_txt)")
   (action_tile "hsch_list"     "(ber_fct (atoi $value))")
   (action_tile "unit_m"        "(setq eenheid 1000.0)(ber_txt)")
   (action_tile "unit_mm"       "(setq eenheid 1.0)(ber_txt)")
   (action_tile "begin_afstand" "(setq beginafstand (atof $value))")
   (action_tile "hgt_onder"     "(setq onderhgt (atof $value))")
   (action_tile "hgt_text"      "(setq txthgt (atof $value))(ber_txt)")
   (action_tile "txt_afstand"   "(setq afsttxt $value)")
   (action_tile "txt_hoogte"    "(setq hgttxt $value)")
   (action_tile "txt_hoek"      "(setq hoektxt $value)")
   (action_tile "cancel"        "(setq door nil)(done_dialog)")
   (action_tile "accept"        "(setq door T)(done_dialog)")
   (start_dialog)
   (unload_dialog dcl_id)
)

(defun set_layer (laagnr)
   (setq laagnaam (nth laagnr laaglist))
)


(defun ber_fct (hschnr)
   (setq factor (atof (nth hschnr hschlist)))
)

;;
;; Bereken de texthoogte
;;
(defun ber_txt ()
   (setq sch (atof (nth schnr schlist)))
   (setq schaal (/ sch eenheid))
   (setq txthoogte (* txthgt schaal))
   (set_tile "hgt_text2" (rtos txthoogte 2 2))
   (setvar "TEXTSIZE" txthoogte)
)

;;
;; Maak het blok aan voor de afstandtext
;;
(defun maak_afstand_blok ()
   (entmake '((0 . "BLOCK") (2 . "PROF_AFST") (70 . 2) (10 0.0 0.0 0.0)))
   (entmake '((0 . "POINT") (8 . "0") (10 0.0 0.0 0.0)))
   (entmake '((0 . "ATTDEF") (8 . "0") (10 -0.6 0.6 0.0) (40 . 2.5) (1 . "")
      (7 . "STANDARD") (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 1.5708)
      (3 . "Afstand in profiel") (2 . "A_PROFIEL") (70 . 0) (73 . 0) (74 . 0))
   )
   (entmake '((0 . "ENDBLK")))
)

;;
;; Teken het profiel
;;
(defun teken()
  (command "-LAYER" "S" laagnaam "")
   (setq startpt (getpoint "\nGeef de plaats voor het profiel: ")
         nul_x (car startpt)
         nul_y (cadr startpt)
         nap (+ onderhgt nul_y)
   )
   ;; Tekenen van het kadertje met teksten
   (command "LINE" startpt
      (list (- nul_x (* 50.0 schaal)) nul_y)
      (list (- nul_x (* 50.0 schaal)) (- nul_y (* 30.0 schaal)))
      (list nul_x (- nul_y (* 30.0 schaal))) "")
   (command "LINE"
      (list (- nul_x (* 50.0 schaal)) (- nul_y (* 10.0 schaal)))
      (list nul_x (- nul_y (* 10.0 schaal))) "")
   (command "LINE"
      (list (- nul_x (* 50.0 schaal)) (- nul_y (* 20.0 schaal)))
      (list nul_x (- nul_y (* 20.0 schaal))) "")
   (command "TEXT" (list (- nul_x (* 48.0 schaal)) (- nul_y (* 7.0 schaal)))
         txthoogte "0" hgttxt)
   (command "TEXT" (list (- nul_x (* 48.0 schaal)) (- nul_y (* 17.0 schaal)))
         txthoogte "0" afsttxt)
   (command "TEXT" (list (- nul_x (* 48.0 schaal)) (- nul_y (* 27.0 schaal)))
         txthoogte "0" hoektxt)
   (command "TEXT" (list (- nul_x (* 7.0 schaal)) (+ nap (* 1.0 schaal)))
            txthoogte "0" "NAP")
   ;; Eerste punt selecteren en tekenen
   (while (not (setq txt1 (entsel "\nSelecteer eerste hoogtetekst: "))))
   (setq entd (entget (car txt1))
         p1 (list (cadr (assoc 10 entd)) (caddr (assoc 10 entd)))
         h1 (atof (cdr (assoc 1 entd)))
         txtpth (list (- nul_x (* 0.6 schaal)) (- nul_y (* 9.4 schaal)))  ; punt hoogtetext
         txtptl (list nul_x (- nul_y (* 20.0 schaal)))                    ; punt afstandtext
         txtpta (list (- nul_x (* 0.5 schaal)) (- nul_y (* 27.0 schaal))) ; punt hoek
         q1 (list nul_x (+ nap (* h1 factor)))
   )
   (command "LINE" q1 (list nul_x (- nul_y (* 30.0 schaal))) "")
   (command "TEXT" txtpth txthoogte "90" (rtos h1 2 2))
   (command "INSERT" "PROF_AFST" txtptl schaal "" "0" (rtos beginafstand 2 2))
   ;; Invoer en tekenen van het profiel
   (initget 1 "Einde")
   (setq txt2 (entsel "\nEinde/<Selecteer volgende hoogtetekst>: "))
   (setq l1 0.0
         h2 h1)
   (while (and (/= txt2 "Einde") (/= txt2 nil))
      (setq entd (entget (car txt2))
            p2 (list (cadr (assoc 10 entd)) (caddr (assoc 10 entd)))
            h2 (atof (cdr (assoc 1 entd)))
            l1 (+ l1 (distance p1 p2))
            q2 (list (+ nul_x l1) (+ nap (* h2 factor)))
            an2 (* 180.0 (/ (angle p1 p2) pi))
      )
      (if (> an2 180.0) (setq an2 (- an2 360.0)))
      (if (= eenheid 1000.0)
         (setq txt_afst (rtos (+ beginafstand l1) 2 2))
         (setq txt_afst (rtos (+ beginafstand (/ l1 1000.0)) 2.2))
      )
      (command "LINE" p1 p2 "")
      (command "LINE" q1 q2 "")
      (setq txtpth (polar txtpth an (distance p1 p2)))
      (setq txtptl (polar txtptl an (distance p1 p2)))
      (command "LINE" q2 (list (+ nul_x l1) (- nul_y (* 20.0 schaal))) "")
      (command "TEXT" txtpth txthoogte "90" (rtos h2 2 2))
      (command "INSERT" "PROF_AFST" txtptl schaal "" "0" txt_afst)
      (if (and an1 an2)
         (command "TEXT" txtpta txthoogte "0" (strcat
            (rtos (abs (- an1 an2)) 2 0) "%%d"))
      )
      (setq txtpta (polar txtpta an (distance p1 p2)))
      (setq p1 p2
            q1 q2
            h1 h2
            an1 an2)
      (initget 1 "Einde")
      (setq txt2 (entsel "\nEinde/<Selecteer volgende hoogtetekst>: "))
   );while
   (command "LINE"
      (list nul_x (- nul_y (* 20.0 schaal)))
      (list (car q2) (- nul_y (* 20.0 schaal))) "")
   (command "LINE"
      (list nul_x (- nul_y (* 10.0 schaal)))
      (list (car q2) (- nul_y (* 10.0 schaal))) "")
   (command "LINE"
      (list nul_x (- nul_y (* 30.0 schaal)))
      (list (car q2) (- nul_y (* 30.0 schaal)))
      (list (car q2) (- nul_y (* 20.0 schaal))) "")
   (command "LINE"
      (list nul_x nul_y )
      (list (car q2) nul_y) "")
   (setvar "CELTYPE" "CENTER")
   (command "LINE" (list (- nul_x (* 7.0 schaal)) nap) (list (car q2) nap) "")
   (setvar "CELTYPE" "BYLAYER")
   (command "TEXT" (list (+ (car q2) (* 2.0 schaal)) nul_y)
         txthoogte "0" (strcat "Lengteschaal 1 : " (rtos sch 2 0)))
   (command "TEXT" "" (strcat "Hoogteschaal 1 : " (rtos (/ sch factor) 2 0)))
)

;;
;; De hoofdroutine
;;
(defun C:DDPROF (/ nul_x nul_y startpt nap txt1 txt2 entd p1 p2 h1 h2 q1 q2
                 txtpth txtptl factor l1 txt_afst an an1 an2 om bm dimtmp oldlay
                 schlist hschlist laagnaam laaglist laag)
   (do_settings)
   (maaklayerlist)
   (prof_dialog)
   (maak_afstand_blok)
   (if door (teken))
   (command "-LAYER" "S" oldlay "")
   (setvar "BLIPMODE" bm)
   (setvar "CELTYPE" "BYLAYER")
   (setvar "DIMZIN" dimtmp)
   (setq *error* olderr)
   (setvar "OSMODE" om)
   (setvar "ATTDIA" 1)
   (setvar "CMDECHO" 1)
   (princ)
)


DDPROF.dcl:

// DDPROF.DCL
// DCL file behorende bij DDPROF.LSP
// Peter Poeliejoe, 26-4-99 20:36

dcl_settings : default_dcl_settings { audit_level = 3; }

ddprof : dialog {
  label = "Dwarsprofiel";
    : column {
      : popup_list {
             label = "Layer:";
             key = "layer_list";
             edit_width = 32;
      }
      : popup_list {
             label = "Horizontale schaal:";
             key = "sch_list";
             edit_width = 14;
      }
      : popup_list {
             label = "Verticale vermenigvuldigingsfactor:";
             key = "hsch_list";
             edit_width = 14;
      }
      : boxed_radio_row {
         label = "Units";
         : radio_button {
              key = "unit_mm";
              label = "Millimeters";
         }
         : radio_button {
              key = "unit_m";
              label = "Meters";
         }
      } // einde radio_row1
      : edit_box {
         label = "Beginafstand:";
         key = "begin_afstand";
         edit_width = 7;
         edit_limit = 7;
      }
      : edit_box {
         label = "Hoogte NAP lijn boven balk:";
         key = "hgt_onder";
         edit_width = 7;
         edit_limit = 7;
      }
      : edit_box {
         label = "Tekst in afstandsbalk:";
         key = "txt_afstand";
         edit_width = 30;
         edit_limit = 30;
      }
      : edit_box {
         label = "Tekst in hoogtebalk:";
         key = "txt_hoogte";
         edit_width = 30;
         edit_limit = 30;
      }
      : edit_box {
         label = "Tekst in hoekbalk:";
         key = "txt_hoek";
         edit_width = 30;
         edit_limit = 30;
      }
  //    : edit_box {
  //       label = "Gewenste Teksthoogte:";
  //       key = "hgt_text";
  //       edit_width = 7;
  //       edit_limit = 7;
  //    }
      : concatenation {
         : text_part {
             label = "Resulterende Teksthoogte: ";
         }
         : text_part {
             key = "hgt_text2";
             width = 7;
         }
      }
    } // einde column2
  spacer_1;
  : row {
    : spacer { width = 1; }
    : button {
      label = "OK";
      is_accept = true;
      key = "accept";
      width = 8;
      fixed_width = true;
    }
    : button {
      label = "Stoppen";
      is_cancel = true;
      key = "cancel";
      width = 8;
      fixed_width = true;
    }
    : spacer { width = 1;}
  }
}