Help with a lisp

[Guest]

Hi BIGAl. I am not using CIV3D.

[Guest]

Nice job dianorh

 

Quote

They lisp cannot know whether text is inside or outside an open polyline, because by its nature it is open

 

I have a suggestion for this , if the open polyline is clockwise then put the dimensions under the line unless put the dimension over the line !!!

[Guest]

dianorh . When i change the name of the layrer is not readable Why?

 

;; IMPORTANT : TO ENSURE THE CORRECT PAPERSPACE TEXT HEIGHT THIS LISP MUST BE RUN IN PAPERSPACE THROUGH THE REQUIRED VIEWPORT WITH THE REQUIRED VIEWPORT SCALE SET.

;; MostInnerPoint by Gilles Chanteau (_gile)
(defun MostInnerPoint (obj fuzz / 2d-coord->pt-lst 3d-coord->pt-lst dich-sub len tmp)

  (defun 2d-coord->pt-lst (lst)
    (if	lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst))))
  );end_defun

  (defun 3d-coord->pt-lst (lst)
    (if	lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst))))
  );end_defun

  (defun dich-sub (inf sup / of new pts)
    (if	(equal inf sup fuzz)
      (progn
        (setq of  (vlax-invoke obj 'Offset inf)
              pts (if (= (vla-get-ObjectName (car of)) "AcDbPolyline")
                    (2d-coord->pt-lst (vlax-get (car of) 'Coordinates))
                    (3d-coord->pt-lst (vlax-get (car of) 'ControlPoints))
                  );end_if
        );end_setq
        (mapcar 'vla-delete of)
        (mapcar (function (lambda (x) (/ x (length pts)))) (apply 'mapcar (cons '+ pts)))
      );end_progn
      (progn
        (setq new (/ (+ inf sup) 2.0)
              of  (vl-catch-all-apply 'vlax-invoke (list obj 'Offset new))
        );end_setq
        (if (vl-catch-all-error-p of)
          (dich-sub inf new)
          (progn
            (mapcar 'vla-delete of)
            (dich-sub new sup)
          )
        );end_if
      );end_progn
    );end_if
  );end_defun

  (if (and  (member	(vla-get-ObjectName obj) '("AcDbPolyline" "AcDbSpline"))
            (vlax-curve-isClosed obj)
            (or (= (vla-get-ObjectName obj) "AcDbPolyline")
                (vlax-curve-isPlanar obj)
            );end_or
            (setq tmp (vl-catch-all-apply 'vlax-invoke (list obj 'Offset fuzz)))
            (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
                  tmp (car tmp)
            );end_setq
            (if (< len (vlax-curve-getDistAtParam tmp (vlax-curve-getEndParam tmp)))
              (setq len (/ len (* -2 pi)))
              (setq len (/ len (* 2 pi)))
            );end_if
            (not (vla-delete tmp))
      );end_and
      (dich-sub 0.0 len)
  );end_if
);end_defun (MostInnerPoint)

(defun rh:put_props ( obj p_lst v_lst) 
  (mapcar '(lambda (x y) (vlax-put-property obj x y)) p_lst v_lst)
);end_defun

(defun rh:outside_obj ( tobj lobj pt / ll ur m_pt n_obj ipt)
  (vla-getboundingbox tobj 'll 'ur)
  (setq m_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (vlax-safearray->list ll) (vlax-safearray->list ur))
        n_obj (vla-addline c_spc (vlax-3d-point m_pt) (vlax-3d-point pt))
        ipt (vlax-invoke lobj 'intersectwith n_obj acextendnone)
  );end_setq
  (vla-delete n_obj)  
  (if ipt T nil)
);end_defun

;; Adapted from Memberwithfuzz by Lee Mac
(defun member_if (itm lst)
  (vl-member-if '(lambda ( x ) (equal x itm 0.001)) lst)
);end_defun
  
(vl-load-com)

(defun c:qqannot (/ *error* sv_lst sv_vals c_doc c_spc c_lyrs t_ht n_lyr ss ent obj e_lst p_lst mi_pt e_p seg dist t_ang i_pt t_lst t_obj move_pt)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
  
  (setq sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get c_doc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
        c_lyrs (vla-get-layers c_doc)
        t_lst nil
  );end_setq
  
  (mapcar 'setvar sv_lst (list 0 0))
  
  (cond ( (not (tblsearch "layer" "_ΔΙΑΣΤΑΣΕΙΣ"))
          (setq n_lyr (vla-add c_lyrs "_ΔΙΑΣΤΑΣΕΙΣ"))
          (rh:put_props n_lyr (list 'color 'lineweight) (list 93 0.3))
        )
  );end_cond
  
  (command "_.-style" "_diast" "romans.shx" "_annotative" "_yes" "_no" 1.75 1.0 0.0 "_no" "_no" "_no");REMEMBER IF YOU CHANGE THIS TO A .TTF FONT REMOVE THE LAST "_no"

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "LWPOLYLINE")))
        t_ht (/ (cdr (assoc 40 (tblsearch "style" "_diast"))) (getvar 'cannoscalevalue))
  );end_setq
  
  (cond (ss
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
          (vla-startundomark c_doc)
          
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  e_lst (entget ent)
                  p_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) e_lst))
                  mi_pt (MostInnerPoint obj 0.001)
            );end_setq
            
            (cond ( (and (equal (car p_lst) (last p_lst) 0.001) (= :vlax-false (vlax-get-property obj 'closed))) 
                    (setq p_lst (reverse (cdr (reverse p_lst))))
                    (vlax-put obj 'coordinates (apply 'append p_lst))
                    (vlax-put-property obj 'closed :vlax-true)
                  )
            );end_cond
            
            (setq e_p (vlax-curve-getendparam ent)
                  seg 0.0
            );end_setq
            
            (while (< seg e_p)
              (setq dist (distance (vlax-curve-getpointatparam ent seg) (vlax-curve-getpointatparam ent (1+ seg)))
                    t_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (+ seg 0.5)))
                    i_pt (vlax-curve-getpointatparam ent (+ seg 0.5))
                    seg (1+ seg)
              );end_setq
              
              (cond ( (< (/ pi 2.0) t_ang (* (/ pi 2.0) 3)) (setq t_ang (if (> t_ang pi) (- t_ang pi) (+ t_ang pi)))))
              
              (cond ( (not (member_if i_pt t_lst))
                      (setq t_lst (cons i_pt t_lst)
                            t_obj (vla-addtext c_spc (rtos dist 2 2) (vlax-3d-point i_pt) t_ht)
                      );end_setq
                      (rh:put_props t_obj (list 'rotation 'alignment 'textalignmentpoint 'layer) (list t_ang acAlignmentBottomCenter (vlax-3d-point i_pt) "_dimensions"))
                      (cond ( (and mi_pt (rh:outside_obj t_obj obj mi_pt))
                              (setq move_pt (polar i_pt (- t_ang (/ pi 2.0)) (* t_ht 1.7)))
                              (vla-move t_obj (vlax-3d-point i_pt) (vlax-3d-point move_pt)) 
                            )
                      );end_cond
                    )
              );end_cond
            );end_while
          );end_repeat
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))          
        )
  );end_cond
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun  

