c3a's heal

[jo-king]

aangesloten zijnde bij C3A, hebben we toegang tot diens extra's; oa het commando (lisp) HEAL.

dit doet hetvolgende:

; routine         : HEAL.LSP
; omschrijving    : samenvoegen van lijnen op een rechte
; command         : HEAL
; menu            : Modify -> Heal
; datum           : 8 juli 1997
; by              : Eva De Meyer, DFC
; copyright       : CAAA vzw

;(prompt " versie ***  (c) CAAA vzw ... ")
(prompt (DFC_GetLanguageString 210))

(defun C:HEAL (/ a b ss h1 h2 tl p1 p2 p3 p4)
   (newvar)
   ;; 1222 = Select two lines or RETURN for selection by window
   (prompt (strcat "\n" (DFC_GetLanguageString 1222) " ..."))

   ;; 1223 = Select the first line
   (setq a (entsel (strcat "\n" (DFC_GetLanguageString 1223) " :")))
   (if (null a)
    (progn
     ;; 1217 First Point - 1218 Other point
     (setq a (getpoint (strcat "\n" (DFC_GetLanguageString 1217) ": "))
           b (getcorner a (strcat (DFC_GetLanguageString 1218) ": "))
     )
     (command "_erase" (ssget "_w" a b) "")
     (setq ss (ssget "_c" a b '((0 . "LINE"))))
    )
    (progn
     ;; 1224 = Select a second,dominant line
     (setq b (entsel (strcat "\n" (DFC_GetLanguageString 1224) ":")))
     (setq ss (ssadd (car a)))
     (setq ss (ssadd (car b) ss))
    )
   )
   (while (> (sslength ss) 1)
    (setq s1 (ssname ss 0))
    (setq ss (ssdel s1 ss)
          tl (sslength ss)
          e1 (entget s1)
          p1 (dxf 10 e1)
          p2 (dxf 11 e1)
    )
    (while (<= 0 (setq tl (1- tl)))
     (setq s2 (ssname ss tl)
           e2 (entget s2)
           p3 (dxf 10 e2)
           p4 (dxf 11 e2)
     )
     (cond
      ((rechte p1 p2 p3 p4)
       (entdel s1)
       (moddxf 10 (trans p1 1 0) e2)
       (setq tl -1))
      ((rechte p1 p2 p4 p3)
       (entdel s1)
       (moddxf 11 (trans p1 1 0) e2)
       (setq tl -1))
      ((rechte p2 p1 p3 p4)
       (entdel  s1)
       (moddxf 10 (trans p2 1 0) e2)
       (setq tl -1))
      ((rechte p2 p1 p4 p3)
       (entdel s1)
       (moddxf 11 (trans p2 1 0) e2)
       (setq tl -1))
     )
    )
   )
   (oldvar)
)



Probleem hierbij is echter dat wanneer je het commando uitvoert, je SNAP automatisch wordt geactiveerd; en OSNAP ge-deactiveerd (en de instellingen gewist!)
vreselijk als je niet met snap wil werken, dat je dat telkens weer moet uitschakelen na dit commando & je osnaps terug moet defineren.


kan er iemand mij vertellen wat ik moet wijzigen om dit te corrigeren & mijn instellingen laten staan zoals ze stonden VOOR ik het commando uitvoer?


thanks.

jo-KING

/deze lisp is eigendom van CAAA en mag waarschijnlijk niet worden gecopieerd voor externe doeleinden....

[jo-king]

aangesloten zijnde bij C3A, hebben we toegang tot diens extra's; oa het commando (lisp) HEAL.

/knip/

kan er iemand mij vertellen wat ik moet wijzigen om dit te corrigeren & mijn instellingen laten staan zoals ze stonden VOOR ik het commando uitvoer?


thanks.

jo-KING

ik heb zelf even een klein lisp-je gemaakt (mijn eerste!) waarbij hij na het commando JO mijn snap settings opnieuw instelt zoals ik het wens.

(defun C:jo () (command "_osmode" "4287")
(command "_snap" "off")

(princ "\nYour favorite Snaps have been set !!")
(PRINC))

dit commando zet ik mee achteraan de lisp van HEAL, en daardoor heb ik geen probleem meer,
mijn collega's hanteren echter andere osnap-instellingen.
kan ik VOOR de heal-lisp de waarde van _osmode opvragen & na de heal-lisp, deze invullen in mijn "jo"-lisp ?

[Joop]

Met deze code gaat het "beter" en hier rust geen copy-right op. 

Code Selecteer Uitklappen


(defun c:heal()   
   (setq oldsnap (getvar "osmode"))
   (setq L1 (car (entsel "\nSelect first line: ")))
   (setq L2 (car (entsel "\nSelect second line: ")))
   (if (and L1 (= "LINE" (cdr (assoc 0 (entget L1))))
            L2 (= "LINE" (cdr (assoc 0 (entget L2)))))
      (progn         
         (setq B1 (cdr (assoc 10 (entget L1))))
         (setq E1 (cdr (assoc 11 (entget L1))))
         (setq B2 (cdr (assoc 10 (entget L2))))
         (setq E2 (cdr (assoc 11 (entget L2))))
         (if (< (abs (- (angle B1 B2) (angle B1 E2))) 0.0001)
            (progn
               (if (> (distance B1 B2) (distance B1 E2))
                  (setq E2 B2))
               (if (> (distance E2 E1) (distance E2 B1))
                 (setq B1 E1))
               (setq L1 (entget L1))
               (setq B2 (assoc 10 L1))
               (setq E1 (assoc 11 L1))
               (setq L1 (subst (cons 10 B1) B2 L1))
               (setq L1 (subst (cons 11 E2) E1 L1))
               (entdel L2 )
               (entmod L1 )
            )
            (prompt "\nLines are not parallel, function cancelled")
        )                   
      )
      (prompt "Invalid selection")
   )
   (setq L1 nil  B1 nil  E1 nil  L2 nil  B2 nil  E2 nil)
(setvar "osmode" oldsnap)
)




[Reimer]

Ik ben nog niet zo heel erg bekend met lisp maar volgens mij moet je het volgende toevoegen aan het begin van de lisp:
(setq OSNAPS (getvar "osmode"))
en deze regel net voor het einde van de lisp:
(setvar "osmode" OSNAPS)
In de eerste regel worden de bestaande objectsnap instellingen opgeslagen onder de naar OSNAPS (die naam mag je zelf invullen)
In de laatste regel worden de opgeslagen instellingen hersteld.

Reimer

[bart]

Code Selecteer Uitklappen

(DEFUN C:HEAL (/ Ln1 Ln2 Eln1 Eln2 Spln1 Spln2 Epln1 Epln2 Hln1 Hln2 Hlnng Hnew)
(setq Ln1 (entsel "\nSelecteer eerste aan te helen lijn: ")
       Ln2 (entsel "\nSelecteer tweede aan te helen lijn: ")
       Eln1 (entget (car Ln1))  Eln2 (entget (car Ln2)))
(IF (not(eq (car Ln1) (car Ln2)))
(IF (= "LINE" (cdr (assoc 0 Eln1)) (cdr (assoc 0 Eln2)))
     (progn
     (setq Spln1 (cdr (assoc 10 Eln1))  Epln1 (cdr (assoc 11 ELn1))
           Spln2 (cdr (assoc 10 Eln2))  Epln2 (cdr (assoc 11 Eln2))
           Hln1   (angle Spln1 Epln1)
           Hln2   (angle Spln2 Epln2)
           Hlnng  (angle Epln2 Spln2)
           Hnew   (angle Spln1 Epln2))
           (IF (equal Hln1 (* 2 pi) 0.001) (setq Hln1 (- Hln1 (* 2 pi)))
               (IF (>= Hln1 3.14) (setq Hln1 (- Hln1 pi))))
           (IF (equal Hln2 (* 2 pi) 0.001) (setq Hln2 (- Hln2 (* 2 pi)))
               (IF (>= Hln2 3.14) (setq Hln2 (- Hln2 pi))))
           (IF (equal Hlnng (* 2 pi) 0.001) (setq Hlnng (- Hlnng (* 2 pi)))
               (IF (>= Hlnng 3.14) (setq Hlnng (- Hlnng pi))))
           (IF (equal Hnew (* 2 pi) 0.001) (setq Hnew (- Hnew (* 2 pi)))
               (IF (>= Hnew 3.14) (setq Hnew (- Hnew pi))))
     (IF (or (equal Hln1 Hln2 0.001) (equal Hln1 Hlnng 0.001))
         (progn
         (IF (or (equal Hnew Hln2 0.001) (equal Hnew Hlnng 0.001))
             (progn
             (setq Hln1  (abs (distance Spln1 Spln2))
                   Hln2  (abs (distance Spln1 Epln2))
                   Hlnng (abs (distance Epln1 Spln2)))

             (IF (> Hln2 Hln1)  (setq Spln2 Epln2))
             (IF (> Hlnng Hln1) (setq Spln1 Epln1))

             (setq Eln1 (subst (cons 10 Spln1) (assoc 10 Eln1) Eln1)
                   Eln1 (subst (cons 11 Spln2) (assoc 11 Eln1) Eln1))
             (entdel (car Ln2))
             (entmod Eln1)
             )
             (prompt "\nLijnen niet in elkaars verlengde!\n")
         )
         )
         (prompt "\nLijnen snijden elkaar!\n")
     )
     )
     (prompt "\nMinstens een entity is geen lijn!\n")
)
(prompt "\nDeze lijnen zijn al een entiteit.")
)
(princ)
)
;----------------------------------------------------------------------


hier nog een is nog van versie 10 wel een paar keer aangepast