Jump to content

Recommended Posts

Posted

Hello everyone, I've made a function based on Lee's great function to copy passed ss with objects, into existing passed file name and folder, but unfortunately can't make it open dwg in background and it always opens dialog box.

Tried also with filedia as u can see but it doesn't work. Any advice is appreciated  

 

;;;******************************************************
;;;	function copies passed objects to passed dwg file
;;;	based on great Lee Mac function Copy2Drawings    



(defun tv:c2dwg ( objSS fn objFolder / *error* _getitem acd app dbx doc dwl err inc lst msg sel tab var vrs )

    (defun *error* ( msg )
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )   
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (defun _getitem ( col itm )
        (if (not (vl-catch-all-error-p (setq itm (vl-catch-all-apply 'vla-item (list col itm)))))
            itm
        )
    )
    ;(setvar 'FILEDIA 0)
    (setq app (vlax-get-acad-object)
          acd (vla-get-activedocument app)
          tab (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")
          cnt 0	  
	  folderPath (vlax-get-property (vlax-get-property objFolder 'Self) 'Path)
	  fnPath (strcat folderPath "/" fn ".dwg")
    )	
    (cond
        (   (not
                (and
		    (setq sel objSS)
                    (setq dwg (getfiled "" fnPath "" 8));*******here it opens dialog box
                )
            )
            (princ "\n*Cancel*")
        )
        (   (progn
                (setq dbx
                    (vl-catch-all-apply 'vla-getinterfaceobject
                        (list (setq app (vlax-get-acad-object))
                            (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                                "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                            )
                        )
                    )
                )
                (or (null dbx) (vl-catch-all-error-p dbx))
            )
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   t
            (vlax-for doc (vla-get-documents app)
                (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
            )
            (repeat (setq inc (sslength sel))
                (setq var (cons (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))) var))
            )
            (setq var
                (vlax-make-variant
                    (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbobject (cons 0 (1- (length var)))) var
                    )
                )
            )
                (if
                    (or (setq doc (cdr (assoc (strcase dwg) dwl)))
                        (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg))))
                             (setq doc dbx)
                        )
                    )
                    (progn
                        (vla-copyobjects acd var
                            (vla-get-block
                                (cond
                                    (   (_getitem (vla-get-layouts doc) tab))
                                    (   (vla-add  (vla-get-layouts doc) tab))
                                )
                            )
                        )
                        (vla-saveas doc dwg)
                        (setq cnt (1+ cnt))
                    )
                    (princ (apply 'strcat (cons "\nUnable to interface with file: " (cdr (fnsplitl dwg)))))
                )
            (setq msg
                (if (< 0 cnt)
                    (strcat "\n"
                        (itoa (sslength sel))
                        (if (= 1 (sslength sel))
                            " object"
                            " objects"
                        )
                        " copied to " (itoa cnt)
                        (if (= 1 cnt)
                            " drawing."
                            " drawings."
                        )
                    )
                    ""
                )
            )
            (if (< 0 (setq err (- (length lst) cnt)))
                (setq msg
                    (strcat msg
                        "\nUnable to copy to" (itoa err)
                        (if (= 1 err)
                            " drawing."
                            " drawings."
                        )
                    )
                )
            )
            (princ msg)
            (if (= 'vla-object (type dbx))
                (vlax-release-object dbx)
            )
        )
    )
    ;(setvar 'FILEDIA 1)
    (princ)
)
;;;*******************************************************************

 

Posted (edited)

well of course it opens a dialog, (setq dwg (getfiled "" fnPath "" 8)) , getfiled is get file dialog

If your filename is fnPath (strcat folderPath "/" fn ".dwg") either skip the getfiled-part or replace it with something like :

 (and (setq sel objSS) (setq dwg (findfile fnPath)))

Edited by rlx
  • Like 1
Posted (edited)

thank you, that part now works, now i'm getting 'Error: Automation Error. Invalid owner object' in this part and have no clue what it means, like it can't get Model tab or something

 

(vla-copyobjects acd var
                            (vla-get-block
                                (cond
                                    (   (_getitem (vla-get-layouts doc) tab))  ;;************in this row
                                    (   (vla-add  (vla-get-layouts doc) tab))
                                )
                            )
                        )

 

Edited by Tomislav
Posted

and sometimes i get 'Error: Automation Error. Duplicate key' in this line

 

(progn
                        (vla-copyobjects acd var
                            (vla-get-block
                                (cond
                                    (   (_getitem (vla-get-layouts doc) tab))
                                    (   (vla-add  (vla-get-layouts doc) tab))
                                )
				(vla-add  (vla-get-layouts doc) tab) ;************this line
                            )
                        )
                        (vla-saveas doc dwg)
                        (setq cnt (1+ cnt))
                    )

 

Posted (edited)
;;; copy to drawing
(defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array)  
  (defun SS->OL (ss / i l)
    (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp))
  (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver))))
  (vla-open dbx dwg)
  ; put all block objects in a list
  (foreach object (ss->ol ss) (setq object-list (cons object object-list)))
  ; put list with objects in a safe array
  (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list)))))
  (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list))
  ; copy objects to dbx-drawing
  (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx))
  (vl-catch-all-apply 'vla-saveas (list dbx dwg))
  (vl-catch-all-apply 'vlax-release-object (list dbx))
  (setq object-list nil object-safe-array nil)
  (princ)
)

(defun c:t1 ( / ss d) (if (and (setq ss (ssget)) (setq d (getfiled "Copy SS to:" "" "dwg" 0))) (ctd ss d))(princ))

 

Edited by rlx
  • Like 1
Posted

thank you for your response but even with yours function i'm getting Automation Error. Invalid owner object in line:

 

(vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx))

 

