Author Topic: increase number of attribute block along a polyline  (Read 8258 times)

0 Members and 1 Guest are viewing this topic.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: increase number of attribute block along a polyline
« Reply #30 on: August 06, 2014, 09:22:05 AM »
Replacing this line:
Code: [Select]
(setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))With:
Code: [Select]
(setq bl
  (ssname
    (ssget
      "_X"
      (list
        '(0 . "INSERT")
        '(66 . 1)
        '(-4 . "<,<,*")
        (list 10 (+ (car v) 1e-6) (+ (cadr v) 1e-6) 0.0)
        '(-4 . ">,>,*")
        (list 10 (- (car v) 1e-6) (- (cadr v) 1e-6) 0.0)
      )
    )
    0
  )
)
May solve all issues I have mentioned. But the program will probably be slower.

BTW: there actually is an entity in the center of the circle.

pedroantonio

  • Guest
Re: increase number of attribute block along a polyline
« Reply #31 on: August 06, 2014, 10:22:33 AM »
Thanks you roy_043 and ronjonp and the two solutions works fine

A) With zoom extend

Code: [Select]
(defun c:pblinclw ( / ListClockwise-p osm ss lw vl pt n pr k v bl att )

  (defun ListClockwise-p ( lst / z vlst )
    (vl-catch-all-apply 'minusp
      (list
        (if
          (not
            (equal 0.0
              (setq z
                (apply '+
                  (mapcar
                    (function
                      (lambda (u v)
                        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                      )
                    )
                    (setq vlst
                      (mapcar
                        (function
                          (lambda (a b) (mapcar '- b a))
                        )
                        (mapcar (function (lambda (x) (car lst))) lst)
                        (cdr (reverse (cons (car lst) (reverse lst))))
                      )
                    )
                    (cdr (reverse (cons (car vlst) (reverse vlst))))
                  )
                )
              ) 1e-6
            )
          )
          z
          (progn
            (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
            nil
          )
        )
      )
    )
  )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 8)
  (prompt "\nPick 2D LWPOLYLINE that has blocks with attributes to increment at its vertices...")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq lw (ssname ss 0))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget lw))))
  (if (not (ListClockwise-p vl)) (setq vl (reverse vl)))
  (setq pt (getpoint "\nPick starting point : "))
  (setq n (length vl))
(command "_.zoom" "_extents")
(command "_.draworder" (ssget "_X" '((0 . "~Insert"))) "" "_back")
  (setq pr (getstring "\nSpecify prefix : "))
  (setq vl (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (cdr (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (append vl vl)))))))
  (setq k 0)
  (repeat n
    (setq k (1+ k))
    (setq v (car vl))
    (setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))
    (setq att (entnext bl))
    (entmod (subst (cons 1 (strcat pr (itoa k))) (assoc 1 (entget att)) (entget att)))
    (entupd att)
    (setq vl (cdr vl))
  )
  (setvar 'osmode osm)
  (princ)
)


b) Change (setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))

Code: [Select]
(defun c:pblinclw ( / ListClockwise-p osm ss lw vl pt n pr k v bl att )

  (defun ListClockwise-p ( lst / z vlst )
    (vl-catch-all-apply 'minusp
      (list
        (if
          (not
            (equal 0.0
              (setq z
                (apply '+
                  (mapcar
                    (function
                      (lambda (u v)
                        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                      )
                    )
                    (setq vlst
                      (mapcar
                        (function
                          (lambda (a b) (mapcar '- b a))
                        )
                        (mapcar (function (lambda (x) (car lst))) lst)
                        (cdr (reverse (cons (car lst) (reverse lst))))
                      )
                    )
                    (cdr (reverse (cons (car vlst) (reverse vlst))))
                  )
                )
              ) 1e-6
            )
          )
          z
          (progn
            (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
            nil
          )
        )
      )
    )
  )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 8)
  (prompt "\nPick 2D LWPOLYLINE that has blocks with attributes to increment at its vertices...")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq lw (ssname ss 0))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget lw))))
  (if (not (ListClockwise-p vl)) (setq vl (reverse vl)))
  (setq pt (getpoint "\nPick starting point : "))
  (setq n (length vl))
  (setq pr (getstring "\nSpecify prefix : "))
  (setq vl (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (cdr (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (append vl vl)))))))
  (setq k 0)
  (repeat n
    (setq k (1+ k))
    (setq v (car vl))
(setq bl
  (ssname
    (ssget
      "_X"
      (list
        '(0 . "INSERT")
        '(66 . 1)
        '(-4 . "<,<,*")
        (list 10 (+ (car v) 1e-6) (+ (cadr v) 1e-6) 0.0)
        '(-4 . ">,>,*")
        (list 10 (- (car v) 1e-6) (- (cadr v) 1e-6) 0.0)
      )
    )
    0
  )
)
    (setq att (entnext bl))
    (entmod (subst (cons 1 (strcat pr (itoa k))) (assoc 1 (entget att)) (entget att)))
    (entupd att)
    (setq vl (cdr vl))
  )
  (setvar 'osmode osm)
  (princ)
)

Thank you ...  :-D