Archive for the ‘Lisp’ Category

27
Oct

Um möglichst schnell alle Punkte einer Wolke, die mittels DXF-Export von einem Leica-Nivellierer erstellt wurden, zu beschriften wurde auf die schnelle folgendes Skript entwickelt.

;; get attribute from block marked with tag (attribute-name)
(defun get_attribute (blk tag / enx)
  (if (= "ATTRIB"
        (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk))))))
      )

    (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
      (cdr (assoc 1 enx))
      (get_attribute blk tag)
    )
  )
)
;; get_attribute

;; extrahiert den namen und schreibt ihn auf den block
(defun c:leica_extract_names (/ v i ename)
  (setq v (ssget "x" (list (cons 0 "insert") (cons 2 "cross"))))
  (setq i 0)

  (repeat (sslength v)
    (progn
      (setq ename (ssname v i))
      (entmake (list
        (cons 0 "text")
        (cons 1 (get_attribute ename "name"))
        (cons 10 (cdr (assoc 10 (entget ename))))
        (cons 40 1.0)) ;; text height
      )
      (setq i (+ i 1))
    )
  )
)

Beispielvideo:

, ,

18
Jun
(defun c:sum_len (/)
  (princ
    "\nSelect Lines and Arcs: "
  )
  (setq	ausw (ssget (list (cons -4 ""))))
  (setq ind 0)
  (setq glg 0)

  (if (/= ausw nil)
    (progn
      (repeat (sslength ausw)
	(princ ".")
	(setq elem (entget (ssname ausw ind)))
	(setq elem_t (strcase (cdr (assoc 0 elem))))

	(if (= elem_t "LINE")
	  (progn
	    (setq p1 (cdr (assoc 10 elem)))
	    (setq p2 (cdr (assoc 11 elem)))
	    (setq lg (distance p1 p2))
	    (setq glg (+ glg lg))
	  )
	)
	(if (= elem_t "ARC")
	  (progn
	    (setq rad (cdr (assoc 40 elem)))
	    (setq a1 (cdr (assoc 50 elem)))
	    (setq a2 (cdr (assoc 51 elem)))
	    (setq a3 (- a2 a1))
	    (if	(< a2 a1)
	      (setq a3 (+ a2 (- (* pi 2) a1)))
	    )
	    (setq glg (+ glg (/ (* (* pi 2 rad) a3) (* pi 2))))
	  )
	)
	(setq ind (+ ind 1))
      )
      ;; end repeat
      (princ (strcat "\nLength: " (rtos glg)))
    )
  )
)

,

30
Sep

Today I wrote a little helper function that rotates selected text and inserts to the current BKS x-axis. The function is tested up to AutoCAD 2011.

(defun c:rotate_0 (/ sset element index)
 (setq sset (ssget))
 (setq index 0)
  (if (/= sset nil)
   (progn
    (repeat (sslength sset)
     (setq element (entget (ssname sset index)))
     (if (= (cdr (assoc 0 element)) "insert")
	(command "_rotate"
          (cdr (assoc -1 element))
          ""
          (cdr (assoc 10 element))
          "b"
          (* (/ 180 pi) (cdr (assoc 50 element)))
          "0.0"
	)
      ; else if	
      (progn
        (setq element (subst (cons 50 0.0) (assoc 50 element) element))
        (entmod element)
      )
    )
   (setq index (+ index 1))
   )
  )
 )
)

,