Posted

Sorry I don't have any more time at this moment , but maybe run an audit on your drawing. It may be corrupt.

Posted

still, thank you in trying to help

Posted

i've tried both functions, from Lee and Rlx, on multiple validated files and always get same error on practically same row, so if someone has any idea why it could be happening i'm all ears 🤔

Posted

maybe post / PM a sample drawing and exaclty what you do (how you select) , if there is external / third party objects in there that can be a problem. But will have a look later 2day/week

Posted (edited)

your lisp works on its own, but in my lisp as called function it doesn't...perhaps i'm not supplying file correctly...i can't paste my whole lisp, it has 1.6k lines, but will add a drawing and part that calls your function.

My lisp basically creates profile from selected points, selects that profile line in ss by creating empty ss before creating profile line and after creating all parts of profile it adds all created objects in that ss, and i want to copy that profile ss in another existent drawing that has a name based on station like 18100.dwg

 

 

(if(= create_new_table "I")
	   (progn
	       (setq folderPath (vlax-get-property (vlax-get-property IndObjFolder 'Self) 'Path))	       
	       (while (setq profile_lastEnt (entnext profile_lastEnt)) ;here it adds objects in SS
		    ;; Add all entity's created/modified after setting lastent to the selection set0
		   (ssadd profile_lastEnt profile_ss)		   
		) ;_ _while
	       (if (= (rem station 1) 0)
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 0) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 0)".dwg not found!"))
			  (exit)
			  )
		      )
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 2) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 2)".dwg not found!"))
			  (exit)
			  )
		      )
		   )
	       )
	   )

 

template AC.dwg

18100.dwg

Edited by Tomislav
Posted

You could attach the whole lisp if its too big to paste the code here. From this part I can't really understand how are you create profile_ss selection set, this could be the problem why it doesn't work for you.

Posted (edited)

well, there's also some copyright involved , but here is a part from creating empty ss to adding objects in it and passing to ctd function...big part of this is skipped (like entering distances and heights to table) cause only when these 3 conditions from first 'if' are met then lisp does something

in another part of my lisp i also use same type of selecting objects in ss and copying to newly created file that also rlx helped me with and there it works normally , you can see that in the end tv:wb function call

 

