Hallo,
Heeft iemand toevallig een lisp beschikbaar voor het maken van dwarsprofielen. Ik heb de lisp-routine ddprof.lsp enkele jaren geleden gedownload van de website van CAD-Magazine. Ik heb hem enkele keren gebruikt, maar de laatste 2 jaar niet meer. Nu wil ik de routine weer gebruiken, maar hij doet het niet meer. Zou dit iets te maken kunnen hebben met het feit dat wij ondertussen met AutoCAD 2004 werken ipv de versie 2002 enkele jaren geleden.
Vandaar mijn vraag of iemand een lisp heeft die ook in 2004 werkt.
Met vriendelijke groet,
Niek
Beste Nikolai, als je die lisp even op de site plaatst, dan kijk ik er wel even naar...
waarschijnlijk enkele aanpassingen nodig....
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;}
}
}
Hallo,
Wat lukt er juist niet :?:
Ik heb geprobeert in 2002 en 2005 en alles gaat.
Kan autocad 2004 bij jullie uw dcl bestand wel vinden.
Mss ligt daar een fout?
MVG
Kenny
Hoi, ik weet niet juist wat er aan de hand is bij jullie, maar bij mij werkt het perfect...
zorg er voor dat je DCL-file wel in een support-map van autocad staat!!!
bij Tools -> Options -> Files -> Support File Search Path
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.
Merci Webracer,
Voor de aanvulling, dat was ik vergeten te vermelden. :lol:
Beste Kenny en Webracer,
Ook namens mij hartelijk bedankt :D.
Groeten,
Nikolai
Deze werkt ook nog in Acad 2010.