Lisp to recreate multiple xclip borders

[Anonymous]

Hello,

I am searching for a lisp routine that would recreate multiple xclip borders and assign generated plines on a new layer.

I have found some directions in other post but its no use for me as I cnat really program... still.

(defun xclip-points (ent / e d)
(while (setq e (cdr (assoc 360 (entget ent)))) (setq ent e))
(if (member '(0 . "SPATIAL_FILTER") (setq d (entget ent)))
(cons
(eq 1 (cdr (assoc 71 d)))
(apply 'append
(mapcar '(lambda (x) (if (eq 10 (car x)) (list (cdr x)))) d)
)
)
)
)

Returns '(flag point point point)

Clip on: (T (670466.0 678736.0) (671585.0 678520.0) ...)
Clip off: (nil (670466.0 678736.0) (671585.0 678520.0) ...)
No clip: nil 

Any ideas?

Much appriciated

Jan

[hmsilva · Accepted solution]

Maybe something like this

(defun c:recreate (/ xclip-points mk_pl lst lsta ss)

  (defun xclip-points (ent / e d)
    (while (setq e (cdr (assoc 360 (entget ent)))) (setq ent e))
    (if (member '(0 . "SPATIAL_FILTER") (setq d (entget ent)))
      (cons
        (eq 1 (cdr (assoc 71 d)))
        (apply 'append
               (mapcar '(lambda (x)
                          (if (eq 10 (car x))
                            (list (cdr x))
                          )
                        )
                       d
               )
        )
      )
    )
  )

  (defun mk_pl (pt-lst /)
    (entmake
      (append
        (list '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              (cons 90 (1+ (length pt-lst)))
              '(8 . "TRAB")
              '(70 . 1)
        )
        (mapcar (function (lambda (x) (cons 10 x))) pt-lst)
      )
    )
  )

  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            lst (xclip-points ent)
      )
      (if (not (null lst))
        (progn
          (setq lst (cdr lst))
          (if (> (length lst) 2)
            (mk_pl lst)
            (if (= (length lst) 2)
              (progn
                (setq lsta (cons (car lst) lsta)
                      lsta (cons (list (car (car lst)) (cadr (cadr lst))) lsta)
                      lsta (cons (cadr lst) lsta)
                      lsta (cons (list (car (cadr lst)) (cadr (car lst))) lsta)
                      lsta (reverse lsta)
                )
                (mk_pl lsta)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

Untested...

Henrique

[Anonymous]

It runs well! Thanks a lot...

I guess this part of code is dealing with color and Linetype... what should i put to get color layer 222,222,222 and hidden linetype? And BTW where can I find some documentation about these arguments.

Cheers

Jan 

[hmsilva]

You're welcome, Jan.

To create a layer, we can entmake it, but we have to write much more code, we need to test if layer exists, if linetype is already loaded, if not load it first, then entmake the layer with the specific linetype,...

The easiest way is to use the command LAYER to create the layer with the specific linetype, if it's not loaded, the command will load it.

(if (not (tblsearch "LAYER" "YourLayerName"))
  (command "_.layer" "_N" "YourLayerName" "_C" "_T" "222,222,222" "YourLayerName" "_L" "Hidden" "YourLayerName" "")
  )

In the code to entmake the lwpolyline, I just set the layer name (dxf 😎 to 'TRAB', change the layer name there and in the previous code to the correct LayerName, and put this code snippet just before

  (if (setq ss (ssget '((0 . "INSERT"))))

You should find the DXF reference at the help files,

Developer Documentation -> DXF Reference

Hope that helps

Henrique

[Anonymous]

As expected I will need some time to contemplate information which you gave me 🙂

But thanks a lot.

If not too much trouble can you alter the code to recreate boundaries of viewports insetad of xclips.

Sorry for the trouble.

Jan 

Edit: I did something wrong..

(defun c:recreate (/ xclip-points mk_pl lst lsta ss)

  (defun xclip-points (ent / e d)
    (while (setq e (cdr (assoc 360 (entget ent)))) (setq ent e))
    (if (member '(0 . "SPATIAL_FILTER") (setq d (entget ent)))
      (cons
        (eq 1 (cdr (assoc 71 d)))
        (apply 'append
               (mapcar '(lambda (x)
                          (if (eq 10 (car x))
                            (list (cdr x))
                          )
                        )
                       d
               )
        )
      )
    )
  )

  (defun mk_pl (pt-lst /)
    (entmake
	(if (not (tblsearch "LAYER" "TestLayer"))
  		(command "_.layer" "_N" "TestLayer" "_C" "_T" "222,222,222" "TestLayer" "_L" "Hidden" "TestLayer" "")
  		)
          )
  )

  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            lst (xclip-points ent)
      )
      (if (not (null lst))
        (progn
          (setq lst (cdr lst))
          (if (> (length lst) 2)
            (mk_pl lst)
            (if (= (length lst) 2)
              (progn
                (setq lsta (cons (car lst) lsta)
                      lsta (cons (list (car (car lst)) (cadr (cadr lst))) lsta)
                      lsta (cons (cadr lst) lsta)
                      lsta (cons (list (car (cadr lst)) (cadr (car lst))) lsta)
                      lsta (reverse lsta)
                )
                (mk_pl lsta)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

[hmsilva]

You're welcome, Jan,

try

(defun c:recreate (/ xclip-points mk_pl lst lsta ss)

  (defun xclip-points (ent / e d)
    (while (setq e (cdr (assoc 360 (entget ent)))) (setq ent e))
    (if (member '(0 . "SPATIAL_FILTER") (setq d (entget ent)))
      (cons
        (eq 1 (cdr (assoc 71 d)))
        (apply 'append
               (mapcar '(lambda (x)
                          (if (eq 10 (car x))
                            (list (cdr x))
                          )
                        )
                       d
               )
        )
      )
    )
  )

  (defun mk_pl (pt-lst /)
    (entmake
      (append
        (list '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              (cons 90 (1+ (length pt-lst)))
              '(8 . "TestLayer")
              '(70 . 1)
        )
        (mapcar (function (lambda (x) (cons 10 x))) pt-lst)
      )
    )
  )

  (if (not (tblsearch "LAYER" "TestLayer"))
  (command "_.layer" "_N" "TestLayer" "_C" "_T" "222,222,222" "TestLayer" "_L" "Hidden" "TestLayer" "")
  )
  
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            lst (xclip-points ent)
      )
      (if (not (null lst))
        (progn
          (setq lst (cdr lst))
          (if (> (length lst) 2)
            (mk_pl lst)
            (if (= (length lst) 2)
              (progn
                (setq lsta (cons (car lst) lsta)
                      lsta (cons (list (car (car lst)) (cadr (cadr lst))) lsta)
                      lsta (cons (cadr lst) lsta)
                      lsta (cons (list (car (cadr lst)) (cadr (car lst))) lsta)
                      lsta (reverse lsta)
                )
                (mk_pl lsta)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

Henrique

[Anonymous]

It works, of course. 

I didnt understand that you have to first make "test layer" and then do the adjustment etc...

Anyhow thank you.

Jan 

[hmsilva]

You're welcome, Jan
Glad I could help

Henrique