(if (and
		(or (= choice "B") (= choice "D"))
		(= create_new_table "I")
	    ) ;_ _and
	    (progn
		(setq profile_ss (ssadd) ; Create an empty selection set
		      profile_lastEnt(entlast) ; Get the last entity in the drawing
		      )
		(setvar 'OSMODE 0)
		(entmake
		    '((0 . "POLYLINE")	; Object type*******************************************
		      ;;(66 . 1)
		     )
		) ;_  entmake
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list (car ent) (caddr ent) 0.0))
			      ;(cons 10 ent)
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat
		(entmake '((0 . "SEQEND")))
	    ) ;_ _progn		
	    (progn
		(if (not (setq ss_inspt
				  (ssget "X" '((8 . "cssa") (0 . "INSERT") (2 . "CSSABL") (66 . 1))) ;_  ssget
			 ) ;_  setq
		    ) ;_  not
		    (progn (alert "There are no CSSABL blocks with attributes!") (quit)) ;_  end of progn
		) ;_ _if
		(attex ss_inspt station)
		(if (not inspt)
		    (progn
			(alert "\nThere's NO cross section table with that station...aborting...!") ;_  alert
			(quit)
		    ) ;_  progn
		) ;_  if
		(setq ss_inspt nil)
		(setvar 'OSMODE 0)
		(entmake
		    '((0 . "POLYLINE")	; Object type*******************************************
		      ;;(66 . 1)
		     )
		) ;_  entmake
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)
			  xpt (+ (car ent) (car inspt))
			  ypt (+ (- (caddr ent) chartlow) (cadr inspt))
		    ) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list xpt ypt 0.000))
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat
		(entmake '((0 . "SEQEND")))
	    ) ;_ _progn
	) ;_ _if
	
	(if (= choice "X")
	    (progn
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent	     (nth n pntucssort)
			  z_values   (cons (caddr ent) z_values)
			  hdistances (cons (car ent) hdistances)
			  n	     (1+ n)
		    ) ;_ _setq
		) ;_ _repeat
	    ) ;_ _progn
	) ;_ _if
	

	(setvar 'CELWEIGHT 0)
	(setq hdistances (reverse hdistances))
	(setq z_values (reverse z_values))


;;; ************* entering distances and heights to table  *************
;;;*********************************************************************
	(if (and (or (= choice "B") (= choice "D"))
		 (= table_heights "Y")
	    ) ;_ _and
	    (progn
		(setq lay_old (getvar 'CLAYER))
		(setq col_old (getvar 'CECOLOR))
		(setvar 'CLAYER "°Tablica")
		(setvar 'CECOLOR "7")
		(if (= od_osi "Y")
		    ;;ako stavljaš i udaljenosti od osi
		    (progn
			(setq xtext
				 (- (cadr inspt) ; y položaj teksta visine
				    (- (- tblhght rowh) (/ brh 2))
				 ) ;_  -
			) ;_  setq
			(setq xtext_dist ; y položaj teksta od osi
				 (- (cadr inspt) (- tblhght (/ rowh 2))) ;_  -
			) ;_  setq
		    ) ;_  progn
		    
		    ;;ako stavljaš samo visine
		    (progn
			(setq xtext
				 (- (cadr inspt) ; y položaj teksta visine
				    (- tblhght (/ rowh 2))
				 ) ;_  -
			) ;_  setq
		    ) ;_  progn
		) ;_  if
		(princ)
		(setvar 'OSMODE 0)
		(setq n 0)
		(repeat	(length hdistances)
		    (setq hdistent (nth n hdistances))
		    (setq zent (nth n z_values))
		    (if	(= od_osi "Y")
			(progn
			    (setq textpos_dist
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext_dist 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst_dist
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) tblhght) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (setq linesecond_dist
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos_dist "90" (rtos hdistent 2 2)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst_dist) (cons 11 linesecond_dist)) ;_  list
			    ) ;_  entmake
			    (setq textpos
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst linesecond_dist)
			    (setq linesecond
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght brh rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos "90" (rtos zent 2 3)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst) (cons 11 linesecond)) ;_  list
			    ) ;_  entmake
			) ;_  progn
			(progn
			    (setq textpos
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) tblhght) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (setq linesecond
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos "90" (rtos zent 2 3)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst) (cons 11 linesecond)) ;_  list
			    ) ;_  entmake
			) ;_  progn
		    ) ;_  if
		    (setq linefirst nil
			  linesecond nil
			  textpos nil
			  hdistent nil			  
			  zent nil
			  n (1+ n)
		    ) ;_  setq
		) ;_  repeat
		(setvar 'CLAYER lay_old)
		(setvar 'CECOLOR col_old)
	    ) ;_  progn
	) ;_  if
	(setvar 'CELWEIGHT lw)
	(if (= table_location "S")
	    (progn
		(while (setq table_lastEnt (entnext table_lastEnt))
		    ;; Add all entity's created/modified after setting lastent to the selection set
		    (ssadd table_lastEnt table_ss)
		) ;_ _while
		(command "_copybase" "0,0" table_ss "")
		(if (= (rem station 1) 0)
		    (tv:wb table_ss (rtos station 2 0) objFolder)
		    (tv:wb table_ss (rtos station 2 2) objFolder)
		) ;_ _if
	    ) ;_ _progn
	) ;_ _if
	(if(= create_new_table "I")
	   (progn	       	       
	       (while (setq profile_lastEnt (entnext profile_lastEnt))
		    ;; Add all entity's created/modified after setting lastent to the selection set0
		   (ssadd profile_lastEnt profile_ss)		   
		) ;_ _while
	       (setq folderPath (vlax-get-property (vlax-get-property IndObjFolder 'Self) 'Path))
	       (if (= (rem station 1) 0)
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 0) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 0)".dwg not found!"))
			  (exit)
			  )
		      )
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 2) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 2)".dwg not found!"))
			  (exit)
			  )
		      )
		   )
	       (entdel profile_ss)
	       )
	   )

 