(command "_.-style" "_diast" "romans.shx" "_annotative" "_yes" "_no" 1.75 1.0 0.0 "_no" "_no" "_no")

When i call the layer with the old way all is ok ????

 

 (command "_layer" "m" "_ΔΙΑΣΤΑΣΕΙΣ" "c" "93" "" "lw" "0.30" "" "")

can you fix it ??

 

Thanks

[dlanorh]

18 hours ago, prodromosm said:

Nice job dianorh

 

 

I have a suggestion for this , if the open polyline is clockwise then put the dimensions under the line unless put the dimension over the line !!!

 

Will give it a try when I return to the office. Site visits at present.

[dlanorh]

9 hours ago, prodromosm said:

dianorh . When i change the name of the layrer is not readable Why?

 

;; IMPORTANT : TO ENSURE THE CORRECT PAPERSPACE TEXT HEIGHT THIS LISP MUST BE RUN IN PAPERSPACE THROUGH THE REQUIRED VIEWPORT WITH THE REQUIRED VIEWPORT SCALE SET.

;; MostInnerPoint by Gilles Chanteau (_gile)
(defun MostInnerPoint (obj fuzz / 2d-coord->pt-lst 3d-coord->pt-lst dich-sub len tmp)

  (defun 2d-coord->pt-lst (lst)
    (if	lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst))))
  );end_defun

  (defun 3d-coord->pt-lst (lst)
    (if	lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst))))
  );end_defun

  (defun dich-sub (inf sup / of new pts)
    (if	(equal inf sup fuzz)
      (progn
        (setq of  (vlax-invoke obj 'Offset inf)
              pts (if (= (vla-get-ObjectName (car of)) "AcDbPolyline")
                    (2d-coord->pt-lst (vlax-get (car of) 'Coordinates))
                    (3d-coord->pt-lst (vlax-get (car of) 'ControlPoints))
                  );end_if
        );end_setq
        (mapcar 'vla-delete of)
        (mapcar (function (lambda (x) (/ x (length pts)))) (apply 'mapcar (cons '+ pts)))
      );end_progn
      (progn
        (setq new (/ (+ inf sup) 2.0)
              of  (vl-catch-all-apply 'vlax-invoke (list obj 'Offset new))
        );end_setq
        (if (vl-catch-all-error-p of)
          (dich-sub inf new)
          (progn
            (mapcar 'vla-delete of)
            (dich-sub new sup)
          )
        );end_if
      );end_progn
    );end_if
  );end_defun

  (if (and  (member	(vla-get-ObjectName obj) '("AcDbPolyline" "AcDbSpline"))
            (vlax-curve-isClosed obj)
            (or (= (vla-get-ObjectName obj) "AcDbPolyline")
                (vlax-curve-isPlanar obj)
            );end_or
            (setq tmp (vl-catch-all-apply 'vlax-invoke (list obj 'Offset fuzz)))
            (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
                  tmp (car tmp)
            );end_setq
            (if (< len (vlax-curve-getDistAtParam tmp (vlax-curve-getEndParam tmp)))
              (setq len (/ len (* -2 pi)))
              (setq len (/ len (* 2 pi)))
            );end_if
            (not (vla-delete tmp))
      );end_and
      (dich-sub 0.0 len)
  );end_if
);end_defun (MostInnerPoint)

(defun rh:put_props ( obj p_lst v_lst) 
  (mapcar '(lambda (x y) (vlax-put-property obj x y)) p_lst v_lst)
);end_defun

(defun rh:outside_obj ( tobj lobj pt / ll ur m_pt n_obj ipt)
  (vla-getboundingbox tobj 'll 'ur)
  (setq m_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (vlax-safearray->list ll) (vlax-safearray->list ur))
        n_obj (vla-addline c_spc (vlax-3d-point m_pt) (vlax-3d-point pt))
        ipt (vlax-invoke lobj 'intersectwith n_obj acextendnone)
  );end_setq
  (vla-delete n_obj)  
  (if ipt T nil)
);end_defun

;; Adapted from Memberwithfuzz by Lee Mac
(defun member_if (itm lst)
  (vl-member-if '(lambda ( x ) (equal x itm 0.001)) lst)
);end_defun
  
(vl-load-com)

(defun c:qqannot (/ *error* sv_lst sv_vals c_doc c_spc c_lyrs t_ht n_lyr ss ent obj e_lst p_lst mi_pt e_p seg dist t_ang i_pt t_lst t_obj move_pt)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
  
  (setq sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get c_doc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
        c_lyrs (vla-get-layers c_doc)
        t_lst nil
  );end_setq
  
  (mapcar 'setvar sv_lst (list 0 0))
  
  (cond ( (not (tblsearch "layer" "_ΔΙΑΣΤΑΣΕΙΣ"))
          (setq n_lyr (vla-add c_lyrs "_ΔΙΑΣΤΑΣΕΙΣ"))
          (rh:put_props n_lyr (list 'color 'lineweight) (list 93 0.3))
        )
  );end_cond
  
  (command "_.-style" "_diast" "romans.shx" "_annotative" "_yes" "_no" 1.75 1.0 0.0 "_no" "_no" "_no");REMEMBER IF YOU CHANGE THIS TO A .TTF FONT REMOVE THE LAST "_no"

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "LWPOLYLINE")))
        t_ht (/ (cdr (assoc 40 (tblsearch "style" "_diast"))) (getvar 'cannoscalevalue))
  );end_setq
  
  (cond (ss
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
          (vla-startundomark c_doc)
          
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  e_lst (entget ent)
                  p_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) e_lst))
                  mi_pt (MostInnerPoint obj 0.001)
            );end_setq
            
            (cond ( (and (equal (car p_lst) (last p_lst) 0.001) (= :vlax-false (vlax-get-property obj 'closed))) 
                    (setq p_lst (reverse (cdr (reverse p_lst))))
                    (vlax-put obj 'coordinates (apply 'append p_lst))
                    (vlax-put-property obj 'closed :vlax-true)
                  )
            );end_cond
            
            (setq e_p (vlax-curve-getendparam ent)
                  seg 0.0
            );end_setq
            
            (while (< seg e_p)
              (setq dist (distance (vlax-curve-getpointatparam ent seg) (vlax-curve-getpointatparam ent (1+ seg)))
                    t_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (+ seg 0.5)))
                    i_pt (vlax-curve-getpointatparam ent (+ seg 0.5))
                    seg (1+ seg)
              );end_setq
              
              (cond ( (< (/ pi 2.0) t_ang (* (/ pi 2.0) 3)) (setq t_ang (if (> t_ang pi) (- t_ang pi) (+ t_ang pi)))))
              
              (cond ( (not (member_if i_pt t_lst))
                      (setq t_lst (cons i_pt t_lst)
                            t_obj (vla-addtext c_spc (rtos dist 2 2) (vlax-3d-point i_pt) t_ht)
                      );end_setq
                      (rh:put_props t_obj (list 'rotation 'alignment 'textalignmentpoint 'layer) (list t_ang acAlignmentBottomCenter (vlax-3d-point i_pt) "_dimensions"))
                      (cond ( (and mi_pt (rh:outside_obj t_obj obj mi_pt))
                              (setq move_pt (polar i_pt (- t_ang (/ pi 2.0)) (* t_ht 1.7)))
                              (vla-move t_obj (vlax-3d-point i_pt) (vlax-3d-point move_pt)) 
                            )
                      );end_cond
                    )
              );end_cond
            );end_while
          );end_repeat
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))          
        )
  );end_cond
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun  

(command "_.-style" "_diast" "romans.shx" "_annotative" "_yes" "_no" 1.75 1.0 0.0 "_no" "_no" "_no")

When i call the layer with the old way all is ok ????

 

 (command "_layer" "m" "_ΔΙΑΣΤΑΣΕΙΣ" "c" "93" "" "lw" "0.30" "" "")

can you fix it ??

 

Thanks

 

You are trying to use unicode characters in a lisp which has problems with anything that isn't "ASCII", so it isn't fixable as the problem is the lisp interpreter, not the layer.

Your best bet is to stick with "ASCII" when using lisp programs, and rename layers with a macro when the drawing is completed.

 

The command call works because it uses your AutoCAD version which is designed with microsoft code pages for your language. I cannot run  the above command as it errors on my system, I have a different code page to you.