Hallo,
habe ein plug-in für ein cad programm...im cad forum kann mir niemand helfen daher versuchs ich hier kennt sich jemand mit d LISP programier sprache aus? hab einen quelltext der vom englischen ins deutsche übersetzt werden muss....ich scheiter daran kläglich...
LISP Problem
Moderator: pilfi
-
- Batterie8 Landschaft
- Beiträge: 665
- Registriert: Mo 2. Aug 2004, 11:16
- Wohnort: Saarbrücken
Ähm, ist wohl eigentlich das Falsche Forum hier, aber was solls.
Also ich hab eigentlich keine Ahnung von LISP aber Programmieren kann ich ganz gut
. Willst Du die Ausgabetexte übersetzen? Müssten wohl in irgendwelchen textliteralen drinstehen. Ganz ja mal ein Stück Qeulltext posten, oder per PN.
Gruß,
Stephan
Also ich hab eigentlich keine Ahnung von LISP aber Programmieren kann ich ganz gut

Gruß,
Stephan
"Your mouth is talking. You might wanna look to that."
Hallo,
das problem ist das ich nicht die deutschen commands kenne. sonst könnte ich die ja einfach ersetzenmir wurde noch der tipp gegeben doch einfach vor jeden command einen _ zu setzen. aber was ist wenn z.B. command "point" "0,0,0" dort steht? ich glaub ich geb auf........
...hier mal ein bischen wie das so aussieht:
; COMMAND:> MFIT
(vmon) : cause with dos you'll need it
(defun c:MFIT (/ etype dup index que omode ptype prtz part part# parts prt fp dnum XYZpts)
(setq serror *error* *error* merror)
(setq omode (getvar "osmode"))
(setvar "cmdecho" 0)
(setq part 0)
(initget 6)
(if div# (setq facet# (1- div#)) (setq facet# 10))
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum)) ; get facet number
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
(while part ; The big while for selecting entities
(if parts
(setq select (strcat "\nSelect object: " (rtos (length parts) 2 0) " selected\n"))
(setq select "\nSelect object: ")
)
(setq part (entsel select)) ; Select entity for inclusion
(setq prt (car part)) ; Take out entity name
(if part (chkpart)) ; See if it is usable
(if prtz T (setq prtz (list prt))) ; Start a prtz list
(if part
(if etype ; If not useable
(prompt (strcat ", Can't use " etype )) ; Say you're sorry
(progn
(if parts
(if (member prt prtz); see if already in list and ask if intentional
(progn
(prompt "(duplicate)")
(initget "D U")
(setq dup (getkword "\nDiscard/<Use>: "))
(if (= dup "D")
T
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
)
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
(setq parts (list part)) ; start list if not already created
)
)
)
)
; CRUM! Make sure the selection process is done
(if (= part nil)
(progn
(initget "C R U M")
(setq que (getkword "\nContinue/Restart/Undo 1/<Make>: "))
(cond
((= que "C") (setq part 0))
((= que "R") (restart))
((= que "U") (undo))
)
)
)
(if (= parts nil) (setq part 0)) ;This keeps the selection prompt correct
; Make sure they don't overload the 3dmesh command
(if (= (* div# (length parts)) 65536.0) ; check mesh size
(progn
(prompt "\nAmazing! You have reached mesh size limit")
(setq part nil)
)
)
) ;End of the big while
; Collect the points for the mesh
(prompt "\rCollecting points for mesh.")
(setq index 0)
(setvar "osmode" 0)
(setq part# (length parts))
(command "undo" "mark") ; set an undo mark
(command "point" "0,0,0") ; set a last entity
(command "layer" "m" "$$$3D$$$" "") ; create temp layer
(repeat part# ; divide all the parts
(setq part (nth index parts))
(setq prt (car part)
ptype (cdr (assoc 0 (entget prt)))
)
(cond
((= ptype "CIRCLE") (if cirdiv (divcir2) (divcir1)))
((= ptype "ARC") (divarc))
((or (= ptype "LINE") (= ptype "3DLINE")) (divline))
((= ptype "PLINE") (divpline))
((= ptype "POINT") (divpoint))
)
(setq index (1+ index))
) ; finish divides time to move on
;Be polite let them know what's going on.
(prompt "\nBuilding mesh list, please wait...")
(getpoints)
(command "undo" "back") ; Remove unnecessary points and layer
; Ok, let's build that mesh.
(command "3dmesh" part# div#) ; Start 3dmesh command
(setq pt# 0)
(repeat (length XYZpts)
(setq pt1 (nth pt# XYZpts)) ; pull out a point
(command pt1) ; send it to the mesh command
(setq pt# (1+ pt#)) ; move on
)
(setvar "cmdecho" 1)
(setvar "osmode" omode)
(Prompt "\nFinished !")
(princ)
)
für mich reines chinesisch.....
das problem ist das ich nicht die deutschen commands kenne. sonst könnte ich die ja einfach ersetzenmir wurde noch der tipp gegeben doch einfach vor jeden command einen _ zu setzen. aber was ist wenn z.B. command "point" "0,0,0" dort steht? ich glaub ich geb auf........
...hier mal ein bischen wie das so aussieht:
; COMMAND:> MFIT
(vmon) : cause with dos you'll need it
(defun c:MFIT (/ etype dup index que omode ptype prtz part part# parts prt fp dnum XYZpts)
(setq serror *error* *error* merror)
(setq omode (getvar "osmode"))
(setvar "cmdecho" 0)
(setq part 0)
(initget 6)
(if div# (setq facet# (1- div#)) (setq facet# 10))
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum)) ; get facet number
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
(while part ; The big while for selecting entities
(if parts
(setq select (strcat "\nSelect object: " (rtos (length parts) 2 0) " selected\n"))
(setq select "\nSelect object: ")
)
(setq part (entsel select)) ; Select entity for inclusion
(setq prt (car part)) ; Take out entity name
(if part (chkpart)) ; See if it is usable
(if prtz T (setq prtz (list prt))) ; Start a prtz list
(if part
(if etype ; If not useable
(prompt (strcat ", Can't use " etype )) ; Say you're sorry
(progn
(if parts
(if (member prt prtz); see if already in list and ask if intentional
(progn
(prompt "(duplicate)")
(initget "D U")
(setq dup (getkword "\nDiscard/<Use>: "))
(if (= dup "D")
T
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
)
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
(setq parts (list part)) ; start list if not already created
)
)
)
)
; CRUM! Make sure the selection process is done
(if (= part nil)
(progn
(initget "C R U M")
(setq que (getkword "\nContinue/Restart/Undo 1/<Make>: "))
(cond
((= que "C") (setq part 0))
((= que "R") (restart))
((= que "U") (undo))
)
)
)
(if (= parts nil) (setq part 0)) ;This keeps the selection prompt correct
; Make sure they don't overload the 3dmesh command
(if (= (* div# (length parts)) 65536.0) ; check mesh size
(progn
(prompt "\nAmazing! You have reached mesh size limit")
(setq part nil)
)
)
) ;End of the big while
; Collect the points for the mesh
(prompt "\rCollecting points for mesh.")
(setq index 0)
(setvar "osmode" 0)
(setq part# (length parts))
(command "undo" "mark") ; set an undo mark
(command "point" "0,0,0") ; set a last entity
(command "layer" "m" "$$$3D$$$" "") ; create temp layer
(repeat part# ; divide all the parts
(setq part (nth index parts))
(setq prt (car part)
ptype (cdr (assoc 0 (entget prt)))
)
(cond
((= ptype "CIRCLE") (if cirdiv (divcir2) (divcir1)))
((= ptype "ARC") (divarc))
((or (= ptype "LINE") (= ptype "3DLINE")) (divline))
((= ptype "PLINE") (divpline))
((= ptype "POINT") (divpoint))
)
(setq index (1+ index))
) ; finish divides time to move on
;Be polite let them know what's going on.
(prompt "\nBuilding mesh list, please wait...")
(getpoints)
(command "undo" "back") ; Remove unnecessary points and layer
; Ok, let's build that mesh.
(command "3dmesh" part# div#) ; Start 3dmesh command
(setq pt# 0)
(repeat (length XYZpts)
(setq pt1 (nth pt# XYZpts)) ; pull out a point
(command pt1) ; send it to the mesh command
(setq pt# (1+ pt#)) ; move on
)
(setvar "cmdecho" 1)
(setvar "osmode" omode)
(Prompt "\nFinished !")
(princ)
)
für mich reines chinesisch.....

-
- Batterie8 Landschaft
- Beiträge: 665
- Registriert: Mo 2. Aug 2004, 11:16
- Wohnort: Saarbrücken
Sorry ich weiß imer noch nicht, was Du genau übersetzen willst. Sachen wie if und while oder setvar sind Schlüsselworte der Programmiersprache. Die können nicht übersetzt werden.
Alles was hinter einem Strichpunkt steht, sind Kommentare, d.h. sie haben mit der FUnktionalität des Programms an sich nichts zu tun, sondern sind Erklärungen und Hinweise des programmierers.
(setq part (entsel select)) ; Select entity for inclusion
Zeilen wie die folgende scheinen bestimmte Funktionen des CAD-Systems aufzurufen, hier z.B. das setzen einer undo-Markiereung, also wol einem Zeitpunkt bis zu dem man Änderugen rückgängig machen kann:
(command "undo" "mark") ; set an undo mark
Wenn es darum geht diese Commands zu übersetzen, dann wirds schwierig. Eigentlich kann ich mir nicht vorstellen, dass die bei der Lokalisierung des CAD-Systems mit übersetzt wurde. Wenn doch, gibt es womöglich eine Plug-In API Dokomentation, da müsste das dann drin stehen. Sorry mehr kann ich dir leider auch nicht helfen.
Gruß,
Stephan
Alles was hinter einem Strichpunkt steht, sind Kommentare, d.h. sie haben mit der FUnktionalität des Programms an sich nichts zu tun, sondern sind Erklärungen und Hinweise des programmierers.
(setq part (entsel select)) ; Select entity for inclusion
Zeilen wie die folgende scheinen bestimmte Funktionen des CAD-Systems aufzurufen, hier z.B. das setzen einer undo-Markiereung, also wol einem Zeitpunkt bis zu dem man Änderugen rückgängig machen kann:
(command "undo" "mark") ; set an undo mark
Wenn es darum geht diese Commands zu übersetzen, dann wirds schwierig. Eigentlich kann ich mir nicht vorstellen, dass die bei der Lokalisierung des CAD-Systems mit übersetzt wurde. Wenn doch, gibt es womöglich eine Plug-In API Dokomentation, da müsste das dann drin stehen. Sorry mehr kann ich dir leider auch nicht helfen.
Gruß,
Stephan
"Your mouth is talking. You might wanna look to that."
-
- Sollte mal wieder fotografieren...
- Beiträge: 5784
- Registriert: So 8. Jun 2003, 13:22
- Wohnort: Gießelrade/Ostholstein
- Kontaktdaten:
ich stimme schdeffan komplett zu! Ich kann mir auch überhaupt nicht vorstellen, dass die Schnittstellen lokalisiert wurden, weil das ja einen wirklichen mehraufwand bedeutet und nicht wirklich einen nutzen hat. Was hast du denn für Texte bekommen???
Es gibt im Quellcode ja einige Prompts
z.b.
(prompt "\nBuilding mesh list, please wait...")
Kann es sein das du nur die lokalisieren sollst???
Ich finde es aber ziemlich unsauber programmiert wenn man die Lokalisierung durchs quer lesen des Quellcodes machen muss. Da gibt es jawohl einige elegantere Methoden als Building mes list, please wait... da hardcoded reinzuschreiben oder?
me.
Es gibt im Quellcode ja einige Prompts
z.b.
(prompt "\nBuilding mesh list, please wait...")
Kann es sein das du nur die lokalisieren sollst???
Ich finde es aber ziemlich unsauber programmiert wenn man die Lokalisierung durchs quer lesen des Quellcodes machen muss. Da gibt es jawohl einige elegantere Methoden als Building mes list, please wait... da hardcoded reinzuschreiben oder?
me.
ich stell mal den ganzen code rein da ichgerade gesehen hab das in dem teil keine commands sind.
@ beta
ganz so einfach ist es leider nicht. der deutschen version sind die commands wie "divide" oder "pline" oder "duplicate" leider nicht bekannt, daher wurden durch andere ersetzt divide ist nun z.b. teilen kommt in einem code nun "divide" vor so bekomme ich immer die fehlermeldung "unbekannter befehl" englisch kann ich ja daher ist es mir schnuppe ob ich nun divide oder teilen eingebe aber das programm verkraftet zwei sprachen leider nicht... hab auch schon versucht überall den _ vor die commands zu setzen aber auch das klapt leider nicht....
hier noch mal der ganze code....
; MFIT.lsp - Version 1.0 December 11, 1988
; [Release 10 only]
; By Jamie Clay
; Commands: MFIT and CDIR
;
; MFIT = <M>esh <FIT> routine
; This is like a Multi-RULESURF only MFIT will combine closed with open
; entities. This allows you to define and create a complex polymesh by
; selecting a series of entities. Entities must be selected in the order
; you wish to use them within the resulting polymesh. Please see example
; slide MFIT.SLD for reference.
;
; PHONE.DWG is a sample drawing that contains a wire frame and resulting
; polymesh. Another drawing, X29-2a was constructed using MFIT as well.
; <See X292A.ARC here on CIS>
;
; The process is simple. MFIT collects a list of entities then divides them,
; placing the points on a special ($$$3D$$$) layer. The points are then
; collected in a list and fed into the 3dmesh command.
;
; COMMAND:> MFIT
; >> Number of facets <10>:
; This is the smoothing factor for the initial polymesh a higher number will
; give you a smoother result but will take longer to process. It is possible
; that if facet set too high you could run out of node space. (VMON) is set
; on to help eliminate this problem.
;
; >> Select Object:
; This is your prompt to select the entities needed to define the polymesh.
; As the entities are selected the prompt will indicate the number like so;
; >>Select Object: 3 selected
;
; If you select the same entity TWICE you will receive this prompt;
; >> (duplicate)
; >> Discard/<Use>:
; If you hit return it will accept the entity as a member of the list.
;
; When finished with selection process hit return or pick a blank space
; on the screen. You will then see this prompt.
; >> Continue/Restart/Undo 1/<Make>:
; <C>ontinue - will return you to the selection process.
; <R>estart - will clear the selection and start over.
; <U>ndo 1 - will remove the last item selected.
; <M>ake - <default> will make the polymesh.
;
; COMMAND:> DCIR
; >>** Circle divide mode **
; >>Pick point/<Normal>:
; There are times when it is better to divide CIRCLEs at the pick point.
; This command will tell MFIT how you want to divide your circles. <Normal>
; simply applies divide to the circle. If you choose <Pick point> the circle
; will be broken at the pick point, converted into a pline then divided
; using the pick point as the starting point. This may prove essential when
; using a series of circles that are on different UCSs.
(vmon) : cause with dos you'll need it
(defun c:MFIT (/ etype dup index que omode ptype prtz part part# parts prt fp dnum XYZpts)
(setq serror *error* *error* merror)
(setq omode (getvar "osmode"))
(setvar "cmdecho" 0)
(setq part 0)
(initget 6)
(if div# (setq facet# (1- div#)) (setq facet# 10))
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum)) ; get facet number
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
(while part ; The big while for selecting entities
(if parts
(setq select (strcat "\nSelect object: " (rtos (length parts) 2 0) " selected\n"))
(setq select "\nSelect object: ")
)
(setq part (entsel select)) ; Select entity for inclusion
(setq prt (car part)) ; Take out entity name
(if part (chkpart)) ; See if it is usable
(if prtz T (setq prtz (list prt))) ; Start a prtz list
(if part
(if etype ; If not useable
(prompt (strcat ", Can't use " etype )) ; Say you're sorry
(progn
(if parts
(if (member prt prtz); see if already in list and ask if intentional
(progn
(prompt "(duplicate)")
(initget "D U")
(setq dup (getkword "\nDiscard/<Use>: "))
(if (= dup "D")
T
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
)
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
(setq parts (list part)) ; start list if not already created
)
)
)
)
; CRUM! Make sure the selection process is done
(if (= part nil)
(progn
(initget "C R U M")
(setq que (getkword "\nContinue/Restart/Undo 1/<Make>: "))
(cond
((= que "C") (setq part 0))
((= que "R") (restart))
((= que "U") (undo))
)
)
)
(if (= parts nil) (setq part 0)) ;This keeps the selection prompt correct
; Make sure they don't overload the 3dmesh command
(if (= (* div# (length parts)) 65536.0) ; check mesh size
(progn
(prompt "\nAmazing! You have reached mesh size limit")
(setq part nil)
)
)
) ;End of the big while
; Collect the points for the mesh
(prompt "\rCollecting points for mesh.")
(setq index 0)
(setvar "osmode" 0)
(setq part# (length parts))
(command "undo" "mark") ; set an undo mark
(command "point" "0,0,0") ; set a last entity
(command "layer" "m" "$$$3D$$$" "") ; create temp layer
(repeat part# ; divide all the parts
(setq part (nth index parts))
(setq prt (car part)
ptype (cdr (assoc 0 (entget prt)))
)
(cond
((= ptype "CIRCLE") (if cirdiv (divcir2) (divcir1)))
((= ptype "ARC") (divarc))
((or (= ptype "LINE") (= ptype "3DLINE")) (divline))
((= ptype "PLINE") (divpline))
((= ptype "POINT") (divpoint))
)
(setq index (1+ index))
) ; finish divides time to move on
;Be polite let them know what's going on.
(prompt "\nBuilding mesh list, please wait...")
(getpoints)
(command "undo" "back") ; Remove unnecessary points and layer
; Ok, let's build that mesh.
(command "3dmesh" part# div#) ; Start 3dmesh command
(setq pt# 0)
(repeat (length XYZpts)
(setq pt1 (nth pt# XYZpts)) ; pull out a point
(command pt1) ; send it to the mesh command
(setq pt# (1+ pt#)) ; move on
)
(setvar "cmdecho" 1)
(setvar "osmode" omode)
(Prompt "\nFinished !")
(princ)
)
; Small command to set circle division mode.
(defun c:dcir ()
(initget "P N")
(setq cirdiv (getkword "\n** Circle divide mode **\nPick point/<Normal>: "))
(if (= cirdiv "P")
(prompt "\nCircle will be divided at <Pick point> ")
(progn
(setq cirdiv nil)
(prompt "\nCircle will be divided <Normal>")
)
)
(princ)
)
;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
; Defun is in de code! - Supporting defuns in order of creation
; Restart selection process
(defun restart ()
(setq prtz nil parts nil prt nil part 0)
(redraw)
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum))
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
)
; Undo one selection from the main list
(defun undo ()
(redraw (car (reverse prtz)))
(setq parts (reverse (cdr (reverse parts))))
(setq prtz (reverse (cdr (reverse prtz))))
(setq part 0)
)
; Check to make sure the entity selected can be used
(defun chkpart ()
(setq sokay (cdr (assoc 0 (entget prt))))
(if (or (= sokay "LINE") (= sokay "POLYLINE") (= sokay "3DLINE")
(= sokay "CIRCLE") (= sokay "ARC") (= sokay "POINT"))
(setq etype nil)
(setq etype sokay)
)
(if (= sokay "POLYLINE")
(progn
(setq bit (cdr (assoc 70 (entget prt))))
(if (= (logand bit 16) 16)
(setq etype "3d Mesh")
)
)
)
(if (not etype) (redraw prt 3))
)
; Divide a arc as a pline
(defun divarc ()
(command "ucs" "e" prt)
(command "pedit" prt "y" "")
(command "ucs" "p")
(setq prt (entlast))
(setq part (cons prt (cdr part)))
(divpline)
)
; Convert a circle into a pline based on pick point
(defun divcir2 ()
(setq cen (getass 10 prt))
(setq bp1 (trans (cadr part) 1 prt)) ; take the current pick point
(command "ucs" "e" prt) ; move to Entity UCS
(setq ccen (trans (getass 10 prt) prt 1)); change center to entity UCS
(setq radi (getass 40 prt)) ; Get radius of circle
(setq bp1 (trans bp1 prt 1)) ; convert pick point to UCS
(prompt "\n*** Converting circle ") ; Facade for NEAR operation
(command "point" "near" bp1) ; make a break point from pick
(prompt "pline ***") ; end of facade
(setq bp1 (getvar "lastpoint")) ; get value of break point
(command "undo" "1") ; remove last point entity
(setq ang (+ 0.0000001 (angle ccen bp1))); Create angle for polar
(setq bp2 (polar ccen ang radi)) ; Create second break point
(command "break" prt bp1 bp2) ; Break it
(command "pedit" prt "y" "C" "") ; Pedit it and close it
(command "ucs" "p") ; move back to last ucs
(setq prt (entlast)) ; Reset prt
(setq part (cons prt (cdr part))) ; Reset part
(divpline) ; divide it as a pline
)
; Divide a circle as a circle
(defun divcir1 ()
(setq lent (entlast))
(command "ucs" "e" prt)
(command "divide" part (1- div#))
(command "point" (trans (getass 10 (entnext lent)) 0 1))
(command "ucs" "p")
)
; Divide a line or 3dline
(defun divline ()
(command "point" (get10 prt))
(command "divide" part (1- div#))
(setq refpt (trans (cdr (assoc 11 (entget prt))) prt 1))
(command "point" refpt)
)
; Divide plines
(defun divpline ()
(setq lst (entlast)) ; Set last entity
(setq vtx (entnext prt)) ; Find first vertex
(command "ucs" "w") ; Pop up to the real world
(setq plbit (cdr (assoc 70 (entget prt)))) ; What kind of pline is this?
(setq lptA (cdr (assoc 10 (entget vtx)))) ; Set up a last point
(if (= (logand plbit 1 ) 1 ) ; If open place a first vertex point
(command "divide" part (1- div#))
(progn
(command "point" (trans lptA prt 0)) ; first vertex point
(command "divide" part (1- div#))
)
)
;Walk to the end of the pline to find the last vertex point
(while (/= (cdr (assoc 0 (entget (entnext vtx)))) "SEQEND")
(setq vtx (entnext vtx))
(setq vrtx (cdr (assoc 0 (entget vtx))))
(setq lptB (cdr (assoc 10 (entget vtx))))
)
(if (= (logand plbit 5 ) 5) ; if open and spline place last vertex point
(command "point" (cdr (assoc 10 (entget (entnext lst))))) ; if closed
(if (= (logand plbit 1) 1)
(command "point" (trans lptA prt 0)) ; closed pline point
(command "point" (trans lptB prt 0)) ; last vertex point
)
)
(command "ucs" "P") ; back to the way were
(setq refpt (getass 10 (entlast)))
)
; Place points for the single point
(defun divpoint ()
(repeat div#
(command "point" (trans (cdr (assoc 10 (entget prt))) prt 1))
)
)
; Collect the 3dpoints from the divide nodes in the order needed
; to build the mesh. MESH = DIV# x PARTS#
(defun getpoints ()
(setq 3dpts (ssget "x" '((8 . "$$$3d$$$")))) ; collect points
(setq indx 0) ; set index
(repeat (* part# div#)
(setq 10pt (get10 (ssname 3dpts indx))) ; get point value
(setq indx (1+ indx)) ; move index
(if XYZpts
(setq XYZpts (append XYZpts (list 10pt))) ; add point to list
(setq XYZpts (list 10pt)) ; create list if not
)
)
(setq XYZpts (reverse XYZpts)) ; This is so mesh is built in
) ; pick order.
; Get the 3dpoints and trans them if needed
(defun get10 (x)
(if (= (getvar "worlducs") 0)
(trans (cdr (assoc 10 (entget x))) 0 1)
(cdr (assoc 10 (entget x)))
)
)
; Get as assoc member of an entity
(defun getass(x y)
(cdr (assoc x (entget y)))
)
;Define the error of our ways
(defun merror (x)
(redraw)
(princ "\nBoom :> ")
(princ x)
(setq *error* serror) ; return error to system error
(princ)
)
; Were done with the hard part
(prompt "\nC:MFIT - Loaded!")
(princ)
@ beta
ganz so einfach ist es leider nicht. der deutschen version sind die commands wie "divide" oder "pline" oder "duplicate" leider nicht bekannt, daher wurden durch andere ersetzt divide ist nun z.b. teilen kommt in einem code nun "divide" vor so bekomme ich immer die fehlermeldung "unbekannter befehl" englisch kann ich ja daher ist es mir schnuppe ob ich nun divide oder teilen eingebe aber das programm verkraftet zwei sprachen leider nicht... hab auch schon versucht überall den _ vor die commands zu setzen aber auch das klapt leider nicht....
hier noch mal der ganze code....
; MFIT.lsp - Version 1.0 December 11, 1988
; [Release 10 only]
; By Jamie Clay
; Commands: MFIT and CDIR
;
; MFIT = <M>esh <FIT> routine
; This is like a Multi-RULESURF only MFIT will combine closed with open
; entities. This allows you to define and create a complex polymesh by
; selecting a series of entities. Entities must be selected in the order
; you wish to use them within the resulting polymesh. Please see example
; slide MFIT.SLD for reference.
;
; PHONE.DWG is a sample drawing that contains a wire frame and resulting
; polymesh. Another drawing, X29-2a was constructed using MFIT as well.
; <See X292A.ARC here on CIS>
;
; The process is simple. MFIT collects a list of entities then divides them,
; placing the points on a special ($$$3D$$$) layer. The points are then
; collected in a list and fed into the 3dmesh command.
;
; COMMAND:> MFIT
; >> Number of facets <10>:
; This is the smoothing factor for the initial polymesh a higher number will
; give you a smoother result but will take longer to process. It is possible
; that if facet set too high you could run out of node space. (VMON) is set
; on to help eliminate this problem.
;
; >> Select Object:
; This is your prompt to select the entities needed to define the polymesh.
; As the entities are selected the prompt will indicate the number like so;
; >>Select Object: 3 selected
;
; If you select the same entity TWICE you will receive this prompt;
; >> (duplicate)
; >> Discard/<Use>:
; If you hit return it will accept the entity as a member of the list.
;
; When finished with selection process hit return or pick a blank space
; on the screen. You will then see this prompt.
; >> Continue/Restart/Undo 1/<Make>:
; <C>ontinue - will return you to the selection process.
; <R>estart - will clear the selection and start over.
; <U>ndo 1 - will remove the last item selected.
; <M>ake - <default> will make the polymesh.
;
; COMMAND:> DCIR
; >>** Circle divide mode **
; >>Pick point/<Normal>:
; There are times when it is better to divide CIRCLEs at the pick point.
; This command will tell MFIT how you want to divide your circles. <Normal>
; simply applies divide to the circle. If you choose <Pick point> the circle
; will be broken at the pick point, converted into a pline then divided
; using the pick point as the starting point. This may prove essential when
; using a series of circles that are on different UCSs.
(vmon) : cause with dos you'll need it
(defun c:MFIT (/ etype dup index que omode ptype prtz part part# parts prt fp dnum XYZpts)
(setq serror *error* *error* merror)
(setq omode (getvar "osmode"))
(setvar "cmdecho" 0)
(setq part 0)
(initget 6)
(if div# (setq facet# (1- div#)) (setq facet# 10))
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum)) ; get facet number
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
(while part ; The big while for selecting entities
(if parts
(setq select (strcat "\nSelect object: " (rtos (length parts) 2 0) " selected\n"))
(setq select "\nSelect object: ")
)
(setq part (entsel select)) ; Select entity for inclusion
(setq prt (car part)) ; Take out entity name
(if part (chkpart)) ; See if it is usable
(if prtz T (setq prtz (list prt))) ; Start a prtz list
(if part
(if etype ; If not useable
(prompt (strcat ", Can't use " etype )) ; Say you're sorry
(progn
(if parts
(if (member prt prtz); see if already in list and ask if intentional
(progn
(prompt "(duplicate)")
(initget "D U")
(setq dup (getkword "\nDiscard/<Use>: "))
(if (= dup "D")
T
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
)
(progn
(setq parts (append parts (list part))) ; add part to list
(setq prtz (append prtz (list prt)))
)
)
(setq parts (list part)) ; start list if not already created
)
)
)
)
; CRUM! Make sure the selection process is done
(if (= part nil)
(progn
(initget "C R U M")
(setq que (getkword "\nContinue/Restart/Undo 1/<Make>: "))
(cond
((= que "C") (setq part 0))
((= que "R") (restart))
((= que "U") (undo))
)
)
)
(if (= parts nil) (setq part 0)) ;This keeps the selection prompt correct
; Make sure they don't overload the 3dmesh command
(if (= (* div# (length parts)) 65536.0) ; check mesh size
(progn
(prompt "\nAmazing! You have reached mesh size limit")
(setq part nil)
)
)
) ;End of the big while
; Collect the points for the mesh
(prompt "\rCollecting points for mesh.")
(setq index 0)
(setvar "osmode" 0)
(setq part# (length parts))
(command "undo" "mark") ; set an undo mark
(command "point" "0,0,0") ; set a last entity
(command "layer" "m" "$$$3D$$$" "") ; create temp layer
(repeat part# ; divide all the parts
(setq part (nth index parts))
(setq prt (car part)
ptype (cdr (assoc 0 (entget prt)))
)
(cond
((= ptype "CIRCLE") (if cirdiv (divcir2) (divcir1)))
((= ptype "ARC") (divarc))
((or (= ptype "LINE") (= ptype "3DLINE")) (divline))
((= ptype "PLINE") (divpline))
((= ptype "POINT") (divpoint))
)
(setq index (1+ index))
) ; finish divides time to move on
;Be polite let them know what's going on.
(prompt "\nBuilding mesh list, please wait...")
(getpoints)
(command "undo" "back") ; Remove unnecessary points and layer
; Ok, let's build that mesh.
(command "3dmesh" part# div#) ; Start 3dmesh command
(setq pt# 0)
(repeat (length XYZpts)
(setq pt1 (nth pt# XYZpts)) ; pull out a point
(command pt1) ; send it to the mesh command
(setq pt# (1+ pt#)) ; move on
)
(setvar "cmdecho" 1)
(setvar "osmode" omode)
(Prompt "\nFinished !")
(princ)
)
; Small command to set circle division mode.
(defun c:dcir ()
(initget "P N")
(setq cirdiv (getkword "\n** Circle divide mode **\nPick point/<Normal>: "))
(if (= cirdiv "P")
(prompt "\nCircle will be divided at <Pick point> ")
(progn
(setq cirdiv nil)
(prompt "\nCircle will be divided <Normal>")
)
)
(princ)
)
;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
; Defun is in de code! - Supporting defuns in order of creation
; Restart selection process
(defun restart ()
(setq prtz nil parts nil prt nil part 0)
(redraw)
(setq dnum (strcat "\nNumber of facets <" (rtos facet# 2 0) ">: "))
(setq div# (getint dnum))
(if div# (setq div# (1+ div#)) (setq div# (1+ facet#)))
)
; Undo one selection from the main list
(defun undo ()
(redraw (car (reverse prtz)))
(setq parts (reverse (cdr (reverse parts))))
(setq prtz (reverse (cdr (reverse prtz))))
(setq part 0)
)
; Check to make sure the entity selected can be used
(defun chkpart ()
(setq sokay (cdr (assoc 0 (entget prt))))
(if (or (= sokay "LINE") (= sokay "POLYLINE") (= sokay "3DLINE")
(= sokay "CIRCLE") (= sokay "ARC") (= sokay "POINT"))
(setq etype nil)
(setq etype sokay)
)
(if (= sokay "POLYLINE")
(progn
(setq bit (cdr (assoc 70 (entget prt))))
(if (= (logand bit 16) 16)
(setq etype "3d Mesh")
)
)
)
(if (not etype) (redraw prt 3))
)
; Divide a arc as a pline
(defun divarc ()
(command "ucs" "e" prt)
(command "pedit" prt "y" "")
(command "ucs" "p")
(setq prt (entlast))
(setq part (cons prt (cdr part)))
(divpline)
)
; Convert a circle into a pline based on pick point
(defun divcir2 ()
(setq cen (getass 10 prt))
(setq bp1 (trans (cadr part) 1 prt)) ; take the current pick point
(command "ucs" "e" prt) ; move to Entity UCS
(setq ccen (trans (getass 10 prt) prt 1)); change center to entity UCS
(setq radi (getass 40 prt)) ; Get radius of circle
(setq bp1 (trans bp1 prt 1)) ; convert pick point to UCS
(prompt "\n*** Converting circle ") ; Facade for NEAR operation
(command "point" "near" bp1) ; make a break point from pick
(prompt "pline ***") ; end of facade
(setq bp1 (getvar "lastpoint")) ; get value of break point
(command "undo" "1") ; remove last point entity
(setq ang (+ 0.0000001 (angle ccen bp1))); Create angle for polar
(setq bp2 (polar ccen ang radi)) ; Create second break point
(command "break" prt bp1 bp2) ; Break it
(command "pedit" prt "y" "C" "") ; Pedit it and close it
(command "ucs" "p") ; move back to last ucs
(setq prt (entlast)) ; Reset prt
(setq part (cons prt (cdr part))) ; Reset part
(divpline) ; divide it as a pline
)
; Divide a circle as a circle
(defun divcir1 ()
(setq lent (entlast))
(command "ucs" "e" prt)
(command "divide" part (1- div#))
(command "point" (trans (getass 10 (entnext lent)) 0 1))
(command "ucs" "p")
)
; Divide a line or 3dline
(defun divline ()
(command "point" (get10 prt))
(command "divide" part (1- div#))
(setq refpt (trans (cdr (assoc 11 (entget prt))) prt 1))
(command "point" refpt)
)
; Divide plines
(defun divpline ()
(setq lst (entlast)) ; Set last entity
(setq vtx (entnext prt)) ; Find first vertex
(command "ucs" "w") ; Pop up to the real world
(setq plbit (cdr (assoc 70 (entget prt)))) ; What kind of pline is this?
(setq lptA (cdr (assoc 10 (entget vtx)))) ; Set up a last point
(if (= (logand plbit 1 ) 1 ) ; If open place a first vertex point
(command "divide" part (1- div#))
(progn
(command "point" (trans lptA prt 0)) ; first vertex point
(command "divide" part (1- div#))
)
)
;Walk to the end of the pline to find the last vertex point
(while (/= (cdr (assoc 0 (entget (entnext vtx)))) "SEQEND")
(setq vtx (entnext vtx))
(setq vrtx (cdr (assoc 0 (entget vtx))))
(setq lptB (cdr (assoc 10 (entget vtx))))
)
(if (= (logand plbit 5 ) 5) ; if open and spline place last vertex point
(command "point" (cdr (assoc 10 (entget (entnext lst))))) ; if closed
(if (= (logand plbit 1) 1)
(command "point" (trans lptA prt 0)) ; closed pline point
(command "point" (trans lptB prt 0)) ; last vertex point
)
)
(command "ucs" "P") ; back to the way were
(setq refpt (getass 10 (entlast)))
)
; Place points for the single point
(defun divpoint ()
(repeat div#
(command "point" (trans (cdr (assoc 10 (entget prt))) prt 1))
)
)
; Collect the 3dpoints from the divide nodes in the order needed
; to build the mesh. MESH = DIV# x PARTS#
(defun getpoints ()
(setq 3dpts (ssget "x" '((8 . "$$$3d$$$")))) ; collect points
(setq indx 0) ; set index
(repeat (* part# div#)
(setq 10pt (get10 (ssname 3dpts indx))) ; get point value
(setq indx (1+ indx)) ; move index
(if XYZpts
(setq XYZpts (append XYZpts (list 10pt))) ; add point to list
(setq XYZpts (list 10pt)) ; create list if not
)
)
(setq XYZpts (reverse XYZpts)) ; This is so mesh is built in
) ; pick order.
; Get the 3dpoints and trans them if needed
(defun get10 (x)
(if (= (getvar "worlducs") 0)
(trans (cdr (assoc 10 (entget x))) 0 1)
(cdr (assoc 10 (entget x)))
)
)
; Get as assoc member of an entity
(defun getass(x y)
(cdr (assoc x (entget y)))
)
;Define the error of our ways
(defun merror (x)
(redraw)
(princ "\nBoom :> ")
(princ x)
(setq *error* serror) ; return error to system error
(princ)
)
; Were done with the hard part
(prompt "\nC:MFIT - Loaded!")
(princ)
-
- Sollte mal wieder fotografieren...
- Beiträge: 9114
- Registriert: Fr 16. Jul 2004, 13:29
- Wohnort: Ruhrgebiet
- Kontaktdaten:
Re: LISP Problem
Hallo,aa4 hat geschrieben:Hallo,
habe ein plug-in für ein cad programm...im cad forum kann mir niemand helfen daher versuchs ich hier kennt sich jemand mit d LISP programier sprache aus? hab einen quelltext der vom englischen ins deutsche übersetzt werden muss....ich scheiter daran kläglich...
das ist für AutoCAD, oder? Bist Du wirklich sicher, daß Du das übersetzen musst? Hast Du schon die Autodesk Hotline gefragt? Ganz oben im Header steht Release 10 only - ist das noch für das olle ACAD 10, und ist das evtl. das eigentliche Problem? Ist nur so eine Vermutung...
Viele Grüße,
Volker
Zuletzt geändert von volkerm am Sa 11. Sep 2004, 18:07, insgesamt 1-mal geändert.
.. und weg.