Edited by Tomislav
Posted
12 minutes ago, Tomislav said:

well, there's also some copyright involved , but here is a part from creating empty ss to adding objects in it and passing to ctd function...big part of this is skipped (like entering distances and heights to table) cause only when these 3 conditions from first 'if' are met then lisp does something

in another part of my lisp i also use same type of selecting objects in ss and copying to newly created file that also rlx helped me with and there it works normally , you can see that in the end tv:wb function call

 

(if (and
		(or (= choice "B") (= choice "D"))
		(= create_new_table "I")
	    ) ;_ _and
	    (progn
		(setq profile_ss (ssadd) ; Create an empty selection set
		      profile_lastEnt(entlast) ; Get the last entity in the drawing
		      )
		(setvar 'OSMODE 0)
		(entmake
		    '((0 . "POLYLINE")	; Object type*******************************************
		      ;;(66 . 1)
		     )
		) ;_  entmake
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list (car ent) (caddr ent) 0.0))
			      ;(cons 10 ent)
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat
		(entmake '((0 . "SEQEND")))
	    ) ;_ _progn		
	    (progn
		(if (not (setq ss_inspt
				  (ssget "X" '((8 . "cssa") (0 . "INSERT") (2 . "CSSABL") (66 . 1))) ;_  ssget
			 ) ;_  setq
		    ) ;_  not
		    (progn (alert "There are no CSSABL blocks with attributes!") (quit)) ;_  end of progn
		) ;_ _if
		(attex ss_inspt station)
		(if (not inspt)
		    (progn
			(alert "\nThere's NO cross section table with that station...aborting...!") ;_  alert
			(quit)
		    ) ;_  progn
		) ;_  if
		(setq ss_inspt nil)
		(setvar 'OSMODE 0)
		(entmake
		    '((0 . "POLYLINE")	; Object type*******************************************
		      ;;(66 . 1)
		     )
		) ;_  entmake
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)
			  xpt (+ (car ent) (car inspt))
			  ypt (+ (- (caddr ent) chartlow) (cadr inspt))
		    ) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list xpt ypt 0.000))
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat
		(entmake '((0 . "SEQEND")))
	    ) ;_ _progn
	) ;_ _if
	
	(if (= choice "X")
	    (progn
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent	     (nth n pntucssort)
			  z_values   (cons (caddr ent) z_values)
			  hdistances (cons (car ent) hdistances)
			  n	     (1+ n)
		    ) ;_ _setq
		) ;_ _repeat
	    ) ;_ _progn
	) ;_ _if
	

	(setvar 'CELWEIGHT 0)
	(setq hdistances (reverse hdistances))
	(setq z_values (reverse z_values))


;;; ************* entering distances and heights to table  *************
;;;*********************************************************************
	(if (and (or (= choice "B") (= choice "D"))
		 (= table_heights "Y")
	    ) ;_ _and
	    (progn
		(setq lay_old (getvar 'CLAYER))
		(setq col_old (getvar 'CECOLOR))
		(setvar 'CLAYER "°Tablica")
		(setvar 'CECOLOR "7")
		(if (= od_osi "Y")
		    ;;ako stavljaš i udaljenosti od osi
		    (progn
			(setq xtext
				 (- (cadr inspt) ; y položaj teksta visine
				    (- (- tblhght rowh) (/ brh 2))
				 ) ;_  -
			) ;_  setq
			(setq xtext_dist ; y položaj teksta od osi
				 (- (cadr inspt) (- tblhght (/ rowh 2))) ;_  -
			) ;_  setq
		    ) ;_  progn
		    
		    ;;ako stavljaš samo visine
		    (progn
			(setq xtext
				 (- (cadr inspt) ; y položaj teksta visine
				    (- tblhght (/ rowh 2))
				 ) ;_  -
			) ;_  setq
		    ) ;_  progn
		) ;_  if
		(princ)
		(setvar 'OSMODE 0)
		(setq n 0)
		(repeat	(length hdistances)
		    (setq hdistent (nth n hdistances))
		    (setq zent (nth n z_values))
		    (if	(= od_osi "Y")
			(progn
			    (setq textpos_dist
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext_dist 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst_dist
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) tblhght) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (setq linesecond_dist
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos_dist "90" (rtos hdistent 2 2)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst_dist) (cons 11 linesecond_dist)) ;_  list
			    ) ;_  entmake
			    (setq textpos
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst linesecond_dist)
			    (setq linesecond
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght brh rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos "90" (rtos zent 2 3)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst) (cons 11 linesecond)) ;_  list
			    ) ;_  entmake
			) ;_  progn
			(progn
			    (setq textpos
				     (list (+ (+ (car inspt) hdistent) 0.02) xtext 0.000) ;_  list
			    ) ;_  setq
			    (setq linefirst
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) tblhght) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (setq linesecond
				     (list (+ (car inspt) hdistent)
					   (- (cadr inspt) (- tblhght rowh)) ;_  -
					   0.000
				     ) ;_  list
			    ) ;_  setq
			    (princ)
			    (vl-cmdf "_.text" "j" "bc" textpos "90" (rtos zent 2 3)) ;_  vl-cmdf
			    (entmake
				(list (cons 0 "LINE") (cons 10 linefirst) (cons 11 linesecond)) ;_  list
			    ) ;_  entmake
			) ;_  progn
		    ) ;_  if
		    (setq linefirst nil
			  linesecond nil
			  textpos nil
			  hdistent nil			  
			  zent nil
			  n (1+ n)
		    ) ;_  setq
		) ;_  repeat
		(setvar 'CLAYER lay_old)
		(setvar 'CECOLOR col_old)
	    ) ;_  progn
	) ;_  if
	(setvar 'CELWEIGHT lw)
	(if (= table_location "S")
	    (progn
		(while (setq table_lastEnt (entnext table_lastEnt))
		    ;; Add all entity's created/modified after setting lastent to the selection set
		    (ssadd table_lastEnt table_ss)
		) ;_ _while
		(command "_copybase" "0,0" table_ss "")
		(if (= (rem station 1) 0)
		    (tv:wb table_ss (rtos station 2 0) objFolder)
		    (tv:wb table_ss (rtos station 2 2) objFolder)
		) ;_ _if
	    ) ;_ _progn
	) ;_ _if
	(if(= create_new_table "I")
	   (progn	       	       
	       (while (setq profile_lastEnt (entnext profile_lastEnt))
		    ;; Add all entity's created/modified after setting lastent to the selection set0
		   (ssadd profile_lastEnt profile_ss)		   
		) ;_ _while
	       (setq folderPath (vlax-get-property (vlax-get-property IndObjFolder 'Self) 'Path))
	       (if (= (rem station 1) 0)
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 0) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 0)".dwg not found!"))
			  (exit)
			  )
		      )
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 2) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 2)".dwg not found!"))
			  (exit)
			  )
		      )
		   )
	       (entdel profile_ss)
	       )
	   )

 


