Author Topic: Why is this REPEAt not working?  (Read 2599 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1304
Why is this REPEAt not working?
« on: September 27, 2014, 04:07:13 AM »
I want to change the ARC for Revcloud so I used 2 Subroutine
- IsRevcloud to check if the object revcloud or no
- PSimple to remove unneeded vertex
The lisp working fine for one object, but REPEAT not working.

Code: [Select]
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(Defun c:dr ( / )
 
  (setq scl 125 )
  (setq Reversedirection "NO")
  (setq i -1)
  (if (setq s (ssget '((0 . "*LINE"))))
    (progn
    (repeat (sslength s)
      (setq e (ssname s (setq i (1+ i))))
  (if (IsRevcloud e)
    (progn
      (setq en  (entget e)
    en  (subst '(42 . 0) (assoc 42 en) en)     )
      (setq e (entmod en))
      (setq en (cdr (car e)))
      (setq enn (PSimple en))
      (command "REVCLOUD" "ARC" scl scl "Object" en Reversedirection)
      )
    )
  )
    )
    )
  )

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;


;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

;;;=======================[ PSimple.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.7 Nov. 23, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths
;;;=============================================================
;; This version will remove the first vertex if it is colinear
;; and first & last arcs that have the same center
;; Open plines that have the same start & end point will be closed

;;  Argument: et
;;    may be an ename, Vla-Object, list of enames or
;;    a selection set
;;  Returns: a list, (ename message)
;;    Massage is number of vertex removed or error message string
;;    If a list or selection set a list of lists is returned
(defun PSimple (et / doc result Tan Replace BulgeCenter RemoveNlst ps1)
  (vl-load-com)

  (defun tan (a) (/ (sin a) (cos a)))

  (defun replace (lst i itm)
    (setq i (1+ i))
    (mapcar '(lambda (x) (if (zerop (setq i (1- i))) itm x)) lst)
  )

 
  ;;  CAB 11.16.07
  ;;  Remove based on pointer list
  (defun RemoveNlst (nlst lst)
    (setq i -1)
    (vl-remove-if  '(lambda (x) (not (null (vl-position (setq i (1+ i)) nlst)))) lst)
  )
 
  (defun BulgeCenter (bulge p1 p2 / delta chord radius center)
    (setq delta  (* (atan bulge) 4)
          chord  (distance p1 p2)
          radius (/ chord (sin (/ delta 2)) 2)
          center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
    )
  )

  ;;  Main function to remove vertex
  ;;  ent must be an ename of a LWPolyline
  (defun ps1 (ent /      aa     cpt    dir    doc    elst   hlst   Remove
                  idx    keep   len    newb   result vlst   x      closed
                  d10    d40    d41    d42    hlst   p1     p2     p3
                  plast  msg)
      ;;=====================================================
      (setq elst (entget ent)
            msg  "")
      (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
      (if (> (length d10) 2)
        (progn
          ;;  seperate vertex data
          (setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst))
          (setq d41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst))
          (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
          ;;  remove extra vertex from point list
          (setq plast (1- (length d10)))
          (setq p1 0  p2 1  p3 2)
          (if (and (not (setq closed (vlax-curve-isclosed ent)))
                   (equal (car d10) (last d10) 1e-6))
            (progn
              (setq Closed t ; close the pline
                    elst (subst (cons 70 (1+(cdr(assoc 70 elst))))(assoc 70 elst) elst)
                    msg  " Closed and")
              (if (and (not(zerop (nth plast d42)))(not(zerop (nth 0 d42))))
                (setq d10 (reverse(cdr(reverse d10)))
                      d40 (reverse(cdr(reverse d40)))
                      d41 (reverse(cdr(reverse d41)))
                      d42 (reverse(cdr(reverse d42)))
                      plast (1- plast)
                )
              )
            )
          )
          (setq idx -1)
          (while (<= (setq idx (1+ idx)) (if closed (+ plast 2) (- plast 2)))
            (cond
              ((and (or (equal (angle (nth p1 d10) (nth p2 d10))
                               (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                        (equal (nth p1 d10) (nth p2 d10) 1e-6)
                        (equal (nth p2 d10) (nth p3 d10) 1e-6))
                    (zerop (nth p2 d42))
                    (or (= p1 plast)
                        (zerop (nth p1 d42)))
               )
               (setq remove (cons p2 remove)) ; build a pointer list
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              ((and (not (zerop (nth p2 d42)))
                    (or closed (/= p1 plast))
                    (not (zerop (nth p1 d42))) ; got two arcs
                    (equal
                      (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                      (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                      1e-4)
               )
               ;;  combine the arcs
               (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                     newb (tan (/ aa 4.0))
               )
               (if (minusp (nth p1 d42))
                 (setq newb (- (abs newb)))
                 (setq newb (abs newb))
               )
               (setq remove (cons p2 remove)) ; build a pointer list
               (setq d42 (replace d42 p1 newb))
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              (t
               (setq p1 p2
                     p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
            )
          )
          (if remove
            (progn
              (setq count (length d10))
              ;; Rebuild the vertex data with pt, start & end width, bulge
              (setq d10 (RemoveNlst remove d10)
                    d40 (RemoveNlst remove d40)
                    d41 (RemoveNlst remove d41)
                    d42 (RemoveNlst remove d42)
              )
              (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                        x  y
                                        (cons 42 z))) d10 d40 d41 d42)
              )
              ;;  rebuild the entity data with new vertex data
              (setq hlst (vl-remove-if
                           '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
              )
              (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
              (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
              (if (entmod hlst); return ename and number of vertex removed
                (list ent (strcat msg " Vertex removed " (itoa(- count (length d10)))))
                (list ent " Error, may be on locked layer.")
              )
            )
            (list ent "Nothing to remove - no colenier vertex.")
          )
        )
        (list ent "Nothing to do - Only two vertex.")
      )
    )
 

  ;;  ========  S T A R T   H E R E  ===========
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (cond
    ((or (=(type et) 'ENAME)
         (and (=(type et) 'VLA-object)
              (setq et (vlax-vla-object->ename et))))
      (vla-startundomark doc)
      (setq result (ps1 et))
      (vla-endundomark doc)
     )
    ((= (type et) 'PICKSET)
      (vla-startundomark doc)
      (setq result (mapcar '(lambda(x) (ps1 x))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (vla-endundomark doc)
    )
    ((listp et)
      (vla-startundomark doc)
      (setq result (mapcar '(lambda(x) (ps1 x)) et))
      (vla-endundomark doc)
    )
    ((setq result "PSimple Error - Wrong Data Type."))
  )
  result
)
(prompt "\nPline Simplify loaded, PSimple to run.")
(princ)
   

 


  ;| ====== IsRevClode ==========
* EN
* Function defines, whether draw a polyline a command _Revcloud
* the Polyline is considered Revcloud if:
  1. It LW a polyline
  2. All segments of a polyline arc
  3. Coordinates of the centers of these segments do not coincide
  4. Curvature of arc segments is identical as on a sign, and numerically
Arguments:
 pl - a name (ENAME) or object (VLA-OBJECT) polylines
Return:
 T - if a polyline satisfies to the listed conditions
 nil - in all other cases
Example of use
(IsRevcloud (car (entsel)))


* RUS
* ??????? ??????????, ?????????? ?? ????????? ???????? _Revcloud
* ????????? ????????? ???????????? ????????  _Revcloud ????:
  1. ??? LW ?????????
  2. ??? ???????? ????????? ???????
  3. ?????????? ??????? ???? ????????? ?? ?????????
  4. ???????? ??????? ????????? ????????? ??? ?? ?????, ??? ? ????????
?????????:
 pl - ??? (ENAME) ??? ?????? (VLA-OBJECT) ?????????
???????:
 T - ???? ????????? ????????????? ????????????? ????????
 nil - ?? ???? ?????? ???????
?????? ?????????????
(IsRevcloud (car(entsel)))
|;
(defun IsRevcloud ( pl / st-en-bulge->center ed crs bulge_list bulge_log center)
;| EN
Helper function st-en-bulge-> center
* the Author the Pastuh
* It is published: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=37164rO
* Purpose
* Receives coordinates of the center of the arch set by points of the beginning, the end and size bulge.
* thus, position of a point of the center is defined so that detour of initial, final points of an arch and
* the received point of the center occured in a direction counter-clockwise.
Arguments:
Point [list] - a point of the beginning of a segment
      p2 = Point [list] - a point of the end of a segment
st - Point [list] - a bidimentional point of the beginning of an arch,
en - Point [list] - a bidimentional point of the end of an arch,
bulg - a tangent 1/4 central corners of an arch (bulge).
Return:
Bidimentional coordinates of a point of the center.
nil if points of the beginning and the end of an arch coincide.
nil if camber is set equal to zero.
|;
 
;| RUS
?????????????? ?-???  st-en-bulge->center
* ????? ??????
* ????????????: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=37164rO
* ??????????
* ???????? ?????????? ?????? ????, ???????? ??????? ??????, ????? ? ????????? ?????????? (bulge).
* ??? ????, ????????? ????? ?????? ???????????? ???, ????? ????? ?????????, ???????? ????? ???? ?
* ?????????? ????? ?????? ?????????? ? ??????????? ?????? ??????? ???????.
?????????:
Point[list] - ????? ?????? ????????
      p2 = Point[list] - ????? ????? ????????
st - Point[list] - ????????? ????? ?????? ????,
en - Point[list] - ????????? ????? ????? ????,
bulg - ??????? 1/4 ???????????? ???? ???? (bulge).
???????:
????????? ?????????? ????? ??????.
nil, ???? ????????? ????? ?????? ? ????? ????.
nil, ???? ?????????? ?????? ?????? ????.
|;
(defun st-en-bulge->center (st
          en
          bulg
            /
          a sina cosa 1-cosa
          b1 b2
          d d1 d2
          )
  (setq a (* (atan bulg) 4.0) sina (sin a) cosa (cos a) 1-cosa (- 1 cosa))
  (cond
    ((equal st en 1e-12) nil);
    ((equal 1-cosa 0.0 1e-12) nil);
    (T
     (setq b1 (+ (- (car en) (* (car st) cosa)) (* (cadr st) sina))
     b2 (- (cadr en) (* (car st) sina) (* (cadr st) cosa))
     d (* 2 1-cosa)
     d1 (- (* b1 1-cosa) (* b2 sina))
     d2 (+ (* b2 1-cosa) (* b1 sina))
     );
     (list (/ d1 d) (/ d2 d));
    );
  ); end cond.
); end defun.
 
(and
  (if (eq (type pl) 'VLA-OBJECT)
   (setq pl (vlax-vla-object->ename pl))
   pl
    )
(wcmatch (cdr(assoc 0 (setq ed (entget pl)))) "LWPOLYLINE")
(setq ed (entget pl))
(setq crs (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) ed)))
(setq bulge_list (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 42)) ed)))
(if (= (logand (cdr(assoc 70 ed)) 1) 1)
  (setq crs (append crs (list (car crs))))
  (setq bulge_list (reverse(cdr(reverse bulge_list)))) ;_???? ?? ????????? ??????, ??????? ????????? bulge
                                                       ;_If not closed PLINE, we delete last bulge
  )
(setq bulge_log (mapcar 'zerop bulge_list))
(not(apply 'or bulge_log)) ;_??? ??????? ????????
                           ;_All arc segments
(apply 'and (mapcar '(lambda(x)(equal x (car bulge_list) 1e-6)) bulge_list)) ;_????? ???????? ??? (??????? 1/4 ????)
                                                                             ;_ Equal curvature of arches (the Tangent 1/4 corners)
(setq center (mapcar '(lambda(st pl blg)(st-en-bulge->center st pl blg)) crs (cdr crs) bulge_list))
(not (apply 'and (mapcar '(lambda(x)(equal x (car center) 1e-6)) center))) ;_?????? ???. ????????? ?? ?????????
                                                                           ;_ The centers of arc segments do not coincide
)
  )
    ;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
Re: Why is this REPEAt not working?
« Reply #1 on: September 27, 2014, 04:21:42 AM »
Try localizing the variable i in ALL functions and subs. Better still: localize ALL variables.

ribarm

  • Water Moccasin
  • Posts: 2126
  • Marko Ribar, architect
Re: Why is this REPEAt not working?
« Reply #2 on: September 27, 2014, 05:10:13 AM »
Here I fixed it... It was sub inside "PSimple" that incremented variable "i" - changed to "in" and localized it in main function...

Code: [Select]
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

  (defun c:dr ( / scl reversedirection i s e en enn in )
   
    (setq scl 125.0)
    (setq reversedirection "NO")
    (setq i -1)
    (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
      (repeat (sslength s)
        (setq e (ssname s (setq i (1+ i))))
        (if (isrevcloud e)
          (progn
            (setq en  (entget e)
                  en  (subst '(42 . 0) (assoc 42 en) en)
            )
            (setq e (entmod en))
            (setq en (cdr (car e)))
            (setq enn (psimple en))
            (command "_.REVCLOUD" "_Arc" scl scl "_Object" en reversedirection)
          )
        )
      )
    )
    (princ)
  )

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;


;     q_|_|| _\|| q_|| _\|     ;
;      Subroutines Start       ;

  ;;;=======================[ PSimple.lsp ]=======================
  ;;; Author: Charles Alan Butler
  ;;; Version:  1.7 Nov. 23, 2007
  ;;; Purpose: To remove unnecessary vertex from a pline
  ;;; Supports arcs and varying widths
  ;;;=============================================================
  ;; This version will remove the first vertex if it is colinear
  ;; and first & last arcs that have the same center
  ;; Open plines that have the same start & end point will be closed

  ;;  Argument: et
  ;;    may be an ename, Vla-Object, list of enames or
  ;;    a selection set
  ;;  Returns: a list, (ename message)
  ;;    Massage is number of vertex removed or error message string
  ;;    If a list or selection set a list of lists is returned

  (defun PSimple ( et / doc result Tan Replace BulgeCenter RemoveNlst ps1 )

    (vl-load-com)

    (defun tan ( a ) (/ (sin a) (cos a)))

    (defun replace ( lst in itm )
      (setq in (1+ in))
      (mapcar '(lambda (x) (if (zerop (setq in (1- in))) itm x)) lst)
    )

    ;;  CAB 11.16.07
    ;;  Remove based on pointer list
    (defun RemoveNlst ( nlst lst )
      (setq in -1)
      (vl-remove-if '(lambda (x) (not (null (vl-position (setq in (1+ in)) nlst)))) lst)
    )
   
    (defun BulgeCenter ( bulge p1 p2 / delta chord radius center )
      (setq delta  (* (atan bulge) 4)
            chord  (distance p1 p2)
            radius (/ chord (sin (/ delta 2)) 2)
            center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
      )
    )

    ;;  Main function to remove vertex
    ;;  ent must be an ename of a LWPolyline
    (defun ps1 ( ent /      aa     cpt    dir    doc    elst   hlst   Remove
                     idx    keep   len    newb   result vlst   x      closed
                     d10    d40    d41    d42    hlst   p1     p2     p3
                     plast  msg )
        ;;=====================================================
        (setq elst (entget ent)
              msg  "")
        (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
        (if (> (length d10) 2)
          (progn
            ;;  seperate vertex data
            (setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst))
            (setq d41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst))
            (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
            ;;  remove extra vertex from point list
            (setq plast (1- (length d10)))
            (setq p1 0  p2 1  p3 2)
            (if (and (not (setq closed (vlax-curve-isclosed ent)))
                     (equal (car d10) (last d10) 1e-6))
              (progn
                (setq Closed t ; close the pline
                      elst (subst (cons 70 (1+(cdr(assoc 70 elst))))(assoc 70 elst) elst)
                      msg  " Closed and")
                (if (and (not(zerop (nth plast d42)))(not(zerop (nth 0 d42))))
                  (setq d10 (reverse(cdr(reverse d10)))
                        d40 (reverse(cdr(reverse d40)))
                        d41 (reverse(cdr(reverse d41)))
                        d42 (reverse(cdr(reverse d42)))
                        plast (1- plast)
                  )
                )
              )
            )
            (setq idx -1)
            (while (<= (setq idx (1+ idx)) (if closed (+ plast 2) (- plast 2)))
              (cond
                ((and (or (equal (angle (nth p1 d10) (nth p2 d10))
                                 (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                          (equal (nth p1 d10) (nth p2 d10) 1e-6)
                          (equal (nth p2 d10) (nth p3 d10) 1e-6))
                      (zerop (nth p2 d42))
                      (or (= p1 plast)
                          (zerop (nth p1 d42)))
                 )
                 (setq remove (cons p2 remove)) ; build a pointer list
                 (setq p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
                ((and (not (zerop (nth p2 d42)))
                      (or closed (/= p1 plast))
                      (not (zerop (nth p1 d42))) ; got two arcs
                      (equal
                        (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                        (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                        1e-4)
                 )
                 ;;  combine the arcs
                 (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                       newb (tan (/ aa 4.0))
                 )
                 (if (minusp (nth p1 d42))
                   (setq newb (- (abs newb)))
                   (setq newb (abs newb))
                 )
                 (setq remove (cons p2 remove)) ; build a pointer list
                 (setq d42 (replace d42 p1 newb))
                 (setq p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
                (t
                 (setq p1 p2
                       p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
              )
            )
            (if remove
              (progn
                (setq count (length d10))
                ;; Rebuild the vertex data with pt, start & end width, bulge
                (setq d10 (RemoveNlst remove d10)
                      d40 (RemoveNlst remove d40)
                      d41 (RemoveNlst remove d41)
                      d42 (RemoveNlst remove d42)
                )
                (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                          x  y
                                          (cons 42 z))) d10 d40 d41 d42)
                )
                ;;  rebuild the entity data with new vertex data
                (setq hlst (vl-remove-if
                             '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
                )
                (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
                (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
                (if (entmod hlst); return ename and number of vertex removed
                  (list ent (strcat msg " Vertex removed " (itoa(- count (length d10)))))
                  (list ent " Error, may be on locked layer.")
                )
              )
              (list ent "Nothing to remove - no colenier vertex.")
            )
          )
          (list ent "Nothing to do - Only two vertex.")
        )
    )
   

    ;;  ========  S T A R T   H E R E  ===========
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    (cond
      ((or (=(type et) 'ENAME)
           (and (=(type et) 'VLA-object)
                (setq et (vlax-vla-object->ename et))))
        (vla-startundomark doc)
        (setq result (ps1 et))
        (vla-endundomark doc)
       )
      ((= (type et) 'PICKSET)
        (vla-startundomark doc)
        (setq result (mapcar '(lambda(x) (ps1 x))
                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
        (vla-endundomark doc)
      )
      ((listp et)
        (vla-startundomark doc)
        (setq result (mapcar '(lambda(x) (ps1 x)) et))
        (vla-endundomark doc)
      )
      ((setq result "PSimple Error - Wrong Data Type."))
    )
    result
  )

    ;| ====== IsRevClode ==========
  * EN
  * Function defines, whether draw a polyline a command _Revcloud
  * the Polyline is considered Revcloud if:
    1. It LW a polyline
    2. All segments of a polyline arc
    3. Coordinates of the centers of these segments do not coincide
    4. Curvature of arc segments is identical as on a sign, and numerically
  Arguments:
   pl - a name (ENAME) or object (VLA-OBJECT) polylines
  Return:
   T - if a polyline satisfies to the listed conditions
   nil - in all other cases
  Example of use
  (IsRevcloud (car (entsel)))
  |;
  (defun IsRevcloud ( pl / st-en-bulge->center ed crs bulge_list bulge_log center )
  ;| EN
  Helper function st-en-bulge-> center
  * the Author the Pastuh
  * It is published: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=37164rO
  * Purpose
  * Receives coordinates of the center of the arch set by points of the beginning, the end and size bulge.
  * thus, position of a point of the center is defined so that detour of initial, final points of an arch and
  * the received point of the center occured in a direction counter-clockwise.
  Arguments:
  Point [list] - a point of the beginning of a segment
        p2 = Point [list] - a point of the end of a segment
  st - Point [list] - a bidimentional point of the beginning of an arch,
  en - Point [list] - a bidimentional point of the end of an arch,
  bulg - a tangent 1/4 central corners of an arch (bulge).
  Return:
  Bidimentional coordinates of a point of the center.
  nil if points of the beginning and the end of an arch coincide.
  nil if camber is set equal to zero.
  |;

    (defun st-en-bulge->center (st
              en
              bulg
                /
              a sina cosa 1-cosa
              b1 b2
              d d1 d2
              )
      (setq a (* (atan bulg) 4.0) sina (sin a) cosa (cos a) 1-cosa (- 1 cosa))
      (cond
        ((equal st en 1e-12) nil);
        ((equal 1-cosa 0.0 1e-12) nil);
        (T
         (setq b1 (+ (- (car en) (* (car st) cosa)) (* (cadr st) sina))
         b2 (- (cadr en) (* (car st) sina) (* (cadr st) cosa))
         d (* 2 1-cosa)
         d1 (- (* b1 1-cosa) (* b2 sina))
         d2 (+ (* b2 1-cosa) (* b1 sina))
         );
         (list (/ d1 d) (/ d2 d));
        );
      ); end cond.
    ); end defun.
   
    (and
      (if (eq (type pl) 'VLA-OBJECT)
        (setq pl (vlax-vla-object->ename pl))
        pl
      )
      (wcmatch (cdr(assoc 0 (setq ed (entget pl)))) "LWPOLYLINE")
      (setq ed (entget pl))
      (setq crs (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) ed)))
      (setq bulge_list (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 42)) ed)))
      (if (= (logand (cdr(assoc 70 ed)) 1) 1)
        (setq crs (append crs (list (car crs))))
        (setq bulge_list (reverse(cdr(reverse bulge_list)))) ;_If not closed PLINE, we delete last bulge
      )
      (setq bulge_log (mapcar 'zerop bulge_list))
      (not(apply 'or bulge_log)) ;_All arc segments
      (apply 'and (mapcar '(lambda(x)(equal x (car bulge_list) 1e-6)) bulge_list)) ;_ Equal curvature of arches (the Tangent 1/4 corners)
      (setq center (mapcar '(lambda(st pl blg)(st-en-bulge->center st pl blg)) crs (cdr crs) bulge_list))
      (not (apply 'and (mapcar '(lambda(x)(equal x (car center) 1e-6)) center))) ;_ The centers of arc segments do not coincide
    )
  )

  ;     q_|_|| _\|| q_|| _\|     ;
  ;       Subroutines End        ;

HTH, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

HasanCAD

  • Swamp Rat
  • Posts: 1304
Re: Why is this REPEAt not working?
« Reply #3 on: September 27, 2014, 05:22:49 AM »
Here I fixed it... It was sub inside "PSimple" that incremented variable "i" - changed to "in" and localized it in main function...
...
HTH, M.R.

Thanks ribarm working as a charm

roy_043

  • Water Moccasin
  • Posts: 1720
  • BricsCAD 18
Re: Why is this REPEAt not working?
« Reply #4 on: September 27, 2014, 05:30:51 AM »
Here I fixed it...
I would localize the 'in' variable in the RemoveNlst function instead of the main function. That makes much more sense. Note that RemoveNlst is nested in PSimple and not in the main function. Also I would not nest a function like RemoveNlst. It is a pretty generic library function.

On a side note: the (not (null ...)) structure can be removed from the lambda in RemoveNlst.
« Last Edit: September 27, 2014, 05:36:34 AM by roy_043 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Re: Why is this REPEAt not working?
« Reply #5 on: September 27, 2014, 07:41:29 AM »
Hasan,

You have seen this routine? http://www.theswamp.org/index.php?topic=1319.0
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

HasanCAD

  • Swamp Rat
  • Posts: 1304
Re: Why is this REPEAt not working?
« Reply #6 on: September 27, 2014, 09:30:46 AM »
Hasan,

You have seen this routine? http://www.theswamp.org/index.php?topic=1319.0

Great routine. But what about the existing revcloud, suppose revcloud arc is 200 and I want change too 125.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Re: Why is this REPEAt not working?
« Reply #7 on: September 27, 2014, 11:26:16 AM »
Well it actually will change it from 200 to 100 but it uss the actual pline & therefore looses some of the uniformity of the shape.
Give it a try to see what I mean.

I think you can get your routine working if you localize the variables, it is a good habit to get into.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

HasanCAD

  • Swamp Rat
  • Posts: 1304
Re: Why is this REPEAt not working?
« Reply #8 on: September 28, 2014, 02:11:42 AM »
Well it actually will change it from 200 to 100 but it uss the actual pline & therefore looses some of the uniformity of the shape.
Give it a try to see what I mean.

I think you can get your routine working if you localize the variables, it is a good habit to get into.

I tested It but losses the shape

liuhaixin88

  • Guest
Re: Why is this REPEAt not working?
« Reply #9 on: September 29, 2014, 04:13:04 AM »
Here I fixed it... It was sub inside "PSimple" that incremented variable "i" - changed to "in" and localized it in main function...


HTH, M.R.

Enthusiastic . marko