Eh IGH, dal s geodetom pričam?

Most of added stuff is table creation, what I'm trying to figure out what is "profile_lastEnt", you define it with (entlast), but what is that? And then later you use in while loop to create selection set, and it looks weird to me, but maybe I'm missing something
 

Posted

before passing selection set to copy-to-dwg function , maybe check if your selectionset is actually a selectionset and if it is , it has elements in it.

(if (and (= (type SS) 'PICKSET) (> (sslength ss) 0)) .....

Posted
23 minutes ago, lastknownuser said:


Eh IGH, dal s geodetom pričam?

Most of added stuff is table creation, what I'm trying to figure out what is "profile_lastEnt", you define it with (entlast), but what is that? And then later you use in while loop to create selection set, and it looks weird to me, but maybe I'm missing something
 

 

da kolega geodeta Os-Koteks 😀

you define profile_lastEnt as last object after which you create objects that will go into SS, it's a boundary for while loop as it adds objects going backward through created objects 

 

Posted
24 minutes ago, rlx said:

before passing selection set to copy-to-dwg function , maybe check if your selectionset is actually a selectionset and if it is , it has elements in it.

(if (and (= (type SS) 'PICKSET) (> (sslength ss) 0)) .....

i'll try to check that, but my watch window shows that profile_ss is indeed selection set

Posted
17 hours ago, Tomislav said:

 

da kolega geodeta Os-Koteks 😀

you define profile_lastEnt as last object after which you create objects that will go into SS, it's a boundary for while loop as it adds objects going backward through created objects 

 


pa pozdrav kolega!
Okay, got that part now, even though you could add objects to selection set as you are creating them, it would be better in my opinion
And here is the problem I think, I also get the error in that line with using this part, but maybe again I am missing something

(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list (car ent) (caddr ent) 0.0))
			      ;(cons 10 ent)
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat


I don't understand why this VERTEX entmake, and it probably adds it in selection set but doesn't create it, so can't copy it therefore it gives error
 

Posted

i've made some changes to try adding to ss after creating so did this, changing adding and control of ss on the end of creation

 

(progn
;;;		(setq profile_ss (ssadd) ; Create an empty selection set
;;;		      profile_lastEnt(entlast) ; Get the last entity in the drawing
;;;		      )
		(setvar 'OSMODE 0)
		(entmake
		    '((0 . "POLYLINE")	; Object type*******************************************
		      ;;(66 . 1)
		     )
		) ;_  entmake
		(setq n 0)
		(repeat	(length pntucssort)
		    (setq ent (nth n pntucssort)) ;_ _setq
		    (entmake
			(list '(0 . "VERTEX") ; Object type
			      (cons 10 (list (car ent) (caddr ent) 0.0))
			      ;(cons 10 ent)
			) ;_  list
		    ) ;_  entmake
		    (setq z_values (cons (caddr ent) z_values))
		    (setq hdistances (cons (car ent) hdistances))
		    (setq n (1+ n))
		) ;_ _repeat
		(entmake '((0 . "SEQEND")))
		(setq profile_ss(entlast))
		(if (and (= (type profile_ss) 'PICKSET) (> (sslength profile_ss) 0))
		    (princ"\nSS valid")
		    (princ"\nNone selected SS")
		    )		
	    ) ;

 

and getting none selected so you are right that something is wrong in adding

 

 

 

 

Posted

but when i leave original creating of profile_ss and add control, it passes control and gives that first error Automation Error. Invalid owner object in ctd function...

here is original+implemented control

 

(if(= create_new_table "I")
	   (progn
	       (while (setq profile_lastEnt (entnext profile_lastEnt))
		   ;; Add all entity's created/modified after setting lastent to the selection set0
		   (ssadd profile_lastEnt profile_ss)
	       ) ;_ _while
	       (if (and (= (type profile_ss) 'PICKSET) (> (sslength profile_ss) 0))
		   (princ "\nOK")
		   (progn
		       (princ "\nNone selected SS")
		       (exit)
		   ) ;_ _progn
	       ) ;_ _if
	       (setq folderPath (vlax-get-property (vlax-get-property IndObjFolder 'Self) 'Path))
	       (if (= (rem station 1) 0)
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 0) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 0)".dwg not found!"))
			  (exit)
			  )
		      )
		   (if(findfile(setq fn(strcat folderPath "\\" (rtos station 2 2) ".dwg")))
		      (ctd profile_ss fn)
		      (progn
			  (alert(strcat"File with station"(rtos station 2 2)".dwg not found!"))
			  (exit)
			  )
		      )
		   )
	       )
	   